StanHeaders/0000755000176200001440000000000013766604372012471 5ustar liggesusersStanHeaders/NAMESPACE0000644000176200001440000000022013711420223013657 0ustar liggesusersif(.Platform$OS.type == "windows") useDynLib(StanHeaders, .registration = TRUE) importFrom(RcppParallel, RcppParallelLibs) export(stanFunction) StanHeaders/LICENSE0000644000176200001440000000014513340666306013467 0ustar liggesusersYEAR: 2011--2017 COPYRIGHT HOLDER: Trustees of Columbia University ORGANIZATION: Columbia University StanHeaders/man/0000755000176200001440000000000013711033410013217 5ustar liggesusersStanHeaders/man/stanFunction.Rd0000644000176200001440000000766013733660317016212 0ustar liggesusers\name{stanFunction} \alias{stanFunction} \title{Compile and Call a Stan Math Function } \description{ Call a function defined in the Stan Math Library from R using this wrapper around \code{\link[Rcpp]{cppFunction}}. } \usage{ stanFunction(function_name, ..., env = parent.frame(), rebuild = FALSE, cacheDir = getOption("rcpp.cache.dir", tempdir()), showOutput = verbose, verbose = getOption("verbose")) } \arguments{ \item{function_name}{ A \code{\link{character}} vector of length one that is the unscoped basename of a C++ function under the \code{prim/} directory of the Stan Math Library that you would like to evaluate. Functions (such as \code{integrate_1d}) of other functions are not permitted and neither are functions (such as \code{reject}) of characters. } \item{\dots}{ Further arguments that are passed to \code{function_name} in \code{tag = value} form, which are passed to \code{function_name} by \emph{position}. See the Details and Examples sections. } \item{env,rebuild,cacheDir,showOutput,verbose}{ The same as in \code{\link[Rcpp]{cppFunction}} } } \details{ The \code{stanFunction} function essentially compiles and evaluates a C++ function of the form \preformatted{auto function_name(...) \{ return stan::math::function_name(...); \}} It is essential to pass all arguments to \code{function_name} through the \dots in order for the C++ wrapper to know what the argument types are. The mapping between R types and Stan types is \tabular{lr}{ \bold{R type} \tab \bold{Stan type} \cr \code{double} \tab \code{real} \cr \code{integer} \tab \code{int} \cr \code{vector} \tab \code{vector} \cr \code{matrix(*, nrow = 1)} \tab \code{row_vector}\cr \code{matrix} \tab \code{matrix} } and, in addition, lists of the aforementioned R types map to arrays of Stan types and thus must not be ragged if they are nested. The Stan version of the function is called with arguments specified by position, i.e. in the order that they appear in the \dots. However, the R wrapper function has arguments whose names are the same as the names passed through the \dots. } \value{ The result of \code{function_name} evaluated at the arguments that are passed through the \dots, which could be of various R types. It also has the side effect of defining a function named \code{function_name} in the environment given by the \code{env} argument that can subsequently be called with inputs of the same type (but not necessarily the same value) that were passed through the \dots. } \examples{ files <- dir(system.file("include", "stan", "math", "prim", package = "StanHeaders"), pattern = "hpp$", recursive = TRUE) functions <- sub("\\\\.hpp$", "", sort(unique(basename(files[dirname(files) != "."])))) length(functions) # you could call most of these Stan functions \dontrun{ log(sum(exp(exp(1)), exp(pi))) # true value stanFunction("log_sum_exp", x = exp(1), y = pi) args(log_sum_exp) # now exists in .GlobalEnv log_sum_exp(x = pi, y = exp(1)) # but log_sum_exp() was not defined for a vector or matrix x <- c(exp(1), pi) try(log_sum_exp(x)) stanFunction("log_sum_exp", x = x) # now it is # log_sum_exp() is now also defined for a matrix log_sum_exp(as.matrix(x)) log_sum_exp(t(as.matrix(x))) log_sum_exp(rbind(x, x)) # but log_sum_exp() was not defined for a list try(log_sum_exp(as.list(x))) stanFunction("log_sum_exp", x = as.list(x)) # now it is # in rare cases, passing a nested list is needed stanFunction("dims", x = list(list(1:3))) # nullary functions work but are not that interesting stanFunction("negative_infinity") # PRNG functions work by adding a seed argument stanFunction("lkj_corr_rng", K = 3L, eta = 1) args(lkj_corr_rng) # has a seed argument } } StanHeaders/man/CxxFlags.Rd0000644000176200001440000000231513605772636015254 0ustar liggesusers\name{CxxFlags} \alias{CxxFlags} \alias{LdFlags} \title{Compilation flags for StanHeaders } \description{ Output the compiler or linker flags required to build with the \pkg{StanHeaders} package } \usage{ CxxFlags(as_character = FALSE) LdFlags(as_character = FALSE) } \arguments{ \item{as_character}{ A logical scalar that defaults to \code{\link{FALSE}} that indicates whether to return the compiler or linker flags as a \code{\link{character}} vector of length one. Otherwise, the compiler or linker flags are merely output to the screen, which is appropriate when called from a Makevars or Makevars.win file } } \details{ These functions are currently not exported and are typically called from a Makevars or a Makevars.win file of another package as follows: PKG_CXXFLAGS += $(shell "${R_HOME}/bin/Rscript" -e "StanHeaders:::CxxFlags()") PKG_LDLIBS += $(shell "${R_HOME}/bin/Rscript" -e "StanHeaders:::LdFlags()") } \value{ If \code{as_character} is \code{\link{TRUE}}, then these functions return a character vector of length one. Otherwise, (which is the default) these functions return \code{\link{NULL}} invisibly after outputing the compiler or linker flags to the screen. } StanHeaders/DESCRIPTION0000644000176200001440000000777013766604372014212 0ustar liggesusersPackage: StanHeaders Date: 2020-12-16 Title: C++ Header Files for Stan Authors@R: c(person("Ben",family="Goodrich", email="benjamin.goodrich@columbia.edu", role=c('cre','aut')), person("Joshua", "Pritikin", role = "ctb"), person("Andrew", "Gelman", role = "aut"), person("Bob", "Carpenter", role = "aut"), person("Matt", "Hoffman", role = "aut"), person("Daniel", "Lee", role = "aut"), person("Michael", "Betancourt", role = "aut"), person("Marcus", "Brubaker", role = "aut"), person("Jiqiang", "Guo", role = "aut"), person("Peter", "Li", role = "aut"), person("Allen", "Riddell", role = "aut"), person("Marco", "Inacio", role = "aut"), person("Mitzi", "Morris", role = "aut"), person("Jeffrey", "Arnold", role = "aut"), person("Rob", "Goedman", role = "aut"), person("Brian", "Lau", role = "aut"), person("Rob", "Trangucci", role = "aut"), person("Jonah", "Gabry", role = "aut"), person("Alp", "Kucukelbir", role = "aut"), person("Robert", "Grant", role = "aut"), person("Dustin", "Tran", role = "aut"), person("Michael", "Malecki", role = "aut"), person("Yuanjun", "Gao", role = "aut"), person("Trustees of", "Columbia University", role = "cph"), person("Lawrence Livermore", "National Security", role = "cph", comment = "CVODES"), person("The Regents of the", "University of California", role = "cph", comment = "CVODES"), person("Southern Methodist", "University", role = "cph", comment = "CVODES")) URL: https://mc-stan.org/ Description: The C++ header files of the Stan project are provided by this package, but it contains little R code or documentation. The main reference is the vignette. There is a shared object containing part of the 'CVODES' library, but its functionality is not accessible from R. 'StanHeaders' is primarily useful for developers who want to utilize the 'LinkingTo' directive of their package's DESCRIPTION file to build on the Stan library without incurring unnecessary dependencies. The Stan project develops a probabilistic programming language that implements full or approximate Bayesian statistical inference via Markov Chain Monte Carlo or 'variational' methods and implements (optionally penalized) maximum likelihood estimation via optimization. The Stan library includes an advanced automatic differentiation scheme, 'templated' statistical and linear algebra functions that can handle the automatically 'differentiable' scalar types (and doubles, 'ints', etc.), and a parser for the Stan language. The 'rstan' package provides user-facing R functions to parse, compile, test, estimate, and analyze Stan models. Imports: RcppParallel (>= 5.0.1) Suggests: Rcpp, BH, knitr (>= 1.15.1), rmarkdown, Matrix, methods, rstan LinkingTo: RcppEigen, RcppParallel (>= 5.0.1) VignetteBuilder: knitr SystemRequirements: pandoc Depends: R (>= 3.4.0) Version: 2.21.0-7 License: BSD_3_clause + file LICENSE NeedsCompilation: yes Packaged: 2020-12-17 04:06:13 UTC; ben Author: Ben Goodrich [cre, aut], Joshua Pritikin [ctb], Andrew Gelman [aut], Bob Carpenter [aut], Matt Hoffman [aut], Daniel Lee [aut], Michael Betancourt [aut], Marcus Brubaker [aut], Jiqiang Guo [aut], Peter Li [aut], Allen Riddell [aut], Marco Inacio [aut], Mitzi Morris [aut], Jeffrey Arnold [aut], Rob Goedman [aut], Brian Lau [aut], Rob Trangucci [aut], Jonah Gabry [aut], Alp Kucukelbir [aut], Robert Grant [aut], Dustin Tran [aut], Michael Malecki [aut], Yuanjun Gao [aut], Trustees of Columbia University [cph], Lawrence Livermore National Security [cph] (CVODES), The Regents of the University of California [cph] (CVODES), Southern Methodist University [cph] (CVODES) Maintainer: Ben Goodrich Repository: CRAN Date/Publication: 2020-12-17 07:30:02 UTC StanHeaders/build/0000755000176200001440000000000013766554455013576 5ustar liggesusersStanHeaders/build/vignette.rds0000644000176200001440000000033613766554455016137 0ustar liggesusersmQm 0rYJBhD rḰ_vs;"fCd9+$RHC8qv2t(]:]'DU$D)9 ~U02B3BO<~Y #include #include "cvodes_diag_impl.h" #include "cvodes_impl.h" /* Other Constants */ #define FRACT RCONST(0.1) #define ONE RCONST(1.0) /* CVDIAG linit, lsetup, lsolve, and lfree routines */ static int CVDiagInit(CVodeMem cv_mem); static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); static int CVDiagFree(CVodeMem cv_mem); /* * ================================================================ * * PART I - forward problems * * ================================================================ */ /* Readability Replacements */ #define lrw1 (cv_mem->cv_lrw1) #define liw1 (cv_mem->cv_liw1) #define f (cv_mem->cv_f) #define uround (cv_mem->cv_uround) #define tn (cv_mem->cv_tn) #define h (cv_mem->cv_h) #define rl1 (cv_mem->cv_rl1) #define gamma (cv_mem->cv_gamma) #define ewt (cv_mem->cv_ewt) #define nfe (cv_mem->cv_nfe) #define zn (cv_mem->cv_zn) #define linit (cv_mem->cv_linit) #define lsetup (cv_mem->cv_lsetup) #define lsolve (cv_mem->cv_lsolve) #define lfree (cv_mem->cv_lfree) #define lmem (cv_mem->cv_lmem) #define vec_tmpl (cv_mem->cv_tempv) #define setupNonNull (cv_mem->cv_setupNonNull) #define gammasv (cvdiag_mem->di_gammasv) #define M (cvdiag_mem->di_M) #define bit (cvdiag_mem->di_bit) #define bitcomp (cvdiag_mem->di_bitcomp) #define nfeDI (cvdiag_mem->di_nfeDI) #define last_flag (cvdiag_mem->di_last_flag) /* * ----------------------------------------------------------------- * CVDiag * ----------------------------------------------------------------- * This routine initializes the memory record and sets various function * fields specific to the diagonal linear solver module. CVDense first * calls the existing lfree routine if this is not NULL. Then it sets * the cv_linit, cv_lsetup, cv_lsolve, cv_lfree fields in (*cvode_mem) * to be CVDiagInit, CVDiagSetup, CVDiagSolve, and CVDiagFree, * respectively. It allocates memory for a structure of type * CVDiagMemRec and sets the cv_lmem field in (*cvode_mem) to the * address of this structure. It sets setupNonNull in (*cvode_mem) to * SUNTRUE. Finally, it allocates memory for M, bit, and bitcomp. * The CVDiag return value is SUCCESS = 0, LMEM_FAIL = -1, or * LIN_ILL_INPUT=-2. * ----------------------------------------------------------------- */ int CVDiag(void *cvode_mem) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiag", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if N_VCompare and N_VInvTest are present */ if(vec_tmpl->ops->nvcompare == NULL || vec_tmpl->ops->nvinvtest == NULL) { cvProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVDIAG", "CVDiag", MSGDG_BAD_NVECTOR); return(CVDIAG_ILL_INPUT); } if (lfree != NULL) lfree(cv_mem); /* Set four main function fields in cv_mem */ linit = CVDiagInit; lsetup = CVDiagSetup; lsolve = CVDiagSolve; lfree = CVDiagFree; /* Get memory for CVDiagMemRec */ cvdiag_mem = NULL; cvdiag_mem = (CVDiagMem) malloc(sizeof(CVDiagMemRec)); if (cvdiag_mem == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); return(CVDIAG_MEM_FAIL); } last_flag = CVDIAG_SUCCESS; /* Allocate memory for M, bit, and bitcomp */ M = N_VClone(vec_tmpl); if (M == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } bit = N_VClone(vec_tmpl); if (bit == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); N_VDestroy(M); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } bitcomp = N_VClone(vec_tmpl); if (bitcomp == NULL) { cvProcessError(cv_mem, CVDIAG_MEM_FAIL, "CVDIAG", "CVDiag", MSGDG_MEM_FAIL); N_VDestroy(M); N_VDestroy(bit); free(cvdiag_mem); cvdiag_mem = NULL; return(CVDIAG_MEM_FAIL); } /* Attach linear solver memory to integrator memory */ lmem = cvdiag_mem; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetWorkSpace * ----------------------------------------------------------------- */ int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetWorkSpace", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *lenrwLS = 3*lrw1; *leniwLS = 3*liw1; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetNumRhsEvals * ----------------------------------------------------------------- */ int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetNumRhsEvals", MSGDG_LMEM_NULL); return(CVDIAG_LMEM_NULL); } cvdiag_mem = (CVDiagMem) lmem; *nfevalsLS = nfeDI; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetLastFlag * ----------------------------------------------------------------- */ int CVDiagGetLastFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVDiagMem cvdiag_mem; /* Return immediately if cvode_mem is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (lmem == NULL) { cvProcessError(cv_mem, CVDIAG_LMEM_NULL, "CVDIAG", "CVDiagGetLastFlag", MSGDG_LMEM_NULL); return(CVDIAG_LMEM_NULL); } cvdiag_mem = (CVDiagMem) lmem; *flag = last_flag; return(CVDIAG_SUCCESS); } /* * ----------------------------------------------------------------- * CVDiagGetReturnFlagName * ----------------------------------------------------------------- */ char *CVDiagGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVDIAG_SUCCESS: sprintf(name,"CVDIAG_SUCCESS"); break; case CVDIAG_MEM_NULL: sprintf(name,"CVDIAG_MEM_NULL"); break; case CVDIAG_LMEM_NULL: sprintf(name,"CVDIAG_LMEM_NULL"); break; case CVDIAG_ILL_INPUT: sprintf(name,"CVDIAG_ILL_INPUT"); break; case CVDIAG_MEM_FAIL: sprintf(name,"CVDIAG_MEM_FAIL"); break; case CVDIAG_INV_FAIL: sprintf(name,"CVDIAG_INV_FAIL"); break; case CVDIAG_RHSFUNC_UNRECVR: sprintf(name,"CVDIAG_RHSFUNC_UNRECVR"); break; case CVDIAG_RHSFUNC_RECVR: sprintf(name,"CVDIAG_RHSFUNC_RECVR"); break; case CVDIAG_NO_ADJ: sprintf(name,"CVDIAG_NO_ADJ"); break; default: sprintf(name,"NONE"); } return(name); } /* * ----------------------------------------------------------------- * CVDiagInit * ----------------------------------------------------------------- * This routine does remaining initializations specific to the diagonal * linear solver. * ----------------------------------------------------------------- */ static int CVDiagInit(CVodeMem cv_mem) { CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; nfeDI = 0; last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagSetup * ----------------------------------------------------------------- * This routine does the setup operations for the diagonal linear * solver. It constructs a diagonal approximation to the Newton matrix * M = I - gamma*J, updates counters, and inverts M. * ----------------------------------------------------------------- */ static int CVDiagSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { realtype r; N_Vector ftemp, y; booleantype invOK; CVDiagMem cvdiag_mem; int retval; cvdiag_mem = (CVDiagMem) lmem; /* Rename work vectors for use as temporary values of y and f */ ftemp = vtemp1; y = vtemp2; /* Form y with perturbation = FRACT*(func. iter. correction) */ r = FRACT * rl1; N_VLinearSum(h, fpred, -ONE, zn[1], ftemp); N_VLinearSum(r, ftemp, ONE, ypred, y); /* Evaluate f at perturbed y */ retval = f(tn, y, M, cv_mem->cv_user_data); nfeDI++; if (retval < 0) { cvProcessError(cv_mem, CVDIAG_RHSFUNC_UNRECVR, "CVDIAG", "CVDiagSetup", MSGDG_RHSFUNC_FAILED); last_flag = CVDIAG_RHSFUNC_UNRECVR; return(-1); } if (retval > 0) { last_flag = CVDIAG_RHSFUNC_RECVR; return(1); } /* Construct M = I - gamma*J with J = diag(deltaf_i/deltay_i) */ N_VLinearSum(ONE, M, -ONE, fpred, M); N_VLinearSum(FRACT, ftemp, -h, M, M); N_VProd(ftemp, ewt, y); /* Protect against deltay_i being at roundoff level */ N_VCompare(uround, y, bit); N_VAddConst(bit, -ONE, bitcomp); N_VProd(ftemp, bit, y); N_VLinearSum(FRACT, y, -ONE, bitcomp, y); N_VDiv(M, y, M); N_VProd(M, bit, M); N_VLinearSum(ONE, M, -ONE, bitcomp, M); /* Invert M with test for zero components */ invOK = N_VInvTest(M, M); if (!invOK) { last_flag = CVDIAG_INV_FAIL; return(1); } /* Set jcur = SUNTRUE, save gamma in gammasv, and return */ *jcurPtr = SUNTRUE; gammasv = gamma; last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagSolve * ----------------------------------------------------------------- * This routine performs the solve operation for the diagonal linear * solver. If necessary it first updates gamma in M = I - gamma*J. * ----------------------------------------------------------------- */ static int CVDiagSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur) { booleantype invOK; realtype r; CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; /* If gamma has changed, update factor in M, and save gamma value */ if (gammasv != gamma) { r = gamma / gammasv; N_VInv(M, M); N_VAddConst(M, -ONE, M); N_VScale(r, M, M); N_VAddConst(M, ONE, M); invOK = N_VInvTest(M, M); if (!invOK) { last_flag = CVDIAG_INV_FAIL; return (1); } gammasv = gamma; } /* Apply M-inverse to b */ N_VProd(b, M, b); last_flag = CVDIAG_SUCCESS; return(0); } /* * ----------------------------------------------------------------- * CVDiagFree * ----------------------------------------------------------------- * This routine frees memory specific to the diagonal linear solver. * ----------------------------------------------------------------- */ static int CVDiagFree(CVodeMem cv_mem) { CVDiagMem cvdiag_mem; cvdiag_mem = (CVDiagMem) lmem; N_VDestroy(M); N_VDestroy(bit); N_VDestroy(bitcomp); free(cvdiag_mem); cv_mem->cv_lmem = NULL; return(0); } /* * ================================================================ * * PART II - backward problems * * ================================================================ */ /* * CVDiagB * * Wrappers for the backward phase around the corresponding * CVODES functions */ int CVDiagB(void *cvode_mem, int which) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVDIAG_MEM_NULL, "CVSDIAG", "CVDiagB", MSGDG_CVMEM_NULL); return(CVDIAG_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CVDIAG_NO_ADJ, "CVSDIAG", "CVDiagB", MSGDG_NO_ADJ); return(CVDIAG_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVDIAG_ILL_INPUT, "CVSDIAG", "CVDiagB", MSGDG_BAD_WHICH); return(CVDIAG_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVDiag(cvodeB_mem); return(flag); } StanHeaders/src/cvodes/cvodes_nls.c0000644000176200001440000002373313766554457017066 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the CVODES nonlinear solver interface. * ---------------------------------------------------------------------------*/ #include "cvodes_impl.h" #include "sundials/sundials_math.h" /* constant macros */ #define ONE RCONST(1.0) /* private functions */ static int cvNlsResidual(N_Vector ycor, N_Vector res, void* cvode_mem); static int cvNlsFPFunction(N_Vector ycor, N_Vector res, void* cvode_mem); static int cvNlsLSetup(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* cvode_mem); static int cvNlsLSolve(N_Vector ycor, N_Vector delta, void* cvode_mem); static int cvNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* cvode_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int CVodeSetNonlinearSolver(void *cvode_mem, SUNNonlinearSolver NLS) { CVodeMem cv_mem; int retval; /* Return immediately if CVode memory is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinearSolver", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Return immediately if NLS memory is NULL */ if (NLS == NULL) { cvProcessError(NULL, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolver", "NLS must be non-NULL"); return (CV_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolver", "NLS does not support required operations"); return(CV_ILL_INPUT); } /* free any existing nonlinear solver */ if ((cv_mem->NLS != NULL) && (cv_mem->ownNLS)) retval = SUNNonlinSolFree(cv_mem->NLS); /* set SUNNonlinearSolver pointer */ cv_mem->NLS = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, CVODE will set the flag to SUNTRUE after this function returns. */ cv_mem->ownNLS = SUNFALSE; /* set the nonlinear system function */ if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_ROOTFIND) { retval = SUNNonlinSolSetSysFn(cv_mem->NLS, cvNlsResidual); } else if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_FIXEDPOINT) { retval = SUNNonlinSolSetSysFn(cv_mem->NLS, cvNlsFPFunction); } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolver", "Invalid nonlinear solver type"); return(CV_ILL_INPUT); } if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolver", "Setting nonlinear system function failed"); return(CV_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(cv_mem->NLS, cvNlsConvTest); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolver", "Setting convergence test function failed"); return(CV_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(cv_mem->NLS, NLS_MAXCOR); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolver", "Setting maximum number of nonlinear iterations failed"); return(CV_ILL_INPUT); } return(CV_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int cvNlsInit(CVodeMem cvode_mem) { int retval; /* set the linear solver setup wrapper function */ if (cvode_mem->cv_lsetup) retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLS, cvNlsLSetup); else retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLS, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODE", "cvNlsInit", "Setting the linear solver setup function failed"); return(CV_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (cvode_mem->cv_lsolve) retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLS, cvNlsLSolve); else retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLS, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODE", "cvNlsInit", "Setting linear solver solve function failed"); return(CV_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(cvode_mem->NLS); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODE", "cvNlsInit", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } return(CV_SUCCESS); } static int cvNlsLSetup(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODE", "cvNlsLSetup", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* if the nonlinear solver marked the Jacobian as bad update convfail */ if (jbad) cv_mem->convfail = CV_FAIL_BAD_J; /* setup the linear solver */ retval = cv_mem->cv_lsetup(cv_mem, cv_mem->convfail, cv_mem->cv_y, cv_mem->cv_ftemp, &(cv_mem->cv_jcur), cv_mem->cv_vtemp1, cv_mem->cv_vtemp2, cv_mem->cv_vtemp3); cv_mem->cv_nsetups++; /* update Jacobian status */ *jcur = cv_mem->cv_jcur; cv_mem->cv_forceSetup = SUNFALSE; cv_mem->cv_gamrat = ONE; cv_mem->cv_gammap = cv_mem->cv_gamma; cv_mem->cv_crate = ONE; cv_mem->cv_crateS = ONE; cv_mem->cv_nstlp = cv_mem->cv_nst; if (retval < 0) return(CV_LSETUP_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); return(CV_SUCCESS); } static int cvNlsLSolve(N_Vector ycor, N_Vector delta, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODE", "cvNlsLSolve", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; retval = cv_mem->cv_lsolve(cv_mem, delta, cv_mem->cv_ewt, cv_mem->cv_y, cv_mem->cv_ftemp); if (retval < 0) return(CV_LSOLVE_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); return(CV_SUCCESS); } static int cvNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector delta, realtype tol, N_Vector ewt, void* cvode_mem) { CVodeMem cv_mem; int m, retval; realtype del; realtype dcon; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODE", "cvNlsConvTest", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* compute the norm of the correction */ del = N_VWrmsNorm(delta, ewt); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != CV_SUCCESS) return(CV_MEM_NULL); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crate, and used in the test. */ if (m > 0) { cv_mem->cv_crate = SUNMAX(CRDOWN * cv_mem->cv_crate, del/cv_mem->cv_delp); } dcon = del * SUNMIN(ONE, cv_mem->cv_crate) / tol; if (dcon <= ONE) { cv_mem->cv_acnrm = (m==0) ? del : N_VWrmsNorm(ycor, cv_mem->cv_ewt); return(CV_SUCCESS); /* Nonlinear system was solved successfully */ } /* check if the iteration seems to be diverging */ if ((m >= 1) && (del > RDIV*cv_mem->cv_delp)) return(SUN_NLS_CONV_RECVR); /* Save norm of correction and loop again */ cv_mem->cv_delp = del; /* Not yet converged */ return(SUN_NLS_CONTINUE); } static int cvNlsResidual(N_Vector ycor, N_Vector res, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODE", "cvNlsResidual", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* update the state based on the current correction */ N_VLinearSum(ONE, cv_mem->cv_zn[0], ONE, ycor, cv_mem->cv_y); /* evaluate the rhs function */ retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); /* compute the resiudal */ N_VLinearSum(cv_mem->cv_rl1, cv_mem->cv_zn[1], ONE, ycor, res); N_VLinearSum(-cv_mem->cv_gamma, cv_mem->cv_ftemp, ONE, res, res); return(CV_SUCCESS); } static int cvNlsFPFunction(N_Vector ycor, N_Vector res, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODE", "cvNlsFPFunction", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* update the state based on the current correction */ N_VLinearSum(ONE, cv_mem->cv_zn[0], ONE, ycor, cv_mem->cv_y); /* evaluate the rhs function */ retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_y, res, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); N_VLinearSum(cv_mem->cv_h, res, -ONE, cv_mem->cv_zn[1], res); N_VScale(cv_mem->cv_rl1, res, res); return(CV_SUCCESS); } StanHeaders/src/cvodes/cvodes_spils.c0000644000176200001440000001035613766554457017421 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated Scaled, Preconditioned Iterative * Linear Solver interface in CVODES; these routines now just wrap * the updated CVODES generic linear solver interface in cvodes_ls.h. * -----------------------------------------------------------------*/ #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= CVSSPILS Exported functions (wrappers for equivalent routines in cvodes_ls.h) =================================================================*/ int CVSpilsSetLinearSolver(void *cvode_mem, SUNLinearSolver LS) { return(CVodeSetLinearSolver(cvode_mem, LS, NULL)); } int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac) { return(CVodeSetEpsLin(cvode_mem, eplifac)); } int CVSpilsSetPreconditioner(void *cvode_mem, CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve) { return(CVodeSetPreconditioner(cvode_mem, pset, psolve)); } int CVSpilsSetJacTimes(void *cvode_mem, CVSpilsJacTimesSetupFn jtsetup, CVSpilsJacTimesVecFn jtimes) { return(CVodeSetJacTimes(cvode_mem, jtsetup, jtimes)); } int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { return(CVodeGetLinWorkSpace(cvode_mem, lenrwLS, leniwLS)); } int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals) { return(CVodeGetNumPrecEvals(cvode_mem, npevals)); } int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves) { return(CVodeGetNumPrecSolves(cvode_mem, npsolves)); } int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters) { return(CVodeGetNumLinIters(cvode_mem, nliters)); } int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails) { return(CVodeGetNumLinConvFails(cvode_mem, nlcfails)); } int CVSpilsGetNumJTSetupEvals(void *cvode_mem, long int *njtsetups) { return(CVodeGetNumJTSetupEvals(cvode_mem, njtsetups)); } int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals) { return(CVodeGetNumJtimesEvals(cvode_mem, njvevals)); } int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { return(CVodeGetNumLinRhsEvals(cvode_mem, nfevalsLS)); } int CVSpilsGetLastFlag(void *cvode_mem, long int *flag) { return(CVodeGetLastLinFlag(cvode_mem, flag)); } char *CVSpilsGetReturnFlagName(long int flag) { return(CVodeGetLinReturnFlagName(flag)); } int CVSpilsSetLinearSolverB(void *cvode_mem, int which, SUNLinearSolver LS) { return(CVodeSetLinearSolverB(cvode_mem, which, LS, NULL)); } int CVSpilsSetEpsLinB(void *cvode_mem, int which, realtype eplifacB) { return(CVodeSetEpsLinB(cvode_mem, which, eplifacB)); } int CVSpilsSetPreconditionerB(void *cvode_mem, int which, CVSpilsPrecSetupFnB psetB, CVSpilsPrecSolveFnB psolveB) { return(CVodeSetPreconditionerB(cvode_mem, which, psetB, psolveB)); } int CVSpilsSetPreconditionerBS(void *cvode_mem, int which, CVSpilsPrecSetupFnBS psetBS, CVSpilsPrecSolveFnBS psolveBS) { return(CVodeSetPreconditionerBS(cvode_mem, which, psetBS, psolveBS)); } int CVSpilsSetJacTimesB(void *cvode_mem, int which, CVSpilsJacTimesSetupFnB jtsetupB, CVSpilsJacTimesVecFnB jtimesB) { return(CVodeSetJacTimesB(cvode_mem, which, jtsetupB, jtimesB)); } int CVSpilsSetJacTimesBS(void *cvode_mem, int which, CVSpilsJacTimesSetupFnBS jtsetupBS, CVSpilsJacTimesVecFnBS jtimesBS) { return(CVodeSetJacTimesBS(cvode_mem, which, jtsetupBS, jtimesBS)); } #ifdef __cplusplus } #endif StanHeaders/src/cvodes/README0000644000176200001440000000732613766554456015442 0ustar liggesusers CVODES Release 4.1.0, Feb 2019 Alan C. Hindmarsh and Radu Serban Center for Applied Scientific Computing, LLNL CVODES is a solver for stiff and nonstiff ODE systems (initial value problem) given in explicit form y' = f(t,y,p) with sensitivity analysis capabilities (both forward and adjoint modes). It is written in ANSI standard C. CVODES can be used both on serial and parallel computers. The main difference is in the NVECTOR module of vector kernels. The desired version is obtained when compiling the example files by linking the appropriate library of NVECTOR kernels. In the parallel versions, communication between processors is done with MPI, with OpenMP, or with Pthreads. When used with the serial NVECTOR module, CVODES provides both direct (dense and band) and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When CVODES is used with the parallel NVECTOR module, only the Krylov linear solvers are available. (An approximate diagonal Jacobian option is available with both versions.) For the serial version, there is a banded preconditioner module called CVBANDPRE available for use with the Krylov solvers, while for the parallel version there is a preconditioner module called CVBBDPRE which provides a band-block-diagonal preconditioner. CVODES is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers [4]. This suite consists of CVODE, CVODES, ARKode, IDA, IDAS, and KINSOL. The directory structure of the package supplied reflects this family relationship. The notes below provide the location of documentation, directions for the installation of the CVODES package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/cvodes/ contains PDF files for the CVODES User Guide [1] (cvs_guide.pdf) and the CVODES Examples [2] (cvs_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_GUIDE.pdf. For complete installation instructions see the "Installation Procedure" chapter in the CVODES User Guide. C. References ------------- [1] A. C. Hindmarsh and R. Serban, "User Documentation for CVODES v2.9.0," LLNL technical report UCRL-SM-208111, March 2016. [2] A. C. Hindmarsh and R. Serban, "Example Programs for CVODES v2.9.0," LLNL technical report UCRL-SM-208115, March 2016. [3] R. Serban and A. C. Hindmarsh, "CVODES: the Sensitivity-Enabled ODE solver in SUNDIALS," Proceedings of IDETC/CIE 2005, Sept. 2005, Long Beach, CA. [4] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. D. Releases ----------- v. 4.1.0 - Feb. 2019 v. 4.0.2 - Jan. 2019 v. 4.0.1 - Dec. 2018 v. 4.0.0 - Dec. 2018 v. 3.2.1 - Oct. 2018 v. 3.2.0 - Sep. 2018 v. 3.1.2 - Jul. 2018 v. 3.1.1 - May 2018 v. 3.1.0 - Nov. 2017 v. 3.0.0 - Sep. 2017 v. 2.9.0 - Sep. 2016 v. 2.8.2 - Aug. 2015 v. 2.8.1 - Mar. 2015 v. 2.8.0 - Mar. 2015 v. 2.7.0 - Mar. 2012 v. 2.6.0 - May 2009 v. 2.5.0 - Nov. 2006 v. 2.4.0 - Mar. 2006 v. 2.3.0 - May. 2005 v. 2.2.0 - Apr. 2005 v. 2.1.2 - Mar. 2005 v. 2.1.1 - Jan. 2005 v. 2.1.0 - Dec. 2004 v. 1.0 - Jul. 2002 (first SUNDIALS release) StanHeaders/src/cvodes/LICENSE0000644000176200001440000000305013766554456015555 0ustar liggesusersBSD 3-Clause License Copyright (c) 2002-2019, Lawrence Livermore National Security and Southern Methodist University. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. StanHeaders/src/cvodes/cvodes_bbdpre.c0000644000176200001440000007120113766554456017520 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with CVODE, the CVSLS linear * solver interface, and the MPI-parallel implementation of NVECTOR. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include "cvodes_bbdpre_impl.h" #include "cvodes_ls_impl.h" #include #include #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Prototypes of functions cvBBDPrecSetup and cvBBDPrecSolve */ static int cvBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data); static int cvBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bbd_data); /* Prototype for cvBBDPrecFree */ static int cvBBDPrecFree(CVodeMem cv_mem); /* Wrapper functions for adjoint code */ static int cvGlocWrapper(sunindextype NlocalB, realtype t, N_Vector yB, N_Vector gB, void *cvadj_mem); static int cvCfnWrapper(sunindextype NlocalB, realtype t, N_Vector yB, void *cvadj_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int cvBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp); /* Prototype for the backward pfree routine */ static int CVBBDPrecFreeB(CVodeBMem cvB_mem); /*================================================================ PART I - forward problems ================================================================*/ /*----------------------------------------------------------------- User-Callable Functions: initialization, reinit and free -----------------------------------------------------------------*/ int CVBBDPrecInit(void *cvode_mem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dqrely, CVLocalFn gloc, CVCommFn cfn) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBBDPrecData pdata; sunindextype muk, mlk, storage_mu, lrw1, liw1; long int lrw, liw; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the CVSLS linear solver interface has been created */ if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Test compatibility of NVECTOR package with the BBD preconditioner */ if(cv_mem->cv_tempv->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_BAD_NVECTOR); return(CVLS_ILL_INPUT); } /* Allocate data memory */ pdata = NULL; pdata = (CVBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Set pointers to gloc and cfn; load half-bandwidths */ pdata->cvode_mem = cvode_mem; pdata->gloc = gloc; pdata->cfn = cfn; pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0,mudq)); pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0,mldq)); muk = SUNMIN(Nlocal-1, SUNMAX(0,mukeep)); mlk = SUNMIN(Nlocal-1, SUNMAX(0,mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Allocate memory for saved Jacobian */ pdata->savedJ = SUNBandMatrixStorage(Nlocal, muk, mlk, muk); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Allocate memory for preconditioner matrix */ storage_mu = SUNMIN(Nlocal-1, muk + mlk); pdata->savedP = NULL; pdata->savedP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu); if (pdata->savedP == NULL) { SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Allocate memory for temporary N_Vectors */ pdata->zlocal = NULL; pdata->zlocal = N_VNewEmpty_Serial(Nlocal); if (pdata->zlocal == NULL) { SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } pdata->rlocal = NULL; pdata->rlocal = N_VNewEmpty_Serial(Nlocal); if (pdata->rlocal == NULL) { N_VDestroy(pdata->zlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } pdata->tmp1 = NULL; pdata->tmp1 = N_VClone(cv_mem->cv_tempv); if (pdata->tmp1 == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } pdata->tmp2 = NULL; pdata->tmp2 = N_VClone(cv_mem->cv_tempv); if (pdata->tmp2 == NULL) { N_VDestroy(pdata->tmp1); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } pdata->tmp3 = NULL; pdata->tmp3 = N_VClone(cv_mem->cv_tempv); if (pdata->tmp3 == NULL) { N_VDestroy(pdata->tmp1); N_VDestroy(pdata->tmp2); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Allocate memory for banded linear solver */ pdata->LS = NULL; pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->savedP); if (pdata->LS == NULL) { N_VDestroy(pdata->tmp1); N_VDestroy(pdata->tmp2); N_VDestroy(pdata->tmp3); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } /* initialize band linear solver object */ flag = SUNLinSolInitialize(pdata->LS); if (flag != SUNLS_SUCCESS) { N_VDestroy(pdata->tmp1); N_VDestroy(pdata->tmp2); N_VDestroy(pdata->tmp3); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); SUNLinSolFree(pdata->LS); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVSBBDPRE", "CVBBDPrecInit", MSGBBD_SUNLS_FAIL); return(CVLS_SUNLS_FAIL); } /* Set pdata->dqrely based on input dqrely (0 implies default). */ pdata->dqrely = (dqrely > ZERO) ? dqrely : SUNRsqrt(cv_mem->cv_uround); /* Store Nlocal to be used in CVBBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge */ pdata->rpwsize = 0; pdata->ipwsize = 0; if (cv_mem->cv_tempv->ops->nvspace) { N_VSpace(cv_mem->cv_tempv, &lrw1, &liw1); pdata->rpwsize += 3*lrw1; pdata->ipwsize += 3*liw1; } if (pdata->rlocal->ops->nvspace) { N_VSpace(pdata->rlocal, &lrw1, &liw1); pdata->rpwsize += 2*lrw1; pdata->ipwsize += 2*liw1; } if (pdata->savedJ->ops->space) { flag = SUNMatSpace(pdata->savedJ, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } if (pdata->savedP->ops->space) { flag = SUNMatSpace(pdata->savedP, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } if (pdata->LS->ops->space) { flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } pdata->nge = 0; /* make sure s_P_data is free from any previous allocations */ if (cvls_mem->pfree) cvls_mem->pfree(cv_mem); /* Point to the new P_data field in the LS memory */ cvls_mem->P_data = pdata; /* Attach the pfree function */ cvls_mem->pfree = cvBBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = CVodeSetPreconditioner(cvode_mem, cvBBDPrecSetup, cvBBDPrecSolve); return(flag); } int CVBBDPrecReInit(void *cvode_mem, sunindextype mudq, sunindextype mldq, realtype dqrely) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBBDPrecData pdata; sunindextype Nlocal; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBBDPRE", "CVBBDPrecReInit", MSGBBD_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the LS linear solver interface has been created */ if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBBDPRE", "CVBBDPrecReInit", MSGBBD_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Test if the preconditioner data is non-NULL */ if (cvls_mem->P_data == NULL) { cvProcessError(cv_mem, CVLS_PMEM_NULL, "CVSBBDPRE", "CVBBDPrecReInit", MSGBBD_PMEM_NULL); return(CVLS_PMEM_NULL); } pdata = (CVBBDPrecData) cvls_mem->P_data; /* Load half-bandwidths */ Nlocal = pdata->n_local; pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0,mudq)); pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0,mldq)); /* Set pdata->dqrely based on input dqrely (0 implies default). */ pdata->dqrely = (dqrely > ZERO) ? dqrely : SUNRsqrt(cv_mem->cv_uround); /* Re-initialize nge */ pdata->nge = 0; return(CVLS_SUCCESS); } int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwBBDP, long int *leniwBBDP) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBBDPrecData pdata; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; if (cvls_mem->P_data == NULL) { cvProcessError(cv_mem, CVLS_PMEM_NULL, "CVSBBDPRE", "CVBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(CVLS_PMEM_NULL); } pdata = (CVBBDPrecData) cvls_mem->P_data; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(CVLS_SUCCESS); } int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBBDPrecData pdata; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; if (cvls_mem->P_data == NULL) { cvProcessError(cv_mem, CVLS_PMEM_NULL, "CVSBBDPRE", "CVBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(CVLS_PMEM_NULL); } pdata = (CVBBDPrecData) cvls_mem->P_data; *ngevalsBBDP = pdata->nge; return(CVLS_SUCCESS); } /*----------------------------------------------------------------- Function : cvBBDPrecSetup ----------------------------------------------------------------- cvBBDPrecSetup generates and factors a banded block of the preconditioner matrix on each processor, via calls to the user-supplied gloc and cfn functions. It uses difference quotient approximations to the Jacobian elements. cvBBDPrecSetup calculates a new J,if necessary, then calculates P = I - gamma*J, and does an LU factorization of P. The parameters of cvBBDPrecSetup used here are as follows: t is the current value of the independent variable. y is the current value of the dependent variable vector, namely the predicted value of y(t). fy is the vector f(t,y). jok is an input flag indicating whether Jacobian-related data needs to be recomputed, as follows: jok == SUNFALSE means recompute Jacobian-related data from scratch. jok == SUNTRUE means that Jacobian data from the previous CVBBDPrecon call can be reused (with the current value of gamma). A cvBBDPrecSetup call with jok == SUNTRUE should only occur after a call with jok == SUNFALSE. jcurPtr is a pointer to an output integer flag which is set by cvBBDPrecSetup as follows: *jcurPtr = SUNTRUE if Jacobian data was recomputed. *jcurPtr = SUNFALSE if Jacobian data was not recomputed, but saved data was reused. gamma is the scalar appearing in the Newton matrix. bbd_data is a pointer to the preconditioner data set by CVBBDPrecInit Return value: The value returned by this cvBBDPrecSetup function is the int 0 if successful, 1 for a recoverable error (step will be retried). -----------------------------------------------------------------*/ static int cvBBDPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bbd_data) { sunindextype ier; CVBBDPrecData pdata; CVodeMem cv_mem; int retval; pdata = (CVBBDPrecData) bbd_data; cv_mem = (CVodeMem) pdata->cvode_mem; /* If jok = SUNTRUE, use saved copy of J */ if (jok) { *jcurPtr = SUNFALSE; retval = SUNMatCopy(pdata->savedJ, pdata->savedP); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_SUNMAT_FAIL); return(-1); } if (retval > 0) { return(1); } /* Otherwise call cvBBDDQJac for new J value */ } else { *jcurPtr = SUNTRUE; retval = SUNMatZero(pdata->savedJ); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_SUNMAT_FAIL); return(-1); } if (retval > 0) { return(1); } retval = cvBBDDQJac(pdata, t, y, pdata->tmp1, pdata->tmp2, pdata->tmp3); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(1); } retval = SUNMatCopy(pdata->savedJ, pdata->savedP); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_SUNMAT_FAIL); return(-1); } if (retval > 0) { return(1); } } /* Scale and add I to get P = I - gamma*J */ retval = SUNMatScaleAddI(-gamma, pdata->savedP); if (retval) { cvProcessError(cv_mem, -1, "CVBBDPRE", "CVBBDPrecSetup", MSGBBD_SUNMAT_FAIL); return(-1); } /* Do LU factorization of matrix and return error flag */ ier = SUNLinSolSetup_Band(pdata->LS, pdata->savedP); return(ier); } /*----------------------------------------------------------------- Function : cvBBDPrecSolve ----------------------------------------------------------------- cvBBDPrecSolve solves a linear system P z = r, with the band-block-diagonal preconditioner matrix P generated and factored by cvBBDPrecSetup. The parameters of cvBBDPrecSolve used here are as follows: r is the right-hand side vector of the linear system. bbd_data is a pointer to the preconditioner data set by CVBBDPrecInit. z is the output vector computed by cvBBDPrecSolve. The value returned by the cvBBDPrecSolve function is always 0, indicating success. -----------------------------------------------------------------*/ static int cvBBDPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bbd_data) { int retval; CVBBDPrecData pdata; pdata = (CVBBDPrecData) bbd_data; /* Attach local data arrays for r and z to rlocal and zlocal */ N_VSetArrayPointer(N_VGetArrayPointer(r), pdata->rlocal); N_VSetArrayPointer(N_VGetArrayPointer(z), pdata->zlocal); /* Call banded solver object to do the work */ retval = SUNLinSolSolve(pdata->LS, pdata->savedP, pdata->zlocal, pdata->rlocal, ZERO); /* Detach local data arrays from rlocal and zlocal */ N_VSetArrayPointer(NULL, pdata->rlocal); N_VSetArrayPointer(NULL, pdata->zlocal); return(retval); } static int cvBBDPrecFree(CVodeMem cv_mem) { CVLsMem cvls_mem; CVBBDPrecData pdata; if (cv_mem->cv_lmem == NULL) return(0); cvls_mem = (CVLsMem) cv_mem->cv_lmem; if (cvls_mem->P_data == NULL) return(0); pdata = (CVBBDPrecData) cvls_mem->P_data; SUNLinSolFree(pdata->LS); N_VDestroy(pdata->tmp1); N_VDestroy(pdata->tmp2); N_VDestroy(pdata->tmp3); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; return(0); } /*----------------------------------------------------------------- Function : cvBBDDQJac ----------------------------------------------------------------- This routine generates a banded difference quotient approximation to the local block of the Jacobian of g(t,y). It assumes that a band SUNMatrix is stored columnwise, and that elements within each column are contiguous. All matrix elements are generated as difference quotients, by way of calls to the user routine gloc. By virtue of the band structure, the number of these calls is bandwidth + 1, where bandwidth = mldq + mudq + 1. But the band matrix kept has bandwidth = mlkeep + mukeep + 1. This routine also assumes that the local elements of a vector are stored contiguously. -----------------------------------------------------------------*/ static int cvBBDDQJac(CVBBDPrecData pdata, realtype t, N_Vector y, N_Vector gy, N_Vector ytemp, N_Vector gtemp) { CVodeMem cv_mem; realtype gnorm, minInc, inc, inc_inv, yj, conj; sunindextype group, i, j, width, ngroups, i1, i2; realtype *y_data, *ewt_data, *gy_data, *gtemp_data; realtype *ytemp_data, *col_j, *cns_data; int retval; cv_mem = (CVodeMem) pdata->cvode_mem; /* Load ytemp with y = predicted solution vector */ N_VScale(ONE, y, ytemp); /* Call cfn and gloc to get base value of g(t,y) */ if (pdata->cfn != NULL) { retval = pdata->cfn(pdata->n_local, t, y, cv_mem->cv_user_data); if (retval != 0) return(retval); } retval = pdata->gloc(pdata->n_local, t, ytemp, gy, cv_mem->cv_user_data); pdata->nge++; if (retval != 0) return(retval); /* Obtain pointers to the data for various vectors */ y_data = N_VGetArrayPointer(y); gy_data = N_VGetArrayPointer(gy); ewt_data = N_VGetArrayPointer(cv_mem->cv_ewt); ytemp_data = N_VGetArrayPointer(ytemp); gtemp_data = N_VGetArrayPointer(gtemp); if (cv_mem->cv_constraints != NULL) cns_data = N_VGetArrayPointer(cv_mem->cv_constraints); /* Set minimum increment based on uround and norm of g */ gnorm = N_VWrmsNorm(gy, cv_mem->cv_ewt); minInc = (gnorm != ZERO) ? (MIN_INC_MULT * SUNRabs(cv_mem->cv_h) * cv_mem->cv_uround * pdata->n_local * gnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = pdata->mldq + pdata->mudq + 1; ngroups = SUNMIN(width, pdata->n_local); /* Loop over groups */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < pdata->n_local; j+=width) { inc = SUNMAX(pdata->dqrely * SUNRabs(y_data[j]), minInc/ewt_data[j]); yj = y_data[j]; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } ytemp_data[j] += inc; } /* Evaluate g with incremented y */ retval = pdata->gloc(pdata->n_local, t, ytemp, gtemp, cv_mem->cv_user_data); pdata->nge++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < pdata->n_local; j+=width) { yj = ytemp_data[j] = y_data[j]; col_j = SUNBandMatrix_Column(pdata->savedJ,j); inc = SUNMAX(pdata->dqrely * SUNRabs(y_data[j]), minInc/ewt_data[j]); /* Adjust sign(inc) as before. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } inc_inv = ONE/inc; i1 = SUNMAX(0, j-pdata->mukeep); i2 = SUNMIN(j + pdata->mlkeep, pdata->n_local-1); for (i=i1; i <= i2; i++) SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (gtemp_data[i] - gy_data[i]); } } return(0); } /*================================================================ PART II - Backward Problems ================================================================*/ /*--------------------------------------------------------------- User-Callable Functions: initialization, reinit and free ---------------------------------------------------------------*/ int CVBBDPrecInitB(void *cvode_mem, int which, sunindextype NlocalB, sunindextype mudqB, sunindextype mldqB, sunindextype mukeepB, sunindextype mlkeepB, realtype dqrelyB, CVLocalFnB glocB, CVCommFnB cfnB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVBBDPrecDataB cvbbdB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBBDPRE", "CVBBDPrecInitB", MSGBBD_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CVLS_NO_ADJ, "CVSBBDPRE", "CVBBDPrecInitB", MSGBBD_NO_ADJ); return(CVLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSBBDPRE", "CVBBDPrecInitB", MSGBBD_BAD_WHICH); return(CVLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; /* advance */ cvB_mem = cvB_mem->cv_next; } /* cv_mem corresponding to 'which' problem. */ cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Initialize the BBD preconditioner for this backward problem. */ flag = CVBBDPrecInit(cvodeB_mem, NlocalB, mudqB, mldqB, mukeepB, mlkeepB, dqrelyB, cvGlocWrapper, cvCfnWrapper); if (flag != CV_SUCCESS) return(flag); /* Allocate memory for CVBBDPrecDataB to store the user-provided functions which will be called from the wrappers */ cvbbdB_mem = NULL; cvbbdB_mem = (CVBBDPrecDataB) malloc(sizeof(* cvbbdB_mem)); if (cvbbdB_mem == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBBDPRE", "CVBBDPrecInitB", MSGBBD_MEM_FAIL); return(CVLS_MEM_FAIL); } /* set pointers to user-provided functions */ cvbbdB_mem->glocB = glocB; cvbbdB_mem->cfnB = cfnB; /* Attach pmem and pfree */ cvB_mem->cv_pmem = cvbbdB_mem; cvB_mem->cv_pfree = CVBBDPrecFreeB; return(CVLS_SUCCESS); } int CVBBDPrecReInitB(void *cvode_mem, int which, sunindextype mudqB, sunindextype mldqB, realtype dqrelyB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBBDPRE", "CVBBDPrecReInitB", MSGBBD_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CVLS_NO_ADJ, "CVSBBDPRE", "CVBBDPrecReInitB", MSGBBD_NO_ADJ); return(CVLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSBBDPRE", "CVBBDPrecReInitB", MSGBBD_BAD_WHICH); return(CVLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; /* advance */ cvB_mem = cvB_mem->cv_next; } /* cv_mem corresponding to 'which' backward problem. */ cvodeB_mem = (void *) (cvB_mem->cv_mem); /* ReInitialize the BBD preconditioner for this backward problem. */ flag = CVBBDPrecReInit(cvodeB_mem, mudqB, mldqB, dqrelyB); return(flag); } static int CVBBDPrecFreeB(CVodeBMem cvB_mem) { free(cvB_mem->cv_pmem); cvB_mem->cv_pmem = NULL; return(0); } /*---------------------------------------------------------------- Wrapper functions ----------------------------------------------------------------*/ /* cvGlocWrapper interfaces to the CVLocalFnB routine provided by the user */ static int cvGlocWrapper(sunindextype NlocalB, realtype t, N_Vector yB, N_Vector gB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVBBDPrecDataB cvbbdB_mem; int flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvbbdB_mem = (CVBBDPrecDataB) (cvB_mem->cv_pmem); /* Get forward solution from interpolation */ flag = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSBBDPRE", "cvGlocWrapper", MSGBBD_BAD_TINTERP); return(-1); } /* Call user's adjoint glocB routine */ return cvbbdB_mem->glocB(NlocalB, t, ca_mem->ca_ytmp, yB, gB, cvB_mem->cv_user_data); } /* cvCfnWrapper interfaces to the CVCommFnB routine provided by the user */ static int cvCfnWrapper(sunindextype NlocalB, realtype t, N_Vector yB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVBBDPrecDataB cvbbdB_mem; int flag; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; cvbbdB_mem = (CVBBDPrecDataB) (cvB_mem->cv_pmem); if (cvbbdB_mem->cfnB == NULL) return(0); /* Get forward solution from interpolation */ flag = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSBBDPRE", "cvCfnWrapper", MSGBBD_BAD_TINTERP); return(-1); } /* Call user's adjoint cfnB routine */ return cvbbdB_mem->cfnB(NlocalB, t, ca_mem->ca_ytmp, yB, cvB_mem->cv_user_data); } StanHeaders/src/cvodes/cvodes.c0000644000176200001440000100355513766554456016212 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the main CVODES integrator * with sensitivity analysis capabilities. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * * Creation, allocation and re-initialization functions * * CVodeCreate * * CVodeInit * CVodeReInit * CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * * CVodeQuadInit * CVodeQuadReInit * CVodeQuadSStolerances * CVodeQuadSVtolerances * * CVodeSensInit * CVodeSensInit1 * CVodeSensReInit * CVodeSensSStolerances * CVodeSensSVtolerances * CVodeSensEEtolerances * * CVodeQuadSensInit * CVodeQuadSensReInit * * CVodeSensToggleOff * * CVodeRootInit * * Main solver function * CVode * * Interpolated output and extraction functions * CVodeGetDky * CVodeGetQuad * CVodeGetQuadDky * CVodeGetSens * CVodeGetSens1 * CVodeGetSensDky * CVodeGetSensDky1 * CVodeGetQuadSens * CVodeGetQuadSens1 * CVodeGetQuadSensDky * CVodeGetQuadSensDky1 * * Deallocation functions * CVodeFree * CVodeQuadFree * CVodeSensFree * CVodeQuadSensFree * * PRIVATE FUNCTIONS * ----------------- * * cvCheckNvector * * Memory allocation/deallocation * cvAllocVectors * cvFreeVectors * cvQuadAllocVectors * cvQuadFreeVectors * cvSensAllocVectors * cvSensFreeVectors * cvQuadSensAllocVectors * cvQuadSensFreeVectors * * Initial stepsize calculation * cvHin * cvUpperBoundH0 * cvYddNorm * * Initial setup * cvInitialSetup * cvEwtSet * cvEwtSetSS * cvEwtSetSV * cvQuadEwtSet * cvQuadEwtSetSS * cvQuadEwtSetSV * cvSensEwtSet * cvSensEwtSetEE * cvSensEwtSetSS * cvSensEwtSetSV * cvQuadSensEwtSet * cvQuadSensEwtSetEE * cvQuadSensEwtSetSS * cvQuadSensEwtSetSV * * Main cvStep function * cvStep * * Functions called at beginning of step * cvAdjustParams * cvAdjustOrder * cvAdjustAdams * cvAdjustBDF * cvIncreaseBDF * cvDecreaseBDF * cvRescale * cvPredict * cvSet * cvSetAdams * cvAdamsStart * cvAdamsFinish * cvAltSum * cvSetBDF * cvSetTqBDF * * Nonlinear solver functions * cvNls * cvQuadNls * cvStgrNls * cvStgr1Nls * cvQuadSensNls * cvHandleNFlag * cvRestore * * Error Test * cvDoErrorTest * * Functions called after a successful step * cvCompleteStep * cvPrepareNextStep * cvSetEta * cvComputeEtaqm1 * cvComputeEtaqp1 * cvChooseEta * * Function to handle failures * cvHandleFailure * * Functions for BDF Stability Limit Detection * cvBDFStab * cvSLdet * * Functions for rootfinding * cvRcheck1 * cvRcheck2 * cvRcheck3 * cvRootfind * * Functions for combined norms * cvQuadUpdateNorm * cvSensNorm * cvSensUpdateNorm * cvQuadSensNorm * cvQuadSensUpdateNorm * * Wrappers for sensitivity RHS * cvSensRhsWrapper * cvSensRhs1Wrapper * * Internal DQ approximations for sensitivity RHS * cvSensRhsInternalDQ * cvSensRhs1InternalDQ * cvQuadSensRhsDQ * * Error message handling functions * cvProcessError * cvErrHandler * * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include "cvodes_impl.h" #include #include #include "sunnonlinsol/sunnonlinsol_newton.h" /* * ================================================================= * CVODES PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) #define TINY RCONST(1.0e-10) #define PT1 RCONST(0.1) #define POINT2 RCONST(0.2) #define FOURTH RCONST(0.25) #define HALF RCONST(0.5) #define PT9 RCONST(0.9) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) #define TWO RCONST(2.0) #define THREE RCONST(3.0) #define FOUR RCONST(4.0) #define FIVE RCONST(5.0) #define TWELVE RCONST(12.0) #define HUNDRED RCONST(100.0) /* * ================================================================= * CVODES ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by cvStep * ---------------------------------------------------------- * * cvHin return values: * CV_SUCCESS, * CV_RHSFUNC_FAIL, CV_RPTD_RHSFUNC_ERR, * CV_QRHSFUNC_FAIL, CV_RPTD_QRHSFUNC_ERR, * CV_SRHSFUNC_FAIL, CV_RPTD_SRHSFUNC_ERR, * CV_TOO_CLOSE * * cvStep control constants: * DO_ERROR_TEST * PREDICT_AGAIN * * cvStep return values: * CV_SUCCESS, * CV_CONV_FAILURE, CV_ERR_FAILURE, * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, * CV_RTFUNC_FAIL, * CV_RHSFUNC_FAIL, CV_QRHSFUNC_FAIL, CV_SRHSFUNC_FAIL, CV_QSRHSFUNC_FAIL, * CV_FIRST_RHSFUNC_ERR, CV_FIRST_QRHSFUNC_ERR, CV_FIRST_SRHSFUNC_ERR, CV_FIRST_QSRHSFUNC_ERR, * CV_UNREC_RHSFUNC_ERR, CV_UNREC_QRHSFUNC_ERR, CV_UNREC_SRHSFUNC_ERR, CV_UNREC_QSRHSFUNC_ERR, * CV_REPTD_RHSFUNC_ERR, CV_REPTD_QRHSFUNC_ERR, CV_REPTD_SRHSFUNC_ERR, CV_REPTD_QSRHSFUNC_ERR, * * cvNls input nflag values: * FIRST_CALL * PREV_CONV_FAIL * PREV_ERR_FAIL * * cvNls return values: * CV_SUCCESS, * CV_LSETUP_FAIL, CV_LSOLVE_FAIL, * CV_RHSFUNC_FAIL, CV_SRHSFUNC_FAIL, * SUN_NLS_CONV_RECVR, * RHSFUNC_RECVR, SRHSFUNC_RECVR * */ #define DO_ERROR_TEST +2 #define PREDICT_AGAIN +3 #define CONV_FAIL +4 #define TRY_AGAIN +5 #define FIRST_CALL +6 #define PREV_CONV_FAIL +7 #define PREV_ERR_FAIL +8 #define CONSTR_RECVR +10 #define QRHSFUNC_RECVR +11 #define QSRHSFUNC_RECVR +13 /* * Control constants for lower-level rootfinding functions * ------------------------------------------------------- * * cvRcheck1 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * cvRcheck2 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * CLOSERT, * RTFOUND * cvRcheck3 return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * RTFOUND * cvRootfind return values: * CV_SUCCESS, * CV_RTFUNC_FAIL, * RTFOUND */ #define RTFOUND +1 #define CLOSERT +3 /* * Control constants for sensitivity DQ * ------------------------------------ */ #define CENTERED1 +1 #define CENTERED2 +2 #define FORWARD1 +3 #define FORWARD2 +4 /* * Control constants for type of sensitivity RHS * --------------------------------------------- */ #define CV_ONESENS 1 #define CV_ALLSENS 2 /* * Control constants for tolerances * -------------------------------- */ #define CV_NN 0 #define CV_SS 1 #define CV_SV 2 #define CV_WF 3 #define CV_EE 4 /* * Algorithmic constants * --------------------- * * CVodeGetDky and cvStep * * FUZZ_FACTOR fuzz factor used to estimate infinitesimal time intervals * * cvHin * * HLB_FACTOR factor for upper bound on initial step size * HUB_FACTOR factor for lower bound on initial step size * H_BIAS bias factor in selection of initial step size * MAX_ITERS maximum attempts to compute the initial step size * * CVodeCreate * * CORTES constant in nonlinear iteration convergence test * * cvStep * * THRESH if eta < THRESH reject a change in step size or order * ETAMX1 -+ * ETAMX2 | * ETAMX3 |-> bounds for eta (step size change) * ETAMXF | * ETAMIN | * ETACF -+ * ADDON safety factor in computing eta * BIAS1 -+ * BIAS2 |-> bias factors in eta selection * BIAS3 -+ * ONEPSM (1+epsilon) used in testing if the step size is below its bound * * SMALL_NST nst > SMALL_NST => use ETAMX3 * MXNCF max no. of convergence failures during one step try * MXNEF max no. of error test failures during one step try * MXNEF1 max no. of error test failures before forcing a reduction of order * SMALL_NEF if an error failure occurs and SMALL_NEF <= nef <= MXNEF1, then * reset eta = SUNMIN(eta, ETAMXF) * LONG_WAIT number of steps to wait before considering an order change when * q==1 and MXNEF1 error test failures have occurred * * cvNls * * DGMAX |gamma/gammap-1| > DGMAX => call lsetup * MSBP max no. of steps between lsetup calls * */ #define FUZZ_FACTOR RCONST(100.0) #define HLB_FACTOR RCONST(100.0) #define HUB_FACTOR RCONST(0.1) #define H_BIAS HALF #define MAX_ITERS 4 #define CORTES RCONST(0.1) #define THRESH RCONST(1.5) #define ETAMX1 RCONST(10000.0) #define ETAMX2 RCONST(10.0) #define ETAMX3 RCONST(10.0) #define ETAMXF RCONST(0.2) #define ETAMIN RCONST(0.1) #define ETACF RCONST(0.25) #define ADDON RCONST(0.000001) #define BIAS1 RCONST(6.0) #define BIAS2 RCONST(6.0) #define BIAS3 RCONST(10.0) #define ONEPSM RCONST(1.000001) #define SMALL_NST 10 #define MXNCF 10 #define MXNEF 7 #define MXNEF1 3 #define SMALL_NEF 2 #define LONG_WAIT 10 #define DGMAX RCONST(0.3) #define MSBP 20 /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype cvCheckNvector(N_Vector tmpl); /* Memory allocation/deallocation */ static booleantype cvAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvFreeVectors(CVodeMem cv_mem); static booleantype cvQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvQuadFreeVectors(CVodeMem cv_mem); static booleantype cvSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvSensFreeVectors(CVodeMem cv_mem); static booleantype cvQuadSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl); static void cvQuadSensFreeVectors(CVodeMem cv_mem); /* Initial stepsize calculation */ static int cvHin(CVodeMem cv_mem, realtype tout); static realtype cvUpperBoundH0(CVodeMem cv_mem, realtype tdist); static int cvYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm); /* Initial setup */ static int cvInitialSetup(CVodeMem cv_mem); static int cvEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); static int cvEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight); static int cvQuadEwtSet(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); static int cvQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); static int cvQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ); static int cvSensEwtSet(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvSensEwtSetEE(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvSensEwtSetSS(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvSensEwtSetSV(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS); static int cvQuadSensEwtSet(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); static int cvQuadSensEwtSetEE(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); static int cvQuadSensEwtSetSS(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); static int cvQuadSensEwtSetSV(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS); /* Main cvStep function */ static int cvStep(CVodeMem cv_mem); /* Function called at beginning of step */ static void cvAdjustParams(CVodeMem cv_mem); static void cvAdjustOrder(CVodeMem cv_mem, int deltaq); static void cvAdjustAdams(CVodeMem cv_mem, int deltaq); static void cvAdjustBDF(CVodeMem cv_mem, int deltaq); static void cvIncreaseBDF(CVodeMem cv_mem); static void cvDecreaseBDF(CVodeMem cv_mem); static void cvRescale(CVodeMem cv_mem); static void cvPredict(CVodeMem cv_mem); static void cvSet(CVodeMem cv_mem); static void cvSetAdams(CVodeMem cv_mem); static realtype cvAdamsStart(CVodeMem cv_mem, realtype m[]); static void cvAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum); static realtype cvAltSum(int iend, realtype a[], int k); static void cvSetBDF(CVodeMem cv_mem); static void cvSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, realtype alpha0_hat, realtype xi_inv, realtype xistar_inv); /* Nonlinear solver functions */ static int cvNls(CVodeMem cv_mem, int nflag); static int cvQuadNls(CVodeMem cv_mem); static int cvStgrNls(CVodeMem cv_mem); static int cvStgr1Nls(CVodeMem cv_mem, int is); static int cvQuadSensNls(CVodeMem cv_mem); static int cvCheckConstraints(CVodeMem cv_mem); static int cvHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *ncfPtr, long int *ncfnPtr); static void cvRestore(CVodeMem cv_mem, realtype saved_t); /* Error Test */ static int cvDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, realtype acor_nrm, int *nefPtr, long int *netfPtr, realtype *dsmPtr); /* Function called after a successful step */ static void cvCompleteStep(CVodeMem cv_mem); static void cvPrepareNextStep(CVodeMem cv_mem, realtype dsm); static void cvSetEta(CVodeMem cv_mem); static realtype cvComputeEtaqm1(CVodeMem cv_mem); static realtype cvComputeEtaqp1(CVodeMem cv_mem); static void cvChooseEta(CVodeMem cv_mem); /* Function to handle failures */ static int cvHandleFailure(CVodeMem cv_mem,int flag); /* Functions for BDF Stability Limit Detection */ static void cvBDFStab(CVodeMem cv_mem); static int cvSLdet(CVodeMem cv_mem); /* Functions for rootfinding */ static int cvRcheck1(CVodeMem cv_mem); static int cvRcheck2(CVodeMem cv_mem); static int cvRcheck3(CVodeMem cv_mem); static int cvRootfind(CVodeMem cv_mem); /* Function for combined norms */ static realtype cvQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ); static realtype cvQuadSensNorm(CVodeMem cv_mem, N_Vector *xQS, N_Vector *wQS); static realtype cvQuadSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS); /* Internal sensitivity RHS DQ functions */ static int cvQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *cvode_mem, N_Vector tmp, N_Vector tmpQ); static int cvQuadSensRhs1InternalDQ(CVodeMem cv_mem, int is, realtype t, N_Vector y, N_Vector yS, N_Vector yQdot, N_Vector yQSdot, N_Vector tmp, N_Vector tmpQ); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation, allocation and re-initialization functions * ----------------------------------------------------------------- */ /* * CVodeCreate * * CVodeCreate creates an internal memory block for a problem to * be solved by CVODES. * If successful, CVodeCreate returns a pointer to the problem memory. * This pointer should be passed to CVodeInit. * If an initialization error occurs, CVodeCreate prints an error * message to standard err and returns NULL. */ void *CVodeCreate(int lmm) { int maxord; CVodeMem cv_mem; /* Test inputs */ if ((lmm != CV_ADAMS) && (lmm != CV_BDF)) { cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_BAD_LMM); return(NULL); } cv_mem = NULL; cv_mem = (CVodeMem) malloc(sizeof(struct CVodeMemRec)); if (cv_mem == NULL) { cvProcessError(NULL, 0, "CVODES", "CVodeCreate", MSGCV_CVMEM_FAIL); return(NULL); } /* Zero out cv_mem */ memset(cv_mem, 0, sizeof(struct CVodeMemRec)); maxord = (lmm == CV_ADAMS) ? ADAMS_Q_MAX : BDF_Q_MAX; /* copy input parameter into cv_mem */ cv_mem->cv_lmm = lmm; /* Set uround */ cv_mem->cv_uround = UNIT_ROUNDOFF; /* Set default values for integrator optional inputs */ cv_mem->cv_f = NULL; cv_mem->cv_user_data = NULL; cv_mem->cv_itol = CV_NN; cv_mem->cv_user_efun = SUNFALSE; cv_mem->cv_efun = NULL; cv_mem->cv_e_data = NULL; cv_mem->cv_ehfun = cvErrHandler; cv_mem->cv_eh_data = cv_mem; cv_mem->cv_errfp = stderr; cv_mem->cv_qmax = maxord; cv_mem->cv_mxstep = MXSTEP_DEFAULT; cv_mem->cv_mxhnil = MXHNIL_DEFAULT; cv_mem->cv_sldeton = SUNFALSE; cv_mem->cv_hin = ZERO; cv_mem->cv_hmin = HMIN_DEFAULT; cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; cv_mem->cv_tstopset = SUNFALSE; cv_mem->cv_maxnef = MXNEF; cv_mem->cv_maxncf = MXNCF; cv_mem->cv_nlscoef = CORTES; cv_mem->convfail = CV_NO_FAILURES; cv_mem->cv_constraints = NULL; cv_mem->cv_constraintsSet = SUNFALSE; /* Initialize root finding variables */ cv_mem->cv_glo = NULL; cv_mem->cv_ghi = NULL; cv_mem->cv_grout = NULL; cv_mem->cv_iroots = NULL; cv_mem->cv_rootdir = NULL; cv_mem->cv_gfun = NULL; cv_mem->cv_nrtfn = 0; cv_mem->cv_gactive = NULL; cv_mem->cv_mxgnull = 1; /* Set default values for quad. optional inputs */ cv_mem->cv_quadr = SUNFALSE; cv_mem->cv_fQ = NULL; cv_mem->cv_errconQ = SUNFALSE; cv_mem->cv_itolQ = CV_NN; /* Set default values for sensi. optional inputs */ cv_mem->cv_sensi = SUNFALSE; cv_mem->cv_fS_data = NULL; cv_mem->cv_fS = cvSensRhsInternalDQ; cv_mem->cv_fS1 = cvSensRhs1InternalDQ; cv_mem->cv_fSDQ = SUNTRUE; cv_mem->cv_ifS = CV_ONESENS; cv_mem->cv_DQtype = CV_CENTERED; cv_mem->cv_DQrhomax = ZERO; cv_mem->cv_p = NULL; cv_mem->cv_pbar = NULL; cv_mem->cv_plist = NULL; cv_mem->cv_errconS = SUNFALSE; cv_mem->cv_ncfS1 = NULL; cv_mem->cv_ncfnS1 = NULL; cv_mem->cv_nniS1 = NULL; cv_mem->cv_itolS = CV_NN; /* Set default values for quad. sensi. optional inputs */ cv_mem->cv_quadr_sensi = SUNFALSE; cv_mem->cv_fQS = NULL; cv_mem->cv_fQS_data = NULL; cv_mem->cv_fQSDQ = SUNTRUE; cv_mem->cv_errconQS = SUNFALSE; cv_mem->cv_itolQS = CV_NN; /* Set default for ASA */ cv_mem->cv_adj = SUNFALSE; cv_mem->cv_adj_mem = NULL; /* Set the saved values for qmax_alloc */ cv_mem->cv_qmax_alloc = maxord; cv_mem->cv_qmax_allocQ = maxord; cv_mem->cv_qmax_allocS = maxord; /* Initialize lrw and liw */ cv_mem->cv_lrw = 65 + 2*L_MAX + NUM_TESTS; cv_mem->cv_liw = 52; /* No mallocs have been done yet */ cv_mem->cv_VabstolMallocDone = SUNFALSE; cv_mem->cv_MallocDone = SUNFALSE; cv_mem->cv_constraintsMallocDone = SUNFALSE; cv_mem->cv_VabstolQMallocDone = SUNFALSE; cv_mem->cv_QuadMallocDone = SUNFALSE; cv_mem->cv_VabstolSMallocDone = SUNFALSE; cv_mem->cv_SabstolSMallocDone = SUNFALSE; cv_mem->cv_SensMallocDone = SUNFALSE; cv_mem->cv_VabstolQSMallocDone = SUNFALSE; cv_mem->cv_SabstolQSMallocDone = SUNFALSE; cv_mem->cv_QuadSensMallocDone = SUNFALSE; cv_mem->cv_adjMallocDone = SUNFALSE; /* Initialize nonlinear solver variables */ cv_mem->NLS = NULL; cv_mem->ownNLS = SUNFALSE; cv_mem->NLSsim = NULL; cv_mem->ownNLSsim = SUNFALSE; cv_mem->ycor0Sim = NULL; cv_mem->ycorSim = NULL; cv_mem->ewtSim = NULL; cv_mem->simMallocDone = SUNFALSE; cv_mem->NLSstg = NULL; cv_mem->ownNLSstg = SUNFALSE; cv_mem->ycor0Stg = NULL; cv_mem->ycorStg = NULL; cv_mem->ewtStg = NULL; cv_mem->stgMallocDone = SUNFALSE; cv_mem->NLSstg1 = NULL; cv_mem->ownNLSstg1 = SUNFALSE; cv_mem->sens_solve = SUNFALSE; cv_mem->sens_solve_idx = -1; /* Return pointer to CVODES memory block */ return((void *)cv_mem); } /*-----------------------------------------------------------------*/ /* * CVodeInit * * CVodeInit allocates and initializes memory for a problem. All * problem inputs are checked for errors. If any error occurs during * initialization, it is reported to the file whose file pointer is * errfp and an error flag is returned. Otherwise, it returns CV_SUCCESS */ int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0) { CVodeMem cv_mem; booleantype nvectorOK, allocOK; sunindextype lrw1, liw1; int i,k, retval; SUNNonlinearSolver NLS; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check for legal input parameters */ if (y0==NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_NULL_Y0); return(CV_ILL_INPUT); } if (f == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_NULL_F); return(CV_ILL_INPUT); } /* Test if all required vector operations are implemented */ nvectorOK = cvCheckNvector(y0); if(!nvectorOK) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeInit", MSGCV_BAD_NVECTOR); return(CV_ILL_INPUT); } /* Set space requirements for one N_Vector */ if (y0->ops->nvspace != NULL) { N_VSpace(y0, &lrw1, &liw1); } else { lrw1 = 0; liw1 = 0; } cv_mem->cv_lrw1 = lrw1; cv_mem->cv_liw1 = liw1; /* Allocate the vectors (using y0 as a template) */ allocOK = cvAllocVectors(cv_mem, y0); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Allocate temporary work arrays for fused vector ops */ cv_mem->cv_cvals = NULL; cv_mem->cv_cvals = (realtype *) malloc(L_MAX*sizeof(realtype)); cv_mem->cv_Xvecs = NULL; cv_mem->cv_Xvecs = (N_Vector *) malloc(L_MAX*sizeof(N_Vector)); cv_mem->cv_Zvecs = NULL; cv_mem->cv_Zvecs = (N_Vector *) malloc(L_MAX*sizeof(N_Vector)); if ((cv_mem->cv_cvals == NULL) || (cv_mem->cv_Xvecs == NULL) || (cv_mem->cv_Zvecs == NULL)) { cvFreeVectors(cv_mem); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* create a Newton nonlinear solver object by default */ NLS = SUNNonlinSol_Newton(y0); /* check that nonlinear solver is non-NULL */ if (NLS == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeInit", MSGCV_MEM_FAIL); cvFreeVectors(cv_mem); return(CV_MEM_FAIL); } /* attach the nonlinear solver to the CVODE memory */ retval = CVodeSetNonlinearSolver(cv_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != CV_SUCCESS) { cvProcessError(cv_mem, retval, "CVODES", "CVodeInit", "Setting the nonlinear solver failed"); cvFreeVectors(cv_mem); SUNNonlinSolFree(NLS); return(CV_MEM_FAIL); } /* set ownership flag */ cv_mem->ownNLS = SUNTRUE; /* All error checking is complete at this point */ /* Copy the input parameters into CVODES state */ cv_mem->cv_f = f; cv_mem->cv_tn = t0; /* Set step parameters */ cv_mem->cv_q = 1; cv_mem->cv_L = 2; cv_mem->cv_qwait = cv_mem->cv_L; cv_mem->cv_etamax = ETAMX1; cv_mem->cv_qu = 0; cv_mem->cv_hu = ZERO; cv_mem->cv_tolsf = ONE; /* Set the linear solver addresses to NULL. (We check != NULL later, in CVode) */ cv_mem->cv_linit = NULL; cv_mem->cv_lsetup = NULL; cv_mem->cv_lsolve = NULL; cv_mem->cv_lfree = NULL; cv_mem->cv_lmem = NULL; /* Set forceSetup to SUNFALSE */ cv_mem->cv_forceSetup = SUNFALSE; /* Initialize zn[0] in the history array */ N_VScale(ONE, y0, cv_mem->cv_zn[0]); /* Initialize all the counters */ cv_mem->cv_nst = 0; cv_mem->cv_nfe = 0; cv_mem->cv_ncfn = 0; cv_mem->cv_netf = 0; cv_mem->cv_nni = 0; cv_mem->cv_nsetups = 0; cv_mem->cv_nhnil = 0; cv_mem->cv_nstlp = 0; cv_mem->cv_nscon = 0; cv_mem->cv_nge = 0; cv_mem->cv_irfnd = 0; /* Initialize other integrator optional outputs */ cv_mem->cv_h0u = ZERO; cv_mem->cv_next_h = ZERO; cv_mem->cv_next_q = 0; /* Initialize Stablilty Limit Detection data */ /* NOTE: We do this even if stab lim det was not turned on yet. This way, the user can turn it on at any time */ cv_mem->cv_nor = 0; for (i = 1; i <= 5; i++) for (k = 1; k <= 3; k++) cv_mem->cv_ssdat[i-1][k-1] = ZERO; /* Problem has been successfully initialized */ cv_mem->cv_MallocDone = SUNTRUE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeReInit * * CVodeReInit re-initializes CVODES's memory for a problem, assuming * it has already been allocated in a prior CVodeInit call. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0) { CVodeMem cv_mem; int i,k; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if cvode_mem was allocated */ if (cv_mem->cv_MallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeReInit", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check for legal input parameters */ if (y0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeReInit", MSGCV_NULL_Y0); return(CV_ILL_INPUT); } /* Copy the input parameters into CVODES state */ cv_mem->cv_tn = t0; /* Set step parameters */ cv_mem->cv_q = 1; cv_mem->cv_L = 2; cv_mem->cv_qwait = cv_mem->cv_L; cv_mem->cv_etamax = ETAMX1; cv_mem->cv_qu = 0; cv_mem->cv_hu = ZERO; cv_mem->cv_tolsf = ONE; /* Set forceSetup to SUNFALSE */ cv_mem->cv_forceSetup = SUNFALSE; /* Initialize zn[0] in the history array */ N_VScale(ONE, y0, cv_mem->cv_zn[0]); /* Initialize all the counters */ cv_mem->cv_nst = 0; cv_mem->cv_nfe = 0; cv_mem->cv_ncfn = 0; cv_mem->cv_netf = 0; cv_mem->cv_nni = 0; cv_mem->cv_nsetups = 0; cv_mem->cv_nhnil = 0; cv_mem->cv_nstlp = 0; cv_mem->cv_nscon = 0; cv_mem->cv_nge = 0; cv_mem->cv_irfnd = 0; /* Initialize other integrator optional outputs */ cv_mem->cv_h0u = ZERO; cv_mem->cv_next_h = ZERO; cv_mem->cv_next_q = 0; /* Initialize Stablilty Limit Detection data */ cv_mem->cv_nor = 0; for (i = 1; i <= 5; i++) for (k = 1; k <= 3; k++) cv_mem->cv_ssdat[i-1][k-1] = ZERO; /* Problem has been successfully re-initialized */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSStolerances * CVodeSVtolerances * CVodeWFtolerances * * These functions specify the integration tolerances. One of them * MUST be called before the first call to CVode. * * CVodeSStolerances specifies scalar relative and absolute tolerances. * CVodeSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * CVodeWFtolerances specifies a user-provides function (of type CVEwtFn) * which will be called to set the error weight vector. */ int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeSStolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSStolerances", MSGCV_BAD_RELTOL); return(CV_ILL_INPUT); } if (abstol < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSStolerances", MSGCV_BAD_ABSTOL); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_reltol = reltol; cv_mem->cv_Sabstol = abstol; cv_mem->cv_itol = CV_SS; cv_mem->cv_user_efun = SUNFALSE; cv_mem->cv_efun = cvEwtSet; cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ return(CV_SUCCESS); } int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeSVtolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSVtolerances", MSGCV_BAD_RELTOL); return(CV_ILL_INPUT); } if (N_VMin(abstol) < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSVtolerances", MSGCV_BAD_ABSTOL); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ if ( !(cv_mem->cv_VabstolMallocDone) ) { cv_mem->cv_Vabstol = N_VClone(cv_mem->cv_ewt); cv_mem->cv_lrw += cv_mem->cv_lrw1; cv_mem->cv_liw += cv_mem->cv_liw1; cv_mem->cv_VabstolMallocDone = SUNTRUE; } cv_mem->cv_reltol = reltol; N_VScale(ONE, abstol, cv_mem->cv_Vabstol); cv_mem->cv_itol = CV_SV; cv_mem->cv_user_efun = SUNFALSE; cv_mem->cv_efun = cvEwtSet; cv_mem->cv_e_data = NULL; /* will be set to cvode_mem in InitialSetup */ return(CV_SUCCESS); } int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeWFtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_MallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVodeWFtolerances", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } cv_mem->cv_itol = CV_WF; cv_mem->cv_user_efun = SUNTRUE; cv_mem->cv_efun = efun; cv_mem->cv_e_data = NULL; /* will be set to user_data in InitialSetup */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadInit * * CVodeQuadInit allocates and initializes quadrature related * memory for a problem. All problem specification inputs are * checked for errors. If any error occurs during initialization, * it is reported to the file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0) { CVodeMem cv_mem; booleantype allocOK; sunindextype lrw1Q, liw1Q; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Set space requirements for one N_Vector */ N_VSpace(yQ0, &lrw1Q, &liw1Q); cv_mem->cv_lrw1Q = lrw1Q; cv_mem->cv_liw1Q = liw1Q; /* Allocate the vectors (using yQ0 as a template) */ allocOK = cvQuadAllocVectors(cv_mem, yQ0); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeQuadInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Initialize znQ[0] in the history array */ N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); /* Copy the input parameters into CVODES state */ cv_mem->cv_fQ = fQ; /* Initialize counters */ cv_mem->cv_nfQe = 0; cv_mem->cv_netfQ = 0; /* Quadrature integration turned ON */ cv_mem->cv_quadr = SUNTRUE; cv_mem->cv_QuadMallocDone = SUNTRUE; /* Quadrature initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadReInit * * CVodeQuadReInit re-initializes CVODES's quadrature related memory * for a problem, assuming it has already been allocated in prior * calls to CVodeInit and CVodeQuadInit. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0) { CVodeMem cv_mem; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Ckeck if quadrature was initialized? */ if (cv_mem->cv_QuadMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadReInit", MSGCV_NO_QUAD); return(CV_NO_QUAD); } /* Initialize znQ[0] in the history array */ N_VScale(ONE, yQ0, cv_mem->cv_znQ[0]); /* Initialize counters */ cv_mem->cv_nfQe = 0; cv_mem->cv_netfQ = 0; /* Quadrature integration turned ON */ cv_mem->cv_quadr = SUNTRUE; /* Quadrature re-initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadSStolerances * CVodeQuadSVtolerances * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to * CVode IF error control on the quadrature variables is enabled * (see CVodeSetQuadErrCon). * * CVodeQuadSStolerances specifies scalar relative and absolute tolerances. * CVodeQuadSVtolerances specifies scalar relative tolerance and a vector * absolute toleranc (a potentially different absolute tolerance for each * vector component). */ int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Ckeck if quadrature was initialized? */ if (cv_mem->cv_QuadMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadSStolerances", MSGCV_NO_QUAD); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSStolerances", MSGCV_BAD_RELTOLQ); return(CV_ILL_INPUT); } if (abstolQ < 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSStolerances", MSGCV_BAD_ABSTOLQ); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolQ = CV_SS; cv_mem->cv_reltolQ = reltolQ; cv_mem->cv_SabstolQ = abstolQ; return(CV_SUCCESS); } int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Ckeck if quadrature was initialized? */ if (cv_mem->cv_QuadMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeQuadSVtolerances", MSGCV_NO_QUAD); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_BAD_RELTOLQ); return(CV_ILL_INPUT); } if (abstolQ == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_NULL_ABSTOLQ); return(CV_ILL_INPUT); } if (N_VMin(abstolQ) < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSVtolerances", MSGCV_BAD_ABSTOLQ); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolQ = CV_SV; cv_mem->cv_reltolQ = reltolQ; if ( !(cv_mem->cv_VabstolQMallocDone) ) { cv_mem->cv_VabstolQ = N_VClone(cv_mem->cv_tempvQ); cv_mem->cv_lrw += cv_mem->cv_lrw1Q; cv_mem->cv_liw += cv_mem->cv_liw1Q; cv_mem->cv_VabstolQMallocDone = SUNTRUE; } N_VScale(ONE, abstolQ, cv_mem->cv_VabstolQ); return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSensInit * * CVodeSensInit allocates and initializes sensitivity related * memory for a problem (using a sensitivity RHS function of type * CVSensRhsFn). All problem specification inputs are checked for * errors. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeSensInit(void *cvode_mem, int Ns, int ism, CVSensRhsFn fS, N_Vector *yS0) { CVodeMem cv_mem; booleantype allocOK; int is, retval; SUNNonlinearSolver NLS; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if CVodeSensInit or CVodeSensInit1 was already called */ if (cv_mem->cv_SensMallocDone) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_SENSINIT_2); return(CV_ILL_INPUT); } /* Check if Ns is legal */ if (Ns<=0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_NS); return(CV_ILL_INPUT); } cv_mem->cv_Ns = Ns; /* Check if ism is compatible */ if (ism==CV_STAGGERED1) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_ISM_IFS); return(CV_ILL_INPUT); } /* Check if ism is legal */ if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_BAD_ISM); return(CV_ILL_INPUT); } cv_mem->cv_ism = ism; /* Check if yS0 is non-null */ if (yS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit", MSGCV_NULL_YS0); return(CV_ILL_INPUT); } /* Store sensitivity RHS-related data */ cv_mem->cv_ifS = CV_ALLSENS; cv_mem->cv_fS1 = NULL; if (fS == NULL) { cv_mem->cv_fSDQ = SUNTRUE; cv_mem->cv_fS = cvSensRhsInternalDQ; cv_mem->cv_fS_data = cvode_mem; } else { cv_mem->cv_fSDQ = SUNFALSE; cv_mem->cv_fS = fS; cv_mem->cv_fS_data = cv_mem->cv_user_data; } /* No memory allocation for STAGGERED1 */ cv_mem->cv_stgr1alloc = SUNFALSE; /* Allocate the vectors (using yS0[0] as a template) */ allocOK = cvSensAllocVectors(cv_mem, yS0[0]); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Check if larger temporary work arrays are needed for fused vector ops */ if (Ns*L_MAX > L_MAX) { free(cv_mem->cv_cvals); cv_mem->cv_cvals = NULL; free(cv_mem->cv_Xvecs); cv_mem->cv_Xvecs = NULL; free(cv_mem->cv_Zvecs); cv_mem->cv_Zvecs = NULL; cv_mem->cv_cvals = (realtype *) malloc((Ns*L_MAX)*sizeof(realtype)); cv_mem->cv_Xvecs = (N_Vector *) malloc((Ns*L_MAX)*sizeof(N_Vector)); cv_mem->cv_Zvecs = (N_Vector *) malloc((Ns*L_MAX)*sizeof(N_Vector)); if ((cv_mem->cv_cvals == NULL) || (cv_mem->cv_Xvecs == NULL) || (cv_mem->cv_Zvecs == NULL)) { cvSensFreeVectors(cv_mem); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znS[0] in the history array */ for (is=0; iscv_cvals[is] = ONE; retval = N_VScaleVectorArray(Ns, cv_mem->cv_cvals, yS0, cv_mem->cv_znS[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Initialize all sensitivity related counters */ cv_mem->cv_nfSe = 0; cv_mem->cv_nfeS = 0; cv_mem->cv_ncfnS = 0; cv_mem->cv_netfS = 0; cv_mem->cv_nniS = 0; cv_mem->cv_nsetupsS = 0; /* Set default values for plist and pbar */ for (is=0; iscv_plist[is] = is; cv_mem->cv_pbar[is] = ONE; } /* Sensitivities will be computed */ cv_mem->cv_sensi = SUNTRUE; cv_mem->cv_SensMallocDone = SUNTRUE; /* create a Newton nonlinear solver object by default */ if (ism == CV_SIMULTANEOUS) NLS = SUNNonlinSol_NewtonSens(Ns+1, cv_mem->cv_acor); else NLS = SUNNonlinSol_NewtonSens(Ns, cv_mem->cv_acor); /* check that the nonlinear solver is non-NULL */ if (NLS == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit", MSGCV_MEM_FAIL); cvSensFreeVectors(cv_mem); return(CV_MEM_FAIL); } /* attach the nonlinear solver to the CVODE memory */ if (ism == CV_SIMULTANEOUS) retval = CVodeSetNonlinearSolverSensSim(cv_mem, NLS); else retval = CVodeSetNonlinearSolverSensStg(cv_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != CV_SUCCESS) { cvProcessError(cv_mem, retval, "CVODES", "CVodeSensInit", "Setting the nonlinear solver failed"); cvSensFreeVectors(cv_mem); SUNNonlinSolFree(NLS); return(CV_MEM_FAIL); } /* set ownership flag */ if (ism == CV_SIMULTANEOUS) cv_mem->ownNLSsim = SUNTRUE; else cv_mem->ownNLSstg = SUNTRUE; /* Sensitivity initialization was successfull */ return(CV_SUCCESS); } /* * CVodeSensInit1 * * CVodeSensInit1 allocates and initializes sensitivity related * memory for a problem (using a sensitivity RHS function of type * CVSensRhs1Fn). All problem specification inputs are checked for * errors. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeSensInit1(void *cvode_mem, int Ns, int ism, CVSensRhs1Fn fS1, N_Vector *yS0) { CVodeMem cv_mem; booleantype allocOK; int is, retval; SUNNonlinearSolver NLS; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensInit1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if CVodeSensInit or CVodeSensInit1 was already called */ if (cv_mem->cv_SensMallocDone) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_SENSINIT_2); return(CV_ILL_INPUT); } /* Check if Ns is legal */ if (Ns<=0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_BAD_NS); return(CV_ILL_INPUT); } cv_mem->cv_Ns = Ns; /* Check if ism is legal */ if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_BAD_ISM); return(CV_ILL_INPUT); } cv_mem->cv_ism = ism; /* Check if yS0 is non-null */ if (yS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensInit1", MSGCV_NULL_YS0); return(CV_ILL_INPUT); } /* Store sensitivity RHS-related data */ cv_mem->cv_ifS = CV_ONESENS; cv_mem->cv_fS = NULL; if (fS1 == NULL) { cv_mem->cv_fSDQ = SUNTRUE; cv_mem->cv_fS1 = cvSensRhs1InternalDQ; cv_mem->cv_fS_data = cvode_mem; } else { cv_mem->cv_fSDQ = SUNFALSE; cv_mem->cv_fS1 = fS1; cv_mem->cv_fS_data = cv_mem->cv_user_data; } /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ if (ism == CV_STAGGERED1) { cv_mem->cv_stgr1alloc = SUNTRUE; cv_mem->cv_ncfS1 = NULL; cv_mem->cv_ncfS1 = (int*)malloc(Ns*sizeof(int)); cv_mem->cv_ncfnS1 = NULL; cv_mem->cv_ncfnS1 = (long int*)malloc(Ns*sizeof(long int)); cv_mem->cv_nniS1 = NULL; cv_mem->cv_nniS1 = (long int*)malloc(Ns*sizeof(long int)); if ( (cv_mem->cv_ncfS1 == NULL) || (cv_mem->cv_ncfnS1 == NULL) || (cv_mem->cv_nniS1 == NULL) ) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } else { cv_mem->cv_stgr1alloc = SUNFALSE; } /* Allocate the vectors (using yS0[0] as a template) */ allocOK = cvSensAllocVectors(cv_mem, yS0[0]); if (!allocOK) { if (cv_mem->cv_stgr1alloc) { free(cv_mem->cv_ncfS1); cv_mem->cv_ncfS1 = NULL; free(cv_mem->cv_ncfnS1); cv_mem->cv_ncfnS1 = NULL; free(cv_mem->cv_nniS1); cv_mem->cv_nniS1 = NULL; } cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Check if larger temporary work arrays are needed for fused vector ops */ if (Ns*L_MAX > L_MAX) { free(cv_mem->cv_cvals); cv_mem->cv_cvals = NULL; free(cv_mem->cv_Xvecs); cv_mem->cv_Xvecs = NULL; free(cv_mem->cv_Zvecs); cv_mem->cv_Zvecs = NULL; cv_mem->cv_cvals = (realtype *) malloc((Ns*L_MAX)*sizeof(realtype)); cv_mem->cv_Xvecs = (N_Vector *) malloc((Ns*L_MAX)*sizeof(N_Vector)); cv_mem->cv_Zvecs = (N_Vector *) malloc((Ns*L_MAX)*sizeof(N_Vector)); if ((cv_mem->cv_cvals == NULL) || (cv_mem->cv_Xvecs == NULL) || (cv_mem->cv_Zvecs == NULL)) { if (cv_mem->cv_stgr1alloc) { free(cv_mem->cv_ncfS1); cv_mem->cv_ncfS1 = NULL; free(cv_mem->cv_ncfnS1); cv_mem->cv_ncfnS1 = NULL; free(cv_mem->cv_nniS1); cv_mem->cv_nniS1 = NULL; } cvSensFreeVectors(cv_mem); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znS[0] in the history array */ for (is=0; iscv_cvals[is] = ONE; retval = N_VScaleVectorArray(Ns, cv_mem->cv_cvals, yS0, cv_mem->cv_znS[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Initialize all sensitivity related counters */ cv_mem->cv_nfSe = 0; cv_mem->cv_nfeS = 0; cv_mem->cv_ncfnS = 0; cv_mem->cv_netfS = 0; cv_mem->cv_nniS = 0; cv_mem->cv_nsetupsS = 0; if (ism==CV_STAGGERED1) for (is=0; iscv_ncfnS1[is] = 0; cv_mem->cv_nniS1[is] = 0; } /* Set default values for plist and pbar */ for (is=0; iscv_plist[is] = is; cv_mem->cv_pbar[is] = ONE; } /* Sensitivities will be computed */ cv_mem->cv_sensi = SUNTRUE; cv_mem->cv_SensMallocDone = SUNTRUE; /* create a Newton nonlinear solver object by default */ if (ism == CV_SIMULTANEOUS) NLS = SUNNonlinSol_NewtonSens(Ns+1, cv_mem->cv_acor); else if (ism == CV_STAGGERED) NLS = SUNNonlinSol_NewtonSens(Ns, cv_mem->cv_acor); else NLS = SUNNonlinSol_Newton(cv_mem->cv_acor); /* check that the nonlinear solver is non-NULL */ if (NLS == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensInit1", MSGCV_MEM_FAIL); cvSensFreeVectors(cv_mem); return(CV_MEM_FAIL); } /* attach the nonlinear solver to the CVODE memory */ if (ism == CV_SIMULTANEOUS) retval = CVodeSetNonlinearSolverSensSim(cv_mem, NLS); else if (ism == CV_STAGGERED) retval = CVodeSetNonlinearSolverSensStg(cv_mem, NLS); else retval = CVodeSetNonlinearSolverSensStg1(cv_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != CV_SUCCESS) { cvProcessError(cv_mem, retval, "CVODES", "CVodeSensInit1", "Setting the nonlinear solver failed"); cvSensFreeVectors(cv_mem); SUNNonlinSolFree(NLS); return(CV_MEM_FAIL); } /* set ownership flag */ if (ism == CV_SIMULTANEOUS) cv_mem->ownNLSsim = SUNTRUE; else if (ism == CV_STAGGERED) cv_mem->ownNLSstg = SUNTRUE; else cv_mem->ownNLSstg1 = SUNTRUE; /* Sensitivity initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSensReInit * * CVodeSensReInit re-initializes CVODES's sensitivity related memory * for a problem, assuming it has already been allocated in prior * calls to CVodeInit and CVodeSensInit/CVodeSensInit1. * All problem specification inputs are checked for errors. * The number of sensitivities Ns is assumed to be unchanged since * the previous call to CVodeSensInit. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is CV_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0) { CVodeMem cv_mem; int is, retval; SUNNonlinearSolver NLS; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensReInit", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Check if ism is compatible */ if ((cv_mem->cv_ifS==CV_ALLSENS) && (ism==CV_STAGGERED1)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_BAD_ISM_IFS); return(CV_ILL_INPUT); } /* Check if ism is legal */ if ((ism!=CV_SIMULTANEOUS) && (ism!=CV_STAGGERED) && (ism!=CV_STAGGERED1)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_BAD_ISM); return(CV_ILL_INPUT); } cv_mem->cv_ism = ism; /* Check if yS0 is non-null */ if (yS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensReInit", MSGCV_NULL_YS0); return(CV_ILL_INPUT); } /* Allocate ncfS1, ncfnS1, and nniS1 if needed */ if ( (ism==CV_STAGGERED1) && (cv_mem->cv_stgr1alloc==SUNFALSE) ) { cv_mem->cv_stgr1alloc = SUNTRUE; cv_mem->cv_ncfS1 = NULL; cv_mem->cv_ncfS1 = (int*)malloc(cv_mem->cv_Ns*sizeof(int)); cv_mem->cv_ncfnS1 = NULL; cv_mem->cv_ncfnS1 = (long int*)malloc(cv_mem->cv_Ns*sizeof(long int)); cv_mem->cv_nniS1 = NULL; cv_mem->cv_nniS1 = (long int*)malloc(cv_mem->cv_Ns*sizeof(long int)); if ( (cv_mem->cv_ncfS1==NULL) || (cv_mem->cv_ncfnS1==NULL) || (cv_mem->cv_nniS1==NULL) ) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensReInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znS[0] in the history array */ for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, yS0, cv_mem->cv_znS[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Initialize all sensitivity related counters */ cv_mem->cv_nfSe = 0; cv_mem->cv_nfeS = 0; cv_mem->cv_ncfnS = 0; cv_mem->cv_netfS = 0; cv_mem->cv_nniS = 0; cv_mem->cv_nsetupsS = 0; if (ism==CV_STAGGERED1) for (is=0; iscv_Ns; is++) { cv_mem->cv_ncfnS1[is] = 0; cv_mem->cv_nniS1[is] = 0; } /* Problem has been successfully re-initialized */ cv_mem->cv_sensi = SUNTRUE; /* Check if the NLS exists, create the default NLS if needed */ if ( (ism == CV_SIMULTANEOUS && cv_mem->NLSsim == NULL) || (ism == CV_STAGGERED && cv_mem->NLSstg == NULL) || (ism == CV_STAGGERED1 && cv_mem->NLSstg1 == NULL) ) { /* create a Newton nonlinear solver object by default */ if (ism == CV_SIMULTANEOUS) NLS = SUNNonlinSol_NewtonSens(cv_mem->cv_Ns+1, cv_mem->cv_acor); else if (ism == CV_STAGGERED) NLS = SUNNonlinSol_NewtonSens(cv_mem->cv_Ns, cv_mem->cv_acor); else NLS = SUNNonlinSol_Newton(cv_mem->cv_acor); /* check that the nonlinear solver is non-NULL */ if (NLS == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSensReInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* attach the nonlinear solver to the CVODES memory */ if (ism == CV_SIMULTANEOUS) retval = CVodeSetNonlinearSolverSensSim(cv_mem, NLS); else if (ism == CV_STAGGERED) retval = CVodeSetNonlinearSolverSensStg(cv_mem, NLS); else retval = CVodeSetNonlinearSolverSensStg1(cv_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != CV_SUCCESS) { cvProcessError(cv_mem, retval, "CVODES", "CVodeSensReInit", "Setting the nonlinear solver failed"); SUNNonlinSolFree(NLS); return(CV_MEM_FAIL); } /* set ownership flag */ if (ism == CV_SIMULTANEOUS) cv_mem->ownNLSsim = SUNTRUE; else if (ism == CV_STAGGERED) cv_mem->ownNLSstg = SUNTRUE; else cv_mem->ownNLSstg1 = SUNTRUE; /* initialize the NLS object, this assumes that the linear solver has already been initialized in CVodeInit */ if (ism == CV_SIMULTANEOUS) retval = cvNlsInitSensSim(cv_mem); else if (ism == CV_STAGGERED) retval = cvNlsInitSensStg(cv_mem); else retval = cvNlsInitSensStg1(cv_mem); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_NLS_INIT_FAIL, "CVODES", "CVodeSensReInit", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } } /* Sensitivity re-initialization was successfull */ return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSensSStolerances * CVodeSensSVtolerances * CVodeSensEEtolerances * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to CVode. * * CVodeSensSStolerances specifies scalar relative and absolute tolerances. * CVodeSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each sensitivity vector (a potentially different * absolute tolerance for each vector component). * CVodeEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the state variables. */ int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS) { CVodeMem cv_mem; int is; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensSStolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_BAD_RELTOLS); return(CV_ILL_INPUT); } if (abstolS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_NULL_ABSTOLS); return(CV_ILL_INPUT); } for (is=0; iscv_Ns; is++) if (abstolS[is] < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSStolerances", MSGCV_BAD_ABSTOLS); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolS = CV_SS; cv_mem->cv_reltolS = reltolS; if ( !(cv_mem->cv_SabstolSMallocDone) ) { cv_mem->cv_SabstolS = NULL; cv_mem->cv_SabstolS = (realtype *)malloc(cv_mem->cv_Ns*sizeof(realtype)); cv_mem->cv_lrw += cv_mem->cv_Ns; cv_mem->cv_SabstolSMallocDone = SUNTRUE; } for (is=0; iscv_Ns; is++) cv_mem->cv_SabstolS[is] = abstolS[is]; return(CV_SUCCESS); } int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS) { CVodeMem cv_mem; int is, retval; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensSVtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_BAD_RELTOLS); return(CV_ILL_INPUT); } if (abstolS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_NULL_ABSTOLS); return(CV_ILL_INPUT); } for (is=0; iscv_Ns; is++) if (N_VMin(abstolS[is]) < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_BAD_ABSTOLS); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolS = CV_SV; cv_mem->cv_reltolS = reltolS; if ( !(cv_mem->cv_VabstolSMallocDone) ) { cv_mem->cv_VabstolS = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); cv_mem->cv_lrw += cv_mem->cv_Ns*cv_mem->cv_lrw1; cv_mem->cv_liw += cv_mem->cv_Ns*cv_mem->cv_liw1; cv_mem->cv_VabstolSMallocDone = SUNTRUE; } for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, abstolS, cv_mem->cv_VabstolS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); return(CV_SUCCESS); } int CVodeSensEEtolerances(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensEEtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSensEEtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } cv_mem->cv_itolS = CV_EE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeQuadSensInit * */ int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0) { CVodeMem cv_mem; booleantype allocOK; int is, retval; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if sensitivity analysis is active */ if (!cv_mem->cv_sensi) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensInit", MSGCV_NO_SENSI); return(CV_ILL_INPUT); } /* Check if yQS0 is non-null */ if (yQS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensInit", MSGCV_NULL_YQS0); return(CV_ILL_INPUT); } /* Allocate the vectors (using yQS0[0] as a template) */ allocOK = cvQuadSensAllocVectors(cv_mem, yQS0[0]); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeQuadSensInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Set fQS */ if (fQS == NULL) { cv_mem->cv_fQSDQ = SUNTRUE; cv_mem->cv_fQS = cvQuadSensRhsInternalDQ; cv_mem->cv_fQS_data = cvode_mem; } else { cv_mem->cv_fQSDQ = SUNFALSE; cv_mem->cv_fQS = fQS; cv_mem->cv_fQS_data = cv_mem->cv_user_data; } /* Initialize znQS[0] in the history array */ for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, yQS0, cv_mem->cv_znQS[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Initialize all sensitivity related counters */ cv_mem->cv_nfQSe = 0; cv_mem->cv_nfQeS = 0; cv_mem->cv_netfQS = 0; /* Quadrature sensitivities will be computed */ cv_mem->cv_quadr_sensi = SUNTRUE; cv_mem->cv_QuadSensMallocDone = SUNTRUE; /* Sensitivity initialization was successfull */ return(CV_SUCCESS); } /* * CVodeQuadSensReInit * */ int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0) { CVodeMem cv_mem; int is, retval; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if sensitivity analysis is active */ if (!cv_mem->cv_sensi) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Was quadrature sensitivity initialized? */ if (cv_mem->cv_QuadSensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensReInit", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } /* Check if yQS0 is non-null */ if (yQS0 == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensReInit", MSGCV_NULL_YQS0); return(CV_ILL_INPUT); } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize znQS[0] in the history array */ for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, yQS0, cv_mem->cv_znQS[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Initialize all sensitivity related counters */ cv_mem->cv_nfQSe = 0; cv_mem->cv_nfQeS = 0; cv_mem->cv_netfQS = 0; /* Quadrature sensitivities will be computed */ cv_mem->cv_quadr_sensi = SUNTRUE; /* Problem has been successfully re-initialized */ return(CV_SUCCESS); } /* * CVodeQuadSensSStolerances * CVodeQuadSensSVtolerances * CVodeQuadSensEEtolerances * * These functions specify the integration tolerances for quadrature * sensitivity variables. One of them MUST be called before the first * call to CVode IF these variables are included in the error test. * * CVodeQuadSensSStolerances specifies scalar relative and absolute tolerances. * CVodeQuadSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each quadrature sensitivity vector (a potentially * different absolute tolerance for each vector component). * CVodeQuadSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the quadrature variables. * In this case, tolerances for the quadrature variables must be * specified through a call to one of CVodeQuad**tolerances. */ int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS) { CVodeMem cv_mem; int is; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if sensitivity was initialized */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSSensSStolerances", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_BAD_RELTOLQS); return(CV_ILL_INPUT); } if (abstolQS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_NULL_ABSTOLQS); return(CV_ILL_INPUT); } for (is=0; iscv_Ns; is++) if (abstolQS[is] < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSStolerances", MSGCV_BAD_ABSTOLQS); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolQS = CV_SS; cv_mem->cv_reltolQS = reltolQS; if ( !(cv_mem->cv_SabstolQSMallocDone) ) { cv_mem->cv_SabstolQS = NULL; cv_mem->cv_SabstolQS = (realtype *)malloc(cv_mem->cv_Ns*sizeof(realtype)); cv_mem->cv_lrw += cv_mem->cv_Ns; cv_mem->cv_SabstolQSMallocDone = SUNTRUE; } for (is=0; iscv_Ns; is++) cv_mem->cv_SabstolQS[is] = abstolQS[is]; return(CV_SUCCESS); } int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS) { CVodeMem cv_mem; int is, retval; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* check if sensitivity was initialized */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_BAD_RELTOLQS); return(CV_ILL_INPUT); } if (abstolQS == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSensSVtolerances", MSGCV_NULL_ABSTOLQS); return(CV_ILL_INPUT); } for (is=0; iscv_Ns; is++) if (N_VMin(abstolQS[is]) < ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeQuadSensSVtolerances", MSGCV_BAD_ABSTOLQS); return(CV_ILL_INPUT); } /* Copy tolerances into memory */ cv_mem->cv_itolQS = CV_SV; cv_mem->cv_reltolQS = reltolQS; if ( !(cv_mem->cv_VabstolQSMallocDone) ) { cv_mem->cv_VabstolQS = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempvQ); cv_mem->cv_lrw += cv_mem->cv_Ns*cv_mem->cv_lrw1Q; cv_mem->cv_liw += cv_mem->cv_Ns*cv_mem->cv_liw1Q; cv_mem->cv_VabstolQSMallocDone = SUNTRUE; } for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, abstolQS, cv_mem->cv_VabstolQS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); return(CV_SUCCESS); } int CVodeQuadSensEEtolerances(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* check if sensitivity was initialized */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeQuadSensEEtolerances", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } cv_mem->cv_itolQS = CV_EE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeSensToggleOff * * CVodeSensToggleOff deactivates sensitivity calculations. * It does NOT deallocate sensitivity-related memory. */ int CVodeSensToggleOff(void *cvode_mem) { CVodeMem cv_mem; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSensToggleOff", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Disable sensitivities */ cv_mem->cv_sensi = SUNFALSE; cv_mem->cv_quadr_sensi = SUNFALSE; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ /* * CVodeRootInit * * CVodeRootInit initializes a rootfinding problem to be solved * during the integration of the ODE system. It loads the root * function pointer and the number of root functions, and allocates * workspace memory. The return value is CV_SUCCESS = 0 if no errors * occurred, or a negative value otherwise. */ int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g) { CVodeMem cv_mem; int i, nrt; /* Check cvode_mem */ if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeRootInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = (nrtfn < 0) ? 0 : nrtfn; /* If rerunning CVodeRootInit() with a different number of root functions (changing number of gfun components), then free currently held memory resources */ if ((nrt != cv_mem->cv_nrtfn) && (cv_mem->cv_nrtfn > 0)) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; free(cv_mem->cv_grout); cv_mem->cv_grout = NULL; free(cv_mem->cv_iroots); cv_mem->cv_iroots = NULL; free(cv_mem->cv_rootdir); cv_mem->cv_rootdir = NULL; free(cv_mem->cv_gactive); cv_mem->cv_gactive = NULL; cv_mem->cv_lrw -= 3 * (cv_mem->cv_nrtfn); cv_mem->cv_liw -= 3 * (cv_mem->cv_nrtfn); } /* If CVodeRootInit() was called with nrtfn == 0, then set cv_nrtfn to zero and cv_gfun to NULL before returning */ if (nrt == 0) { cv_mem->cv_nrtfn = nrt; cv_mem->cv_gfun = NULL; return(CV_SUCCESS); } /* If rerunning CVodeRootInit() with the same number of root functions (not changing number of gfun components), then check if the root function argument has changed */ /* If g != NULL then return as currently reserved memory resources will suffice */ if (nrt == cv_mem->cv_nrtfn) { if (g != cv_mem->cv_gfun) { if (g == NULL) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; free(cv_mem->cv_grout); cv_mem->cv_grout = NULL; free(cv_mem->cv_iroots); cv_mem->cv_iroots = NULL; free(cv_mem->cv_rootdir); cv_mem->cv_rootdir = NULL; free(cv_mem->cv_gactive); cv_mem->cv_gactive = NULL; cv_mem->cv_lrw -= 3*nrt; cv_mem->cv_liw -= 3*nrt; cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeRootInit", MSGCV_NULL_G); return(CV_ILL_INPUT); } else { cv_mem->cv_gfun = g; return(CV_SUCCESS); } } else return(CV_SUCCESS); } /* Set variable values in CVode memory block */ cv_mem->cv_nrtfn = nrt; if (g == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeRootInit", MSGCV_NULL_G); return(CV_ILL_INPUT); } else cv_mem->cv_gfun = g; /* Allocate necessary memory and return */ cv_mem->cv_glo = NULL; cv_mem->cv_glo = (realtype *) malloc(nrt*sizeof(realtype)); if (cv_mem->cv_glo == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->cv_ghi = NULL; cv_mem->cv_ghi = (realtype *) malloc(nrt*sizeof(realtype)); if (cv_mem->cv_ghi == NULL) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->cv_grout = NULL; cv_mem->cv_grout = (realtype *) malloc(nrt*sizeof(realtype)); if (cv_mem->cv_grout == NULL) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->cv_iroots = NULL; cv_mem->cv_iroots = (int *) malloc(nrt*sizeof(int)); if (cv_mem->cv_iroots == NULL) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; free(cv_mem->cv_grout); cv_mem->cv_grout = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->cv_rootdir = NULL; cv_mem->cv_rootdir = (int *) malloc(nrt*sizeof(int)); if (cv_mem->cv_rootdir == NULL) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; free(cv_mem->cv_grout); cv_mem->cv_grout = NULL; free(cv_mem->cv_iroots); cv_mem->cv_iroots = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->cv_gactive = NULL; cv_mem->cv_gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); if (cv_mem->cv_gactive == NULL) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; free(cv_mem->cv_grout); cv_mem->cv_grout = NULL; free(cv_mem->cv_iroots); cv_mem->cv_iroots = NULL; free(cv_mem->cv_rootdir); cv_mem->cv_rootdir = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeRootInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Set default values for rootdir (both directions) */ for(i=0; icv_rootdir[i] = 0; /* Set default values for gactive (all active) */ for(i=0; icv_gactive[i] = SUNTRUE; cv_mem->cv_lrw += 3*nrt; cv_mem->cv_liw += 3*nrt; return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * CVode * * This routine is the main driver of the CVODES package. * * It integrates over a time interval defined by the user, by calling * cvStep to do internal time steps. * * The first time that CVode is called for a successfully initialized * problem, it computes a tentative initial step size h. * * CVode supports two modes, specified by itask: CV_NORMAL, CV_ONE_STEP. * In the CV_NORMAL mode, the solver steps until it reaches or passes tout * and then interpolates to obtain y(tout). * In the CV_ONE_STEP mode, it takes one internal step and returns. */ int CVode(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask) { CVodeMem cv_mem; long int nstloc; int retval, hflag, kflag, istate, is, ir, ier, irfndp; realtype troundoff, tout_hin, rh, nrm; booleantype inactive_roots; /* * ------------------------------------- * 1. Check and process inputs * ------------------------------------- */ /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVode", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Check if cvode_mem was allocated */ if (cv_mem->cv_MallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_MALLOC, "CVODES", "CVode", MSGCV_NO_MALLOC); return(CV_NO_MALLOC); } /* Check for yout != NULL */ if ((cv_mem->cv_y = yout) == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_YOUT_NULL); return(CV_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_TRET_NULL); return(CV_ILL_INPUT); } /* Check for valid itask */ if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_ITASK); return(CV_ILL_INPUT); } if (itask == CV_NORMAL) cv_mem->cv_toutc = tout; cv_mem->cv_taskc = itask; /* * ---------------------------------------- * 2. Initializations performed only at * the first step (nst=0): * - initial setup * - initialize Nordsieck history array * - compute initial step size * - check for approach to tstop * - check for approach to a root * ---------------------------------------- */ if (cv_mem->cv_nst == 0) { cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; /* Check inputs for corectness */ ier = cvInitialSetup(cv_mem); if (ier!= CV_SUCCESS) return(ier); /* * Call f at (t0,y0), set zn[1] = y'(t0). * If computing any quadratures, call fQ at (t0,y0), set znQ[1] = yQ'(t0) * If computing sensitivities, call fS at (t0,y0,yS0), set znS[1][is] = yS'(t0), is=1,...,Ns. * If computing quadr. sensi., call fQS at (t0,y0,yS0), set znQS[1][is] = yQS'(t0), is=1,...,Ns. */ retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_zn[1], cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) { cvProcessError(cv_mem, CV_RHSFUNC_FAIL, "CVODES", "CVode", MSGCV_RHSFUNC_FAILED, cv_mem->cv_tn); return(CV_RHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_RHSFUNC_ERR, "CVODES", "CVode", MSGCV_RHSFUNC_FIRST); return(CV_FIRST_RHSFUNC_ERR); } if (cv_mem->cv_quadr) { retval = cv_mem->cv_fQ(cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_znQ[1], cv_mem->cv_user_data); cv_mem->cv_nfQe++; if (retval < 0) { cvProcessError(cv_mem, CV_QRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QRHSFUNC_FAILED, cv_mem->cv_tn); return(CV_QRHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_QRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QRHSFUNC_FIRST); return(CV_FIRST_QRHSFUNC_ERR); } } if (cv_mem->cv_sensi) { retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_zn[1], cv_mem->cv_znS[0], cv_mem->cv_znS[1], cv_mem->cv_tempv, cv_mem->cv_ftemp); if (retval < 0) { cvProcessError(cv_mem, CV_SRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_SRHSFUNC_FAILED, cv_mem->cv_tn); return(CV_SRHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_SRHSFUNC_ERR, "CVODES", "CVode", MSGCV_SRHSFUNC_FIRST); return(CV_FIRST_SRHSFUNC_ERR); } } if (cv_mem->cv_quadr_sensi) { retval = cv_mem->cv_fQS(cv_mem->cv_Ns, cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_znS[0], cv_mem->cv_znQ[1], cv_mem->cv_znQS[1], cv_mem->cv_fQS_data, cv_mem->cv_tempv, cv_mem->cv_tempvQ); cv_mem->cv_nfQSe++; if (retval < 0) { cvProcessError(cv_mem, CV_QSRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QSRHSFUNC_FAILED, cv_mem->cv_tn); return(CV_QSRHSFUNC_FAIL); } if (retval > 0) { cvProcessError(cv_mem, CV_FIRST_QSRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QSRHSFUNC_FIRST); return(CV_FIRST_QSRHSFUNC_ERR); } } /* Test input tstop for legality. */ if (cv_mem->cv_tstopset) { if ( (cv_mem->cv_tstop - cv_mem->cv_tn)*(tout - cv_mem->cv_tn) <= ZERO ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TSTOP, cv_mem->cv_tstop, cv_mem->cv_tn); return(CV_ILL_INPUT); } } /* Set initial h (from H0 or cvHin). */ cv_mem->cv_h = cv_mem->cv_hin; if ( (cv_mem->cv_h != ZERO) && ((tout-cv_mem->cv_tn)*cv_mem->cv_h < ZERO) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_H0); return(CV_ILL_INPUT); } if (cv_mem->cv_h == ZERO) { tout_hin = tout; if ( cv_mem->cv_tstopset && (tout-cv_mem->cv_tn)*(tout-cv_mem->cv_tstop) > ZERO ) tout_hin = cv_mem->cv_tstop; hflag = cvHin(cv_mem, tout_hin); if (hflag != CV_SUCCESS) { istate = cvHandleFailure(cv_mem, hflag); return(istate); } } rh = SUNRabs(cv_mem->cv_h)*cv_mem->cv_hmax_inv; if (rh > ONE) cv_mem->cv_h /= rh; if (SUNRabs(cv_mem->cv_h) < cv_mem->cv_hmin) cv_mem->cv_h *= cv_mem->cv_hmin/SUNRabs(cv_mem->cv_h); /* Check for approach to tstop */ if (cv_mem->cv_tstopset) { if ( (cv_mem->cv_tn + cv_mem->cv_h - cv_mem->cv_tstop)*cv_mem->cv_h > ZERO ) cv_mem->cv_h = (cv_mem->cv_tstop - cv_mem->cv_tn)*(ONE-FOUR*cv_mem->cv_uround); } /* * Scale zn[1] by h. * If computing any quadratures, scale znQ[1] by h. * If computing sensitivities, scale znS[1][is] by h. * If computing quadrature sensitivities, scale znQS[1][is] by h. */ cv_mem->cv_hscale = cv_mem->cv_h; cv_mem->cv_h0u = cv_mem->cv_h; cv_mem->cv_hprime = cv_mem->cv_h; N_VScale(cv_mem->cv_h, cv_mem->cv_zn[1], cv_mem->cv_zn[1]); if (cv_mem->cv_quadr) N_VScale(cv_mem->cv_h, cv_mem->cv_znQ[1], cv_mem->cv_znQ[1]); if (cv_mem->cv_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_h; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[1], cv_mem->cv_znS[1]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } if (cv_mem->cv_quadr_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_h; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znQS[1], cv_mem->cv_znQS[1]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } /* Check for zeros of root function g at and near t0. */ if (cv_mem->cv_nrtfn > 0) { retval = cvRcheck1(cv_mem); if (retval == CV_RTFUNC_FAIL) { cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck1", MSGCV_RTFUNC_FAILED, cv_mem->cv_tn); return(CV_RTFUNC_FAIL); } } } /* end first call block */ /* * ------------------------------------------------------ * 3. At following steps, perform stop tests: * - check for root in last step * - check if we passed tstop * - check if we passed tout (NORMAL mode) * - check if current tn was returned (ONE_STEP mode) * - check if we are close to tstop * (adjust step size if needed) * ------------------------------------------------------- */ if (cv_mem->cv_nst > 0) { /* Estimate an infinitesimal time interval to be used as a roundoff for time quantities (based on current time and step size) */ troundoff = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_h)); /* First check for a root in the last step taken, other than the last root found, if any. If itask = CV_ONE_STEP and y(tn) was not returned because of an intervening root, return y(tn) now. */ if (cv_mem->cv_nrtfn > 0) { irfndp = cv_mem->cv_irfnd; retval = cvRcheck2(cv_mem); if (retval == CLOSERT) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvRcheck2", MSGCV_CLOSE_ROOTS, cv_mem->cv_tlo); return(CV_ILL_INPUT); } else if (retval == CV_RTFUNC_FAIL) { cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck2", MSGCV_RTFUNC_FAILED, cv_mem->cv_tlo); return(CV_RTFUNC_FAIL); } else if (retval == RTFOUND) { cv_mem->cv_tretlast = *tret = cv_mem->cv_tlo; return(CV_ROOT_RETURN); } /* If tn is distinct from tretlast (within roundoff), check remaining interval for roots */ if ( SUNRabs(cv_mem->cv_tn - cv_mem->cv_tretlast) > troundoff ) { retval = cvRcheck3(cv_mem); if (retval == CV_SUCCESS) { /* no root found */ cv_mem->cv_irfnd = 0; if ((irfndp == 1) && (itask == CV_ONE_STEP)) { cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); return(CV_SUCCESS); } } else if (retval == RTFOUND) { /* a new root was found */ cv_mem->cv_irfnd = 1; cv_mem->cv_tretlast = *tret = cv_mem->cv_tlo; return(CV_ROOT_RETURN); } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck3", MSGCV_RTFUNC_FAILED, cv_mem->cv_tlo); return(CV_RTFUNC_FAIL); } } } /* end of root stop check */ /* In CV_NORMAL mode, test if tout was reached */ if ( (itask == CV_NORMAL) && ((cv_mem->cv_tn-tout)*cv_mem->cv_h >= ZERO) ) { cv_mem->cv_tretlast = *tret = tout; ier = CVodeGetDky(cv_mem, tout, 0, yout); if (ier != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TOUT, tout); return(CV_ILL_INPUT); } return(CV_SUCCESS); } /* In CV_ONE_STEP mode, test if tn was returned */ if ( itask == CV_ONE_STEP && SUNRabs(cv_mem->cv_tn - cv_mem->cv_tretlast) > troundoff ) { cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); return(CV_SUCCESS); } /* Test for tn at tstop or near tstop */ if ( cv_mem->cv_tstopset ) { if ( SUNRabs(cv_mem->cv_tn - cv_mem->cv_tstop) <= troundoff ) { ier = CVodeGetDky(cv_mem, cv_mem->cv_tstop, 0, yout); if (ier != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_BAD_TSTOP, cv_mem->cv_tstop, cv_mem->cv_tn); return(CV_ILL_INPUT); } cv_mem->cv_tretlast = *tret = cv_mem->cv_tstop; cv_mem->cv_tstopset = SUNFALSE; return(CV_TSTOP_RETURN); } /* If next step would overtake tstop, adjust stepsize */ if ( (cv_mem->cv_tn + cv_mem->cv_hprime - cv_mem->cv_tstop)*cv_mem->cv_h > ZERO ) { cv_mem->cv_hprime = (cv_mem->cv_tstop - cv_mem->cv_tn)*(ONE-FOUR*cv_mem->cv_uround); cv_mem->cv_eta = cv_mem->cv_hprime / cv_mem->cv_h; } } } /* end stopping tests block at nst>0 */ /* * -------------------------------------------------- * 4. Looping point for internal steps * * 4.1. check for errors (too many steps, too much * accuracy requested, step size too small) * 4.2. take a new step (call cvStep) * 4.3. stop on error * 4.4. perform stop tests: * - check for root in last step * - check if tout was passed * - check if close to tstop * - check if in ONE_STEP mode (must return) * -------------------------------------------------- */ nstloc = 0; for(;;) { cv_mem->cv_next_h = cv_mem->cv_h; cv_mem->cv_next_q = cv_mem->cv_q; /* Reset and check ewt, ewtQ, ewtS */ if (cv_mem->cv_nst > 0) { ier = cv_mem->cv_efun(cv_mem->cv_zn[0], cv_mem->cv_ewt, cv_mem->cv_e_data); if(ier != 0) { if (cv_mem->cv_itol == CV_WF) cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_NOW_FAIL, cv_mem->cv_tn); else cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWT_NOW_BAD, cv_mem->cv_tn); istate = CV_ILL_INPUT; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); break; } if (cv_mem->cv_quadr && cv_mem->cv_errconQ) { ier = cvQuadEwtSet(cv_mem, cv_mem->cv_znQ[0], cv_mem->cv_ewtQ); if(ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTQ_NOW_BAD, cv_mem->cv_tn); istate = CV_ILL_INPUT; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); break; } } if (cv_mem->cv_sensi) { ier = cvSensEwtSet(cv_mem, cv_mem->cv_znS[0], cv_mem->cv_ewtS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTS_NOW_BAD, cv_mem->cv_tn); istate = CV_ILL_INPUT; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); break; } } if (cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS) { ier = cvQuadSensEwtSet(cv_mem, cv_mem->cv_znQS[0], cv_mem->cv_ewtQS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVode", MSGCV_EWTQS_NOW_BAD, cv_mem->cv_tn); istate = CV_ILL_INPUT; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); break; } } } /* Check for too many steps */ if ( (cv_mem->cv_mxstep>0) && (nstloc >= cv_mem->cv_mxstep) ) { cvProcessError(cv_mem, CV_TOO_MUCH_WORK, "CVODES", "CVode", MSGCV_MAX_STEPS, cv_mem->cv_tn); istate = CV_TOO_MUCH_WORK; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); break; } /* Check for too much accuracy requested */ nrm = N_VWrmsNorm(cv_mem->cv_zn[0], cv_mem->cv_ewt); if (cv_mem->cv_quadr && cv_mem->cv_errconQ) { nrm = cvQuadUpdateNorm(cv_mem, nrm, cv_mem->cv_znQ[0], cv_mem->cv_ewtQ); } if (cv_mem->cv_sensi && cv_mem->cv_errconS) { nrm = cvSensUpdateNorm(cv_mem, nrm, cv_mem->cv_znS[0], cv_mem->cv_ewtS); } if (cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS) { nrm = cvQuadSensUpdateNorm(cv_mem, nrm, cv_mem->cv_znQS[0], cv_mem->cv_ewtQS); } cv_mem->cv_tolsf = cv_mem->cv_uround * nrm; if (cv_mem->cv_tolsf > ONE) { cvProcessError(cv_mem, CV_TOO_MUCH_ACC, "CVODES", "CVode", MSGCV_TOO_MUCH_ACC, cv_mem->cv_tn); istate = CV_TOO_MUCH_ACC; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); cv_mem->cv_tolsf *= TWO; break; } else { cv_mem->cv_tolsf = ONE; } /* Check for h below roundoff level in tn */ if (cv_mem->cv_tn + cv_mem->cv_h == cv_mem->cv_tn) { cv_mem->cv_nhnil++; if (cv_mem->cv_nhnil <= cv_mem->cv_mxhnil) cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_HNIL, cv_mem->cv_tn, cv_mem->cv_h); if (cv_mem->cv_nhnil == cv_mem->cv_mxhnil) cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_HNIL_DONE); } /* Call cvStep to take a step */ kflag = cvStep(cv_mem); /* Process failed step cases, and exit loop */ if (kflag != CV_SUCCESS) { istate = cvHandleFailure(cv_mem, kflag); cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); break; } nstloc++; /* If tstop is set and was reached, reset tn = tstop */ if ( cv_mem->cv_tstopset ) { troundoff = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_h)); if ( SUNRabs(cv_mem->cv_tn - cv_mem->cv_tstop) <= troundoff) cv_mem->cv_tn = cv_mem->cv_tstop; } /* Check for root in last step taken. */ if (cv_mem->cv_nrtfn > 0) { retval = cvRcheck3(cv_mem); if (retval == RTFOUND) { /* A new root was found */ cv_mem->cv_irfnd = 1; istate = CV_ROOT_RETURN; cv_mem->cv_tretlast = *tret = cv_mem->cv_tlo; break; } else if (retval == CV_RTFUNC_FAIL) { /* g failed */ cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "cvRcheck3", MSGCV_RTFUNC_FAILED, cv_mem->cv_tlo); istate = CV_RTFUNC_FAIL; break; } /* If we are at the end of the first step and we still have * some event functions that are inactive, issue a warning * as this may indicate a user error in the implementation * of the root function. */ if (cv_mem->cv_nst==1) { inactive_roots = SUNFALSE; for (ir=0; ircv_nrtfn; ir++) { if (!cv_mem->cv_gactive[ir]) { inactive_roots = SUNTRUE; break; } } if ((cv_mem->cv_mxgnull > 0) && inactive_roots) { cvProcessError(cv_mem, CV_WARNING, "CVODES", "CVode", MSGCV_INACTIVE_ROOTS); } } } /* In NORMAL mode, check if tout reached */ if ( (itask == CV_NORMAL) && (cv_mem->cv_tn-tout)*cv_mem->cv_h >= ZERO ) { istate = CV_SUCCESS; cv_mem->cv_tretlast = *tret = tout; (void) CVodeGetDky(cv_mem, tout, 0, yout); cv_mem->cv_next_q = cv_mem->cv_qprime; cv_mem->cv_next_h = cv_mem->cv_hprime; break; } /* Check if tn is at tstop, or about to pass tstop */ if ( cv_mem->cv_tstopset ) { troundoff = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_h)); if ( SUNRabs(cv_mem->cv_tn - cv_mem->cv_tstop) <= troundoff) { (void) CVodeGetDky(cv_mem, cv_mem->cv_tstop, 0, yout); cv_mem->cv_tretlast = *tret = cv_mem->cv_tstop; cv_mem->cv_tstopset = SUNFALSE; istate = CV_TSTOP_RETURN; break; } if ( (cv_mem->cv_tn + cv_mem->cv_hprime - cv_mem->cv_tstop)*cv_mem->cv_h > ZERO ) { cv_mem->cv_hprime = (cv_mem->cv_tstop - cv_mem->cv_tn)*(ONE-FOUR*cv_mem->cv_uround); cv_mem->cv_eta = cv_mem->cv_hprime / cv_mem->cv_h; } } /* In ONE_STEP mode, copy y and exit loop */ if (itask == CV_ONE_STEP) { istate = CV_SUCCESS; cv_mem->cv_tretlast = *tret = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], yout); cv_mem->cv_next_q = cv_mem->cv_qprime; cv_mem->cv_next_h = cv_mem->cv_hprime; break; } } /* end looping for internal steps */ /* Load optional output */ if (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED1)) { cv_mem->cv_nniS = 0; cv_mem->cv_ncfnS = 0; for (is=0; iscv_Ns; is++) { cv_mem->cv_nniS += cv_mem->cv_nniS1[is]; cv_mem->cv_ncfnS += cv_mem->cv_ncfnS1[is]; } } return(istate); } /* * ----------------------------------------------------------------- * Interpolated output and extraction functions * ----------------------------------------------------------------- */ /* * CVodeGetDky * * This routine computes the k-th derivative of the interpolating * polynomial at the time t and stores the result in the vector dky. * The formula is: * q * dky = SUM c(j,k) * (t - tn)^(j-k) * h^(-j) * zn[j] , * j=k * where c(j,k) = j*(j-1)*...*(j-k+1), q is the current order, and * zn[j] is the j-th column of the Nordsieck history array. * * This function is called by CVode with k = 0 and t = tout, but * may also be called directly by the user. */ int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky) { realtype s, r; realtype tfuzz, tp, tn1; int i, j, nvec, ier; CVodeMem cv_mem; /* Check all inputs for legality */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (dky == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetDky", MSGCV_NULL_DKY); return(CV_BAD_DKY); } if ((k < 0) || (k > cv_mem->cv_q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetDky", MSGCV_BAD_K); return(CV_BAD_K); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_hu)); if (cv_mem->cv_hu < ZERO) tfuzz = -tfuzz; tp = cv_mem->cv_tn - cv_mem->cv_hu - tfuzz; tn1 = cv_mem->cv_tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetDky", MSGCV_BAD_T, t, cv_mem->cv_tn-cv_mem->cv_hu, cv_mem->cv_tn); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ nvec = 0; s = (t - cv_mem->cv_tn) / cv_mem->cv_h; for (j=cv_mem->cv_q; j >= k; j--) { cv_mem->cv_cvals[nvec] = ONE; for (i=j; i >= j-k+1; i--) cv_mem->cv_cvals[nvec] *= i; for (i=0; i < j-k; i++) cv_mem->cv_cvals[nvec] *= s; cv_mem->cv_Xvecs[nvec] = cv_mem->cv_zn[j]; nvec += 1; } ier = N_VLinearCombination(nvec, cv_mem->cv_cvals, cv_mem->cv_Xvecs, dky); if (ier != CV_SUCCESS) return (CV_VECTOROP_ERR); if (k == 0) return(CV_SUCCESS); r = SUNRpowerI(cv_mem->cv_h, -k); N_VScale(r, dky, dky); return(CV_SUCCESS); } /* * CVodeGetQuad * * This routine extracts quadrature solution into yQout at the * time which CVode returned the solution. * This is just a wrapper that calls CVodeGetQuadDky with k=0. */ int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuad", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = cv_mem->cv_tretlast; flag = CVodeGetQuadDky(cvode_mem,cv_mem->cv_tretlast,0,yQout); return(flag); } /* * CVodeGetQuadDky * * CVodeQuadDky computes the kth derivative of the yQ function at * time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * k=0, 1, ..., qu, where qu is the current order. * The derivative vector is returned in dky. This vector * must be allocated by the caller. It is only legal to call this * function after a successful return from CVode with quadrature * computation enabled. */ int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dkyQ) { realtype s, r; realtype tfuzz, tp, tn1; int i, j, nvec, ier; CVodeMem cv_mem; /* Check all inputs for legality */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if(cv_mem->cv_quadr != SUNTRUE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadDky", MSGCV_NO_QUAD); return(CV_NO_QUAD); } if (dkyQ == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetQuadDky", MSGCV_NULL_DKY); return(CV_BAD_DKY); } if ((k < 0) || (k > cv_mem->cv_q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetQuadDky", MSGCV_BAD_K); return(CV_BAD_K); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_hu)); if (cv_mem->cv_hu < ZERO) tfuzz = -tfuzz; tp = cv_mem->cv_tn - cv_mem->cv_hu - tfuzz; tn1 = cv_mem->cv_tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetQuadDky", MSGCV_BAD_T); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ nvec = 0; s = (t - cv_mem->cv_tn) / cv_mem->cv_h; for (j=cv_mem->cv_q; j >= k; j--) { cv_mem->cv_cvals[nvec] = ONE; for (i=j; i >= j-k+1; i--) cv_mem->cv_cvals[nvec] *= i; for (i=0; i < j-k; i++) cv_mem->cv_cvals[nvec] *= s; cv_mem->cv_Xvecs[nvec] = cv_mem->cv_znQ[j]; nvec += 1; } ier = N_VLinearCombination(nvec, cv_mem->cv_cvals, cv_mem->cv_Xvecs, dkyQ); if (ier != CV_SUCCESS) return (CV_VECTOROP_ERR); if (k == 0) return(CV_SUCCESS); r = SUNRpowerI(cv_mem->cv_h, -k); N_VScale(r, dkyQ, dkyQ); return(CV_SUCCESS); } /* * CVodeGetSens * * This routine extracts sensitivity solution into ySout at the * time at which CVode returned the solution. * This is just a wrapper that calls CVodeSensDky with k=0. */ int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSens", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = cv_mem->cv_tretlast; flag = CVodeGetSensDky(cvode_mem,cv_mem->cv_tretlast,0,ySout); return(flag); } /* * CVodeGetSens1 * * This routine extracts the is-th sensitivity solution into ySout * at the time at which CVode returned the solution. * This is just a wrapper that calls CVodeSensDky1 with k=0. */ int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSens1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = cv_mem->cv_tretlast; flag = CVodeGetSensDky1(cvode_mem,cv_mem->cv_tretlast,0,is,ySout); return(flag); } /* * CVodeGetSensDky * * If the user calls directly CVodeSensDky then s must be allocated * prior to this call. When CVodeSensDky is called by * CVodeGetSens, only ier=CV_SUCCESS, ier=CV_NO_SENS, or * ier=CV_BAD_T are possible. */ int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyS) { int ier=CV_SUCCESS; int is; CVodeMem cv_mem; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (dkyS == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky", MSGCV_NULL_DKYA); return(CV_BAD_DKY); } for (is=0; iscv_Ns; is++) { ier = CVodeGetSensDky1(cvode_mem,t,k,is,dkyS[is]); if (ier!=CV_SUCCESS) break; } return(ier); } /* * CVodeGetSensDky1 * * CVodeSensDky1 computes the kth derivative of the yS[is] function at * time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * is=0, 1, ..., Ns-1 and k=0, 1, ..., qu, where qu is the current * order. The derivative vector is returned in dky. This vector * must be allocated by the caller. It is only legal to call this * function after a successful return from CVode with sensitivity * computation enabled. */ int CVodeGetSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dkyS) { realtype s, r; realtype tfuzz, tp, tn1; int i, j, nvec, ier; CVodeMem cv_mem; /* Check all inputs for legality */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensDky1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if(cv_mem->cv_sensi != SUNTRUE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensDky1", MSGCV_NO_SENSI); return(CV_NO_SENS); } if (dkyS == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky1", MSGCV_NULL_DKY); return(CV_BAD_DKY); } if ((k < 0) || (k > cv_mem->cv_q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_K); return(CV_BAD_K); } if ((is < 0) || (is > cv_mem->cv_Ns-1)) { cvProcessError(cv_mem, CV_BAD_IS, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_IS); return(CV_BAD_IS); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_hu)); if (cv_mem->cv_hu < ZERO) tfuzz = -tfuzz; tp = cv_mem->cv_tn - cv_mem->cv_hu - tfuzz; tn1 = cv_mem->cv_tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetSensDky1", MSGCV_BAD_T); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ nvec = 0; s = (t - cv_mem->cv_tn) / cv_mem->cv_h; for (j=cv_mem->cv_q; j >= k; j--) { cv_mem->cv_cvals[nvec] = ONE; for (i=j; i >= j-k+1; i--) cv_mem->cv_cvals[nvec] *= i; for (i=0; i < j-k; i++) cv_mem->cv_cvals[nvec] *= s; cv_mem->cv_Xvecs[nvec] = cv_mem->cv_znS[j][is]; nvec += 1; } ier = N_VLinearCombination(nvec, cv_mem->cv_cvals, cv_mem->cv_Xvecs, dkyS); if (ier != CV_SUCCESS) return (CV_VECTOROP_ERR); if (k == 0) return(CV_SUCCESS); r = SUNRpowerI(cv_mem->cv_h, -k); N_VScale(r, dkyS, dkyS); return(CV_SUCCESS); } /* * CVodeGetQuadSens and CVodeGetQuadSens1 * * Extraction functions for all or only one of the quadrature sensitivity * vectors at the time at which CVode returned the ODE solution. */ int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSens", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = cv_mem->cv_tretlast; flag = CVodeGetQuadSensDky(cvode_mem,cv_mem->cv_tretlast,0,yQSout); return(flag); } int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout) { CVodeMem cv_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSens1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tret = cv_mem->cv_tretlast; flag = CVodeGetQuadSensDky1(cvode_mem,cv_mem->cv_tretlast,0,is,yQSout); return(flag); } /* * CVodeGetQuadSensDky and CVodeGetQuadSensDky1 * * Dense output functions for all or only one of the quadrature sensitivity * vectors (or derivative thereof). */ int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all) { int ier=CV_SUCCESS; int is; CVodeMem cv_mem; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensDky", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (dkyQS_all == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetSensDky", MSGCV_NULL_DKYA); return(CV_BAD_DKY); } for (is=0; iscv_Ns; is++) { ier = CVodeGetQuadSensDky1(cvode_mem,t,k,is,dkyQS_all[is]); if (ier!=CV_SUCCESS) break; } return(ier); } int CVodeGetQuadSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dkyQS) { realtype s, r; realtype tfuzz, tp, tn1; int i, j, nvec, ier; CVodeMem cv_mem; /* Check all inputs for legality */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensDky1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if(cv_mem->cv_quadr_sensi != SUNTRUE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensDky1", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } if (dkyQS == NULL) { cvProcessError(cv_mem, CV_BAD_DKY, "CVODES", "CVodeGetQuadSensDky1", MSGCV_NULL_DKY); return(CV_BAD_DKY); } if ((k < 0) || (k > cv_mem->cv_q)) { cvProcessError(cv_mem, CV_BAD_K, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_K); return(CV_BAD_K); } if ((is < 0) || (is > cv_mem->cv_Ns-1)) { cvProcessError(cv_mem, CV_BAD_IS, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_IS); return(CV_BAD_IS); } /* Allow for some slack */ tfuzz = FUZZ_FACTOR * cv_mem->cv_uround * (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_hu)); if (cv_mem->cv_hu < ZERO) tfuzz = -tfuzz; tp = cv_mem->cv_tn - cv_mem->cv_hu - tfuzz; tn1 = cv_mem->cv_tn + tfuzz; if ((t-tp)*(t-tn1) > ZERO) { cvProcessError(cv_mem, CV_BAD_T, "CVODES", "CVodeGetQuadSensDky1", MSGCV_BAD_T); return(CV_BAD_T); } /* Sum the differentiated interpolating polynomial */ nvec = 0; s = (t - cv_mem->cv_tn) / cv_mem->cv_h; for (j=cv_mem->cv_q; j >= k; j--) { cv_mem->cv_cvals[nvec] = ONE; for (i=j; i >= j-k+1; i--) cv_mem->cv_cvals[nvec] *= i; for (i=0; i < j-k; i++) cv_mem->cv_cvals[nvec] *= s; cv_mem->cv_Xvecs[nvec] = cv_mem->cv_znQS[j][is]; nvec += 1; } ier = N_VLinearCombination(nvec, cv_mem->cv_cvals, cv_mem->cv_Xvecs, dkyQS); if (ier != CV_SUCCESS) return (CV_VECTOROP_ERR); if (k == 0) return(CV_SUCCESS); r = SUNRpowerI(cv_mem->cv_h, -k); N_VScale(r, dkyQS, dkyQS); return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Deallocation functions * ----------------------------------------------------------------- */ /* * CVodeFree * * This routine frees the problem memory allocated by CVodeInit. * Such memory includes all the vectors allocated by cvAllocVectors, * and the memory lmem for the linear solver (deallocated by a call * to lfree), as well as (if Ns!=0) all memory allocated for * sensitivity computations by CVodeSensInit. */ void CVodeFree(void **cvode_mem) { CVodeMem cv_mem; if (*cvode_mem == NULL) return; cv_mem = (CVodeMem) (*cvode_mem); cvFreeVectors(cv_mem); if (cv_mem->ownNLS) { SUNNonlinSolFree(cv_mem->NLS); cv_mem->ownNLS = SUNFALSE; cv_mem->NLS = NULL; } CVodeQuadFree(cv_mem); CVodeSensFree(cv_mem); CVodeQuadSensFree(cv_mem); CVodeAdjFree(cv_mem); if (cv_mem->cv_lfree != NULL) cv_mem->cv_lfree(cv_mem); if (cv_mem->cv_nrtfn > 0) { free(cv_mem->cv_glo); cv_mem->cv_glo = NULL; free(cv_mem->cv_ghi); cv_mem->cv_ghi = NULL; free(cv_mem->cv_grout); cv_mem->cv_grout = NULL; free(cv_mem->cv_iroots); cv_mem->cv_iroots = NULL; free(cv_mem->cv_rootdir); cv_mem->cv_rootdir = NULL; free(cv_mem->cv_gactive); cv_mem->cv_gactive = NULL; } free(cv_mem->cv_cvals); cv_mem->cv_cvals = NULL; free(cv_mem->cv_Xvecs); cv_mem->cv_Xvecs = NULL; free(cv_mem->cv_Zvecs); cv_mem->cv_Zvecs = NULL; free(*cvode_mem); *cvode_mem = NULL; } /* * CVodeQuadFree * * CVodeQuadFree frees the problem memory in cvode_mem allocated * for quadrature integration. Its only argument is the pointer * cvode_mem returned by CVodeCreate. */ void CVodeQuadFree(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if(cv_mem->cv_QuadMallocDone) { cvQuadFreeVectors(cv_mem); cv_mem->cv_QuadMallocDone = SUNFALSE; cv_mem->cv_quadr = SUNFALSE; } } /* * CVodeSensFree * * CVodeSensFree frees the problem memory in cvode_mem allocated * for sensitivity analysis. Its only argument is the pointer * cvode_mem returned by CVodeCreate. */ void CVodeSensFree(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if(cv_mem->cv_SensMallocDone) { if (cv_mem->cv_stgr1alloc) { free(cv_mem->cv_ncfS1); cv_mem->cv_ncfS1 = NULL; free(cv_mem->cv_ncfnS1); cv_mem->cv_ncfnS1 = NULL; free(cv_mem->cv_nniS1); cv_mem->cv_nniS1 = NULL; cv_mem->cv_stgr1alloc = SUNFALSE; } cvSensFreeVectors(cv_mem); cv_mem->cv_SensMallocDone = SUNFALSE; cv_mem->cv_sensi = SUNFALSE; } /* free any vector wrappers */ if (cv_mem->simMallocDone) { N_VDestroy(cv_mem->ycor0Sim); cv_mem->ycor0Sim = NULL; N_VDestroy(cv_mem->ycorSim); cv_mem->ycorSim = NULL; N_VDestroy(cv_mem->ewtSim); cv_mem->ewtSim = NULL; cv_mem->simMallocDone = SUNFALSE; } if (cv_mem->stgMallocDone) { N_VDestroy(cv_mem->ycor0Stg); cv_mem->ycor0Stg = NULL; N_VDestroy(cv_mem->ycorStg); cv_mem->ycorStg = NULL; N_VDestroy(cv_mem->ewtStg); cv_mem->ewtStg = NULL; cv_mem->stgMallocDone = SUNFALSE; } /* if CVODES created a NLS object then free it */ if (cv_mem->ownNLSsim) { SUNNonlinSolFree(cv_mem->NLSsim); cv_mem->ownNLSsim = SUNFALSE; cv_mem->NLSsim = NULL; } if (cv_mem->ownNLSstg) { SUNNonlinSolFree(cv_mem->NLSstg); cv_mem->ownNLSstg = SUNFALSE; cv_mem->NLSstg = NULL; } if (cv_mem->ownNLSstg1) { SUNNonlinSolFree(cv_mem->NLSstg1); cv_mem->ownNLSstg1 = SUNFALSE; cv_mem->NLSstg1 = NULL; } } /* * CVodeQuadSensFree * * CVodeQuadSensFree frees the problem memory in cvode_mem allocated * for quadrature sensitivity analysis. Its only argument is the pointer * cvode_mem returned by CVodeCreate. */ void CVodeQuadSensFree(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if(cv_mem->cv_QuadSensMallocDone) { cvQuadSensFreeVectors(cv_mem); cv_mem->cv_QuadSensMallocDone = SUNFALSE; cv_mem->cv_quadr_sensi = SUNFALSE; } } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * cvCheckNvector * This routine checks if all required vector operations are present. * If any of them is missing it returns SUNFALSE. */ static booleantype cvCheckNvector(N_Vector tmpl) { if((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvconst == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvdiv == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvaddconst == NULL) || (tmpl->ops->nvmaxnorm == NULL) || (tmpl->ops->nvwrmsnorm == NULL) || (tmpl->ops->nvmin == NULL)) return(SUNFALSE); else return(SUNTRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * cvAllocVectors * * This routine allocates the CVODES vectors ewt, acor, tempv, ftemp, and * zn[0], ..., zn[maxord]. * If all memory allocations are successful, cvAllocVectors returns SUNTRUE. * Otherwise all allocated memory is freed and cvAllocVectors returns SUNFALSE. * This routine also sets the optional outputs lrw and liw, which are * (respectively) the lengths of the real and integer work spaces * allocated here. */ static booleantype cvAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ewt, acor, tempv, ftemp */ cv_mem->cv_ewt = N_VClone(tmpl); if (cv_mem->cv_ewt == NULL) return(SUNFALSE); cv_mem->cv_acor = N_VClone(tmpl); if (cv_mem->cv_acor == NULL) { N_VDestroy(cv_mem->cv_ewt); return(SUNFALSE); } cv_mem->cv_tempv = N_VClone(tmpl); if (cv_mem->cv_tempv == NULL) { N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); return(SUNFALSE); } cv_mem->cv_ftemp = N_VClone(tmpl); if (cv_mem->cv_ftemp == NULL) { N_VDestroy(cv_mem->cv_tempv); N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); return(SUNFALSE); } cv_mem->cv_vtemp1 = N_VClone(tmpl); if (cv_mem->cv_vtemp1 == NULL) { N_VDestroy(cv_mem->cv_ftemp); N_VDestroy(cv_mem->cv_tempv); N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); return(SUNFALSE); } cv_mem->cv_vtemp2 = N_VClone(tmpl); if (cv_mem->cv_vtemp2 == NULL) { N_VDestroy(cv_mem->cv_vtemp1); N_VDestroy(cv_mem->cv_ftemp); N_VDestroy(cv_mem->cv_tempv); N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); return(SUNFALSE); } cv_mem->cv_vtemp3 = N_VClone(tmpl); if (cv_mem->cv_vtemp3 == NULL) { N_VDestroy(cv_mem->cv_vtemp2); N_VDestroy(cv_mem->cv_vtemp1); N_VDestroy(cv_mem->cv_ftemp); N_VDestroy(cv_mem->cv_tempv); N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); return(SUNFALSE); } /* Allocate zn[0] ... zn[qmax] */ for (j=0; j <= cv_mem->cv_qmax; j++) { cv_mem->cv_zn[j] = N_VClone(tmpl); if (cv_mem->cv_zn[j] == NULL) { N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); N_VDestroy(cv_mem->cv_tempv); N_VDestroy(cv_mem->cv_ftemp); N_VDestroy(cv_mem->cv_vtemp1); N_VDestroy(cv_mem->cv_vtemp2); N_VDestroy(cv_mem->cv_vtemp3); for (i=0; i < j; i++) N_VDestroy(cv_mem->cv_zn[i]); return(SUNFALSE); } } /* Update solver workspace lengths */ cv_mem->cv_lrw += (cv_mem->cv_qmax + 8)*cv_mem->cv_lrw1; cv_mem->cv_liw += (cv_mem->cv_qmax + 8)*cv_mem->cv_liw1; /* Store the value of qmax used here */ cv_mem->cv_qmax_alloc = cv_mem->cv_qmax; return(SUNTRUE); } /* * cvFreeVectors * * This routine frees the CVODES vectors allocated in cvAllocVectors. */ static void cvFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_alloc; N_VDestroy(cv_mem->cv_ewt); N_VDestroy(cv_mem->cv_acor); N_VDestroy(cv_mem->cv_tempv); N_VDestroy(cv_mem->cv_ftemp); N_VDestroy(cv_mem->cv_vtemp1); N_VDestroy(cv_mem->cv_vtemp2); N_VDestroy(cv_mem->cv_vtemp3); for (j=0; j <= maxord; j++) N_VDestroy(cv_mem->cv_zn[j]); cv_mem->cv_lrw -= (maxord + 8)*cv_mem->cv_lrw1; cv_mem->cv_liw -= (maxord + 8)*cv_mem->cv_liw1; if (cv_mem->cv_VabstolMallocDone) { N_VDestroy(cv_mem->cv_Vabstol); cv_mem->cv_lrw -= cv_mem->cv_lrw1; cv_mem->cv_liw -= cv_mem->cv_liw1; } if (cv_mem->cv_constraintsMallocDone) { N_VDestroy(cv_mem->cv_constraints); cv_mem->cv_lrw -= cv_mem->cv_lrw1; cv_mem->cv_liw -= cv_mem->cv_liw1; } } /* * CVodeQuadAllocVectors * * NOTE: Space for ewtQ is allocated even when errconQ=SUNFALSE, * although in this case, ewtQ is never used. The reason for this * decision is to allow the user to re-initialize the quadrature * computation with errconQ=SUNTRUE, after an initialization with * errconQ=SUNFALSE, without new memory allocation within * CVodeQuadReInit. */ static booleantype cvQuadAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ewtQ */ cv_mem->cv_ewtQ = N_VClone(tmpl); if (cv_mem->cv_ewtQ == NULL) { return(SUNFALSE); } /* Allocate acorQ */ cv_mem->cv_acorQ = N_VClone(tmpl); if (cv_mem->cv_acorQ == NULL) { N_VDestroy(cv_mem->cv_ewtQ); return(SUNFALSE); } /* Allocate yQ */ cv_mem->cv_yQ = N_VClone(tmpl); if (cv_mem->cv_yQ == NULL) { N_VDestroy(cv_mem->cv_ewtQ); N_VDestroy(cv_mem->cv_acorQ); return(SUNFALSE); } /* Allocate tempvQ */ cv_mem->cv_tempvQ = N_VClone(tmpl); if (cv_mem->cv_tempvQ == NULL) { N_VDestroy(cv_mem->cv_ewtQ); N_VDestroy(cv_mem->cv_acorQ); N_VDestroy(cv_mem->cv_yQ); return(SUNFALSE); } /* Allocate zQn[0] ... zQn[maxord] */ for (j=0; j <= cv_mem->cv_qmax; j++) { cv_mem->cv_znQ[j] = N_VClone(tmpl); if (cv_mem->cv_znQ[j] == NULL) { N_VDestroy(cv_mem->cv_ewtQ); N_VDestroy(cv_mem->cv_acorQ); N_VDestroy(cv_mem->cv_yQ); N_VDestroy(cv_mem->cv_tempvQ); for (i=0; i < j; i++) N_VDestroy(cv_mem->cv_znQ[i]); return(SUNFALSE); } } /* Store the value of qmax used here */ cv_mem->cv_qmax_allocQ = cv_mem->cv_qmax; /* Update solver workspace lengths */ cv_mem->cv_lrw += (cv_mem->cv_qmax + 5)*cv_mem->cv_lrw1Q; cv_mem->cv_liw += (cv_mem->cv_qmax + 5)*cv_mem->cv_liw1Q; return(SUNTRUE); } /* * cvQuadFreeVectors * * This routine frees the CVODES vectors allocated in cvQuadAllocVectors. */ static void cvQuadFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_allocQ; N_VDestroy(cv_mem->cv_ewtQ); N_VDestroy(cv_mem->cv_acorQ); N_VDestroy(cv_mem->cv_yQ); N_VDestroy(cv_mem->cv_tempvQ); for (j=0; j<=maxord; j++) N_VDestroy(cv_mem->cv_znQ[j]); cv_mem->cv_lrw -= (maxord + 5)*cv_mem->cv_lrw1Q; cv_mem->cv_liw -= (maxord + 5)*cv_mem->cv_liw1Q; if (cv_mem->cv_VabstolQMallocDone) { N_VDestroy(cv_mem->cv_VabstolQ); cv_mem->cv_lrw -= cv_mem->cv_lrw1Q; cv_mem->cv_liw -= cv_mem->cv_liw1Q; } cv_mem->cv_VabstolQMallocDone = SUNFALSE; } /* * cvSensAllocVectors * * Create (through duplication) N_Vectors used for sensitivity analysis, * using the N_Vector 'tmpl' as a template. */ static booleantype cvSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate yS */ cv_mem->cv_yS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_yS == NULL) { return(SUNFALSE); } /* Allocate ewtS */ cv_mem->cv_ewtS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_ewtS == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate acorS */ cv_mem->cv_acorS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_acorS == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate tempvS */ cv_mem->cv_tempvS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_tempvS == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate ftempS */ cv_mem->cv_ftempS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_ftempS == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate znS */ for (j=0; j<=cv_mem->cv_qmax; j++) { cv_mem->cv_znS[j] = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_znS[j] == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ftempS, cv_mem->cv_Ns); for (i=0; icv_znS[i], cv_mem->cv_Ns); return(SUNFALSE); } } /* Allocate space for pbar and plist */ cv_mem->cv_pbar = NULL; cv_mem->cv_pbar = (realtype *)malloc(cv_mem->cv_Ns*sizeof(realtype)); if (cv_mem->cv_pbar == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ftempS, cv_mem->cv_Ns); for (i=0; i<=cv_mem->cv_qmax; i++) N_VDestroyVectorArray(cv_mem->cv_znS[i], cv_mem->cv_Ns); return(SUNFALSE); } cv_mem->cv_plist = NULL; cv_mem->cv_plist = (int *)malloc(cv_mem->cv_Ns*sizeof(int)); if (cv_mem->cv_plist == NULL) { N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ftempS, cv_mem->cv_Ns); for (i=0; i<=cv_mem->cv_qmax; i++) N_VDestroyVectorArray(cv_mem->cv_znS[i], cv_mem->cv_Ns); free(cv_mem->cv_pbar); cv_mem->cv_pbar = NULL; return(SUNFALSE); } /* Update solver workspace lengths */ cv_mem->cv_lrw += (cv_mem->cv_qmax + 6)*cv_mem->cv_Ns*cv_mem->cv_lrw1 + cv_mem->cv_Ns; cv_mem->cv_liw += (cv_mem->cv_qmax + 6)*cv_mem->cv_Ns*cv_mem->cv_liw1 + cv_mem->cv_Ns; /* Store the value of qmax used here */ cv_mem->cv_qmax_allocS = cv_mem->cv_qmax; return(SUNTRUE); } /* * cvSensFreeVectors * * This routine frees the CVODES vectors allocated in cvSensAllocVectors. */ static void cvSensFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_allocS; N_VDestroyVectorArray(cv_mem->cv_yS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ftempS, cv_mem->cv_Ns); for (j=0; j<=maxord; j++) N_VDestroyVectorArray(cv_mem->cv_znS[j], cv_mem->cv_Ns); free(cv_mem->cv_pbar); cv_mem->cv_pbar = NULL; free(cv_mem->cv_plist); cv_mem->cv_plist = NULL; cv_mem->cv_lrw -= (maxord + 6)*cv_mem->cv_Ns*cv_mem->cv_lrw1 + cv_mem->cv_Ns; cv_mem->cv_liw -= (maxord + 6)*cv_mem->cv_Ns*cv_mem->cv_liw1 + cv_mem->cv_Ns; if (cv_mem->cv_VabstolSMallocDone) { N_VDestroyVectorArray(cv_mem->cv_VabstolS, cv_mem->cv_Ns); cv_mem->cv_lrw -= cv_mem->cv_Ns*cv_mem->cv_lrw1; cv_mem->cv_liw -= cv_mem->cv_Ns*cv_mem->cv_liw1; } if (cv_mem->cv_SabstolSMallocDone) { free(cv_mem->cv_SabstolS); cv_mem->cv_SabstolS = NULL; cv_mem->cv_lrw -= cv_mem->cv_Ns; } cv_mem->cv_VabstolSMallocDone = SUNFALSE; cv_mem->cv_SabstolSMallocDone = SUNFALSE; } /* * cvQuadSensAllocVectors * * Create (through duplication) N_Vectors used for quadrature sensitivity analysis, * using the N_Vector 'tmpl' as a template. */ static booleantype cvQuadSensAllocVectors(CVodeMem cv_mem, N_Vector tmpl) { int i, j; /* Allocate ftempQ */ cv_mem->cv_ftempQ = N_VClone(tmpl); if (cv_mem->cv_ftempQ == NULL) { return(SUNFALSE); } /* Allocate yQS */ cv_mem->cv_yQS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_yQS == NULL) { N_VDestroy(cv_mem->cv_ftempQ); return(SUNFALSE); } /* Allocate ewtQS */ cv_mem->cv_ewtQS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_ewtQS == NULL) { N_VDestroy(cv_mem->cv_ftempQ); N_VDestroyVectorArray(cv_mem->cv_yQS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate acorQS */ cv_mem->cv_acorQS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_acorQS == NULL) { N_VDestroy(cv_mem->cv_ftempQ); N_VDestroyVectorArray(cv_mem->cv_yQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtQS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate tempvQS */ cv_mem->cv_tempvQS = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_tempvQS == NULL) { N_VDestroy(cv_mem->cv_ftempQ); N_VDestroyVectorArray(cv_mem->cv_yQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorQS, cv_mem->cv_Ns); return(SUNFALSE); } /* Allocate znQS */ for (j=0; j<=cv_mem->cv_qmax; j++) { cv_mem->cv_znQS[j] = N_VCloneVectorArray(cv_mem->cv_Ns, tmpl); if (cv_mem->cv_znQS[j] == NULL) { N_VDestroy(cv_mem->cv_ftempQ); N_VDestroyVectorArray(cv_mem->cv_yQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvQS, cv_mem->cv_Ns); for (i=0; icv_znQS[i], cv_mem->cv_Ns); return(SUNFALSE); } } /* Update solver workspace lengths */ cv_mem->cv_lrw += (cv_mem->cv_qmax + 5)*cv_mem->cv_Ns*cv_mem->cv_lrw1Q; cv_mem->cv_liw += (cv_mem->cv_qmax + 5)*cv_mem->cv_Ns*cv_mem->cv_liw1Q; /* Store the value of qmax used here */ cv_mem->cv_qmax_allocQS = cv_mem->cv_qmax; return(SUNTRUE); } /* * cvQuadSensFreeVectors * * This routine frees the CVODES vectors allocated in cvQuadSensAllocVectors. */ static void cvQuadSensFreeVectors(CVodeMem cv_mem) { int j, maxord; maxord = cv_mem->cv_qmax_allocQS; N_VDestroy(cv_mem->cv_ftempQ); N_VDestroyVectorArray(cv_mem->cv_yQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_ewtQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_acorQS, cv_mem->cv_Ns); N_VDestroyVectorArray(cv_mem->cv_tempvQS, cv_mem->cv_Ns); for (j=0; j<=maxord; j++) N_VDestroyVectorArray(cv_mem->cv_znQS[j], cv_mem->cv_Ns); cv_mem->cv_lrw -= (maxord + 5)*cv_mem->cv_Ns*cv_mem->cv_lrw1Q; cv_mem->cv_liw -= (maxord + 5)*cv_mem->cv_Ns*cv_mem->cv_liw1Q; if (cv_mem->cv_VabstolQSMallocDone) { N_VDestroyVectorArray(cv_mem->cv_VabstolQS, cv_mem->cv_Ns); cv_mem->cv_lrw -= cv_mem->cv_Ns*cv_mem->cv_lrw1Q; cv_mem->cv_liw -= cv_mem->cv_Ns*cv_mem->cv_liw1Q; } if (cv_mem->cv_SabstolQSMallocDone) { free(cv_mem->cv_SabstolQS); cv_mem->cv_SabstolQS = NULL; cv_mem->cv_lrw -= cv_mem->cv_Ns; } cv_mem->cv_VabstolQSMallocDone = SUNFALSE; cv_mem->cv_SabstolQSMallocDone = SUNFALSE; } /* * ----------------------------------------------------------------- * Initial stepsize calculation * ----------------------------------------------------------------- */ /* * cvHin * * This routine computes a tentative initial step size h0. * If tout is too close to tn (= t0), then cvHin returns CV_TOO_CLOSE * and h remains uninitialized. Note that here tout is either the value * passed to CVode at the first call or the value of tstop (if tstop is * enabled and it is closer to t0=tn than tout). * If any RHS function fails unrecoverably, cvHin returns CV_*RHSFUNC_FAIL. * If any RHS function fails recoverably too many times and recovery is * not possible, cvHin returns CV_REPTD_*RHSFUNC_ERR. * Otherwise, cvHin sets h to the chosen value h0 and returns CV_SUCCESS. * * The algorithm used seeks to find h0 as a solution of * (WRMS norm of (h0^2 ydd / 2)) = 1, * where ydd = estimated second derivative of y. Here, y includes * all variables considered in the error test. * * We start with an initial estimate equal to the geometric mean of the * lower and upper bounds on the step size. * * Loop up to MAX_ITERS times to find h0. * Stop if new and previous values differ by a factor < 2. * Stop if hnew/hg > 2 after one iteration, as this probably means * that the ydd value is bad because of cancellation error. * * For each new proposed hg, we allow MAX_ITERS attempts to * resolve a possible recoverable failure from f() by reducing * the proposed stepsize by a factor of 0.2. If a legal stepsize * still cannot be found, fall back on a previous value if possible, * or else return CV_REPTD_RHSFUNC_ERR. * * Finally, we apply a bias (0.5) and verify that h0 is within bounds. */ static int cvHin(CVodeMem cv_mem, realtype tout) { int retval, sign, count1, count2; realtype tdiff, tdist, tround, hlb, hub; realtype hg, hgs, hs, hnew, hrat, h0, yddnrm; booleantype hgOK; /* If tout is too close to tn, give up */ if ((tdiff = tout-cv_mem->cv_tn) == ZERO) return(CV_TOO_CLOSE); sign = (tdiff > ZERO) ? 1 : -1; tdist = SUNRabs(tdiff); tround = cv_mem->cv_uround * SUNMAX(SUNRabs(cv_mem->cv_tn), SUNRabs(tout)); if (tdist < TWO*tround) return(CV_TOO_CLOSE); /* Set lower and upper bounds on h0, and take geometric mean as first trial value. Exit with this value if the bounds cross each other. */ hlb = HLB_FACTOR * tround; hub = cvUpperBoundH0(cv_mem, tdist); hg = SUNRsqrt(hlb*hub); if (hub < hlb) { if (sign == -1) cv_mem->cv_h = -hg; else cv_mem->cv_h = hg; return(CV_SUCCESS); } /* Outer loop */ hs = hg; /* safeguard against 'uninitialized variable' warning */ for(count1 = 1; count1 <= MAX_ITERS; count1++) { /* Attempts to estimate ydd */ hgOK = SUNFALSE; for (count2 = 1; count2 <= MAX_ITERS; count2++) { hgs = hg*sign; retval = cvYddNorm(cv_mem, hgs, &yddnrm); /* If a RHS function failed unrecoverably, give up */ if (retval < 0) return(retval); /* If successful, we can use ydd */ if (retval == CV_SUCCESS) {hgOK = SUNTRUE; break;} /* A RHS function failed recoverably; cut step size and test it again */ hg *= POINT2; } /* If a RHS function failed recoverably MAX_ITERS times */ if (!hgOK) { /* Exit if this is the first or second pass. No recovery possible */ if (count1 <= 2) { if (retval == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); if (retval == QRHSFUNC_RECVR) return(CV_REPTD_QRHSFUNC_ERR); if (retval == SRHSFUNC_RECVR) return(CV_REPTD_SRHSFUNC_ERR); } /* We have a fall-back option. The value hs is a previous hnew which passed through f(). Use it and break */ hnew = hs; break; } /* The proposed step size is feasible. Save it. */ hs = hg; /* Propose new step size */ hnew = (yddnrm*hub*hub > TWO) ? SUNRsqrt(TWO/yddnrm) : SUNRsqrt(hg*hub); /* If last pass, stop now with hnew */ if (count1 == MAX_ITERS) break; hrat = hnew/hg; /* Accept hnew if it does not differ from hg by more than a factor of 2 */ if ((hrat > HALF) && (hrat < TWO)) break; /* After one pass, if ydd seems to be bad, use fall-back value. */ if ((count1 > 1) && (hrat > TWO)) { hnew = hg; break; } /* Send this value back through f() */ hg = hnew; } /* Apply bounds, bias factor, and attach sign */ h0 = H_BIAS*hnew; if (h0 < hlb) h0 = hlb; if (h0 > hub) h0 = hub; if (sign == -1) h0 = -h0; cv_mem->cv_h = h0; return(CV_SUCCESS); } /* * cvUpperBoundH0 * * This routine sets an upper bound on abs(h0) based on * tdist = tn - t0 and the values of y[i]/y'[i]. */ static realtype cvUpperBoundH0(CVodeMem cv_mem, realtype tdist) { realtype hub_inv, hubQ_inv, hubS_inv, hubQS_inv, hub; N_Vector temp1, temp2; N_Vector tempQ1, tempQ2; N_Vector *tempS1; N_Vector *tempQS1; int is; /* * Bound based on |y|/|y'| -- allow at most an increase of * HUB_FACTOR in y0 (based on a forward Euler step). The weight * factor is used as a safeguard against zero components in y0. */ temp1 = cv_mem->cv_tempv; temp2 = cv_mem->cv_acor; N_VAbs(cv_mem->cv_zn[0], temp2); cv_mem->cv_efun(cv_mem->cv_zn[0], temp1, cv_mem->cv_e_data); N_VInv(temp1, temp1); N_VLinearSum(HUB_FACTOR, temp2, ONE, temp1, temp1); N_VAbs(cv_mem->cv_zn[1], temp2); N_VDiv(temp2, temp1, temp1); hub_inv = N_VMaxNorm(temp1); /* Bound based on |yQ|/|yQ'| */ if (cv_mem->cv_quadr && cv_mem->cv_errconQ) { tempQ1 = cv_mem->cv_tempvQ; tempQ2 = cv_mem->cv_acorQ; N_VAbs(cv_mem->cv_znQ[0], tempQ2); cvQuadEwtSet(cv_mem, cv_mem->cv_znQ[0], tempQ1); N_VInv(tempQ1, tempQ1); N_VLinearSum(HUB_FACTOR, tempQ2, ONE, tempQ1, tempQ1); N_VAbs(cv_mem->cv_znQ[1], tempQ2); N_VDiv(tempQ2, tempQ1, tempQ1); hubQ_inv = N_VMaxNorm(tempQ1); if (hubQ_inv > hub_inv) hub_inv = hubQ_inv; } /* Bound based on |yS|/|yS'| */ if (cv_mem->cv_sensi && cv_mem->cv_errconS) { tempS1 = cv_mem->cv_acorS; cvSensEwtSet(cv_mem, cv_mem->cv_znS[0], tempS1); for (is=0; iscv_Ns; is++) { N_VAbs(cv_mem->cv_znS[0][is], temp2); N_VInv(tempS1[is], temp1); N_VLinearSum(HUB_FACTOR, temp2, ONE, temp1, temp1); N_VAbs(cv_mem->cv_znS[1][is], temp2); N_VDiv(temp2, temp1, temp1); hubS_inv = N_VMaxNorm(temp1); if (hubS_inv > hub_inv) hub_inv = hubS_inv; } } /* Bound based on |yQS|/|yQS'| */ if (cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS) { tempQ1 = cv_mem->cv_tempvQ; tempQ2 = cv_mem->cv_acorQ; tempQS1 = cv_mem->cv_acorQS; cvQuadSensEwtSet(cv_mem, cv_mem->cv_znQS[0], tempQS1); for (is=0; iscv_Ns; is++) { N_VAbs(cv_mem->cv_znQS[0][is], tempQ2); N_VInv(tempQS1[is], tempQ1); N_VLinearSum(HUB_FACTOR, tempQ2, ONE, tempQ1, tempQ1); N_VAbs(cv_mem->cv_znQS[1][is], tempQ2); N_VDiv(tempQ2, tempQ1, tempQ1); hubQS_inv = N_VMaxNorm(tempQ1); if (hubQS_inv > hub_inv) hub_inv = hubQS_inv; } } /* * bound based on tdist -- allow at most a step of magnitude * HUB_FACTOR * tdist */ hub = HUB_FACTOR*tdist; /* Use the smaler of the two */ if (hub*hub_inv > ONE) hub = ONE/hub_inv; return(hub); } /* * cvYddNorm * * This routine computes an estimate of the second derivative of Y * using a difference quotient, and returns its WRMS norm. * * Y contains all variables included in the error test. */ static int cvYddNorm(CVodeMem cv_mem, realtype hg, realtype *yddnrm) { int retval; N_Vector wrk1, wrk2; /* y <- h*y'(t) + y(t) */ N_VLinearSum(hg, cv_mem->cv_zn[1], ONE, cv_mem->cv_zn[0], cv_mem->cv_y); if (cv_mem->cv_sensi && cv_mem->cv_errconS) { retval = N_VLinearSumVectorArray(cv_mem->cv_Ns, hg, cv_mem->cv_znS[1], ONE, cv_mem->cv_znS[0], cv_mem->cv_yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } /* tempv <- f(t+h, h*y'(t)+y(t)) */ retval = cv_mem->cv_f(cv_mem->cv_tn+hg, cv_mem->cv_y, cv_mem->cv_tempv, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); if (cv_mem->cv_quadr && cv_mem->cv_errconQ) { retval = cv_mem->cv_fQ(cv_mem->cv_tn+hg, cv_mem->cv_y, cv_mem->cv_tempvQ, cv_mem->cv_user_data); cv_mem->cv_nfQe++; if (retval < 0) return(CV_QRHSFUNC_FAIL); if (retval > 0) return(QRHSFUNC_RECVR); } if (cv_mem->cv_sensi && cv_mem->cv_errconS) { wrk1 = cv_mem->cv_ftemp; wrk2 = cv_mem->cv_acor; retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn+hg, cv_mem->cv_y, cv_mem->cv_tempv, cv_mem->cv_yS, cv_mem->cv_tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); } if (cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS) { wrk1 = cv_mem->cv_ftemp; wrk2 = cv_mem->cv_acorQ; retval = cv_mem->cv_fQS(cv_mem->cv_Ns, cv_mem->cv_tn+hg, cv_mem->cv_y, cv_mem->cv_yS, cv_mem->cv_tempvQ, cv_mem->cv_tempvQS, cv_mem->cv_fQS_data, wrk1, wrk2); cv_mem->cv_nfQSe++; if (retval < 0) return(CV_QSRHSFUNC_FAIL); if (retval > 0) return(QSRHSFUNC_RECVR); } /* Load estimate of ||y''|| into tempv: * tempv <- (1/h) * f(t+h, h*y'(t)+y(t)) - y'(t) */ N_VLinearSum(ONE/hg, cv_mem->cv_tempv, -ONE/hg, cv_mem->cv_zn[1], cv_mem->cv_tempv); *yddnrm = N_VWrmsNorm(cv_mem->cv_tempv, cv_mem->cv_ewt); if (cv_mem->cv_quadr && cv_mem->cv_errconQ) { N_VLinearSum(ONE/hg, cv_mem->cv_tempvQ, -ONE/hg, cv_mem->cv_znQ[1], cv_mem->cv_tempvQ); *yddnrm = cvQuadUpdateNorm(cv_mem, *yddnrm, cv_mem->cv_tempvQ, cv_mem->cv_ewtQ); } if (cv_mem->cv_sensi && cv_mem->cv_errconS) { retval = N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE/hg, cv_mem->cv_tempvS, -ONE/hg, cv_mem->cv_znS[1], cv_mem->cv_tempvS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); *yddnrm = cvSensUpdateNorm(cv_mem, *yddnrm, cv_mem->cv_tempvS, cv_mem->cv_ewtS); } if (cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS) { retval = N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE/hg, cv_mem->cv_tempvQS, -ONE/hg, cv_mem->cv_znQS[1], cv_mem->cv_tempvQS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); *yddnrm = cvQuadSensUpdateNorm(cv_mem, *yddnrm, cv_mem->cv_tempvQS, cv_mem->cv_ewtQS); } return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Initial setup * ----------------------------------------------------------------- */ /* * cvInitialSetup * * This routine performs input consistency checks at the first step. * If needed, it also checks the linear solver module and calls the * linear solver initialization routine. */ static int cvInitialSetup(CVodeMem cv_mem) { int ier; booleantype conOK; /* Did the user specify tolerances? */ if (cv_mem->cv_itol == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NO_TOL); return(CV_ILL_INPUT); } /* Set data for efun */ if (cv_mem->cv_user_efun) cv_mem->cv_e_data = cv_mem->cv_user_data; else cv_mem->cv_e_data = cv_mem; /* Check to see if y0 satisfies constraints */ if (cv_mem->cv_constraintsSet) { if (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_SIMULTANEOUS)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_BAD_ISM_CONSTR); return(CV_ILL_INPUT); } conOK = N_VConstrMask(cv_mem->cv_constraints, cv_mem->cv_zn[0], cv_mem->cv_tempv); if (!conOK) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_Y0_FAIL_CONSTR); return(CV_ILL_INPUT); } } /* Load initial error weights */ ier = cv_mem->cv_efun(cv_mem->cv_zn[0], cv_mem->cv_ewt, cv_mem->cv_e_data); if (ier != 0) { if (cv_mem->cv_itol == CV_WF) cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_EWT_FAIL); else cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_BAD_EWT); return(CV_ILL_INPUT); } /* Quadrature initial setup */ if (cv_mem->cv_quadr && cv_mem->cv_errconQ) { /* Did the user specify tolerances? */ if (cv_mem->cv_itolQ == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NO_TOLQ); return(CV_ILL_INPUT); } /* Load ewtQ */ ier = cvQuadEwtSet(cv_mem, cv_mem->cv_znQ[0], cv_mem->cv_ewtQ); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_BAD_EWTQ); return(CV_ILL_INPUT); } } if (!cv_mem->cv_quadr) cv_mem->cv_errconQ = SUNFALSE; /* Forward sensitivity initial setup */ if (cv_mem->cv_sensi) { /* Did the user specify tolerances? */ if (cv_mem->cv_itolS == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NO_TOLS); return(CV_ILL_INPUT); } /* If using the internal DQ functions, we must have access to the problem parameters */ if(cv_mem->cv_fSDQ && (cv_mem->cv_p == NULL)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NULL_P); return(CV_ILL_INPUT); } /* Load ewtS */ ier = cvSensEwtSet(cv_mem, cv_mem->cv_znS[0], cv_mem->cv_ewtS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_BAD_EWTS); return(CV_ILL_INPUT); } } /* FSA of quadrature variables */ if (cv_mem->cv_quadr_sensi) { /* If using the internal DQ functions, we must have access to fQ * (i.e. quadrature integration must be enabled) and to the problem parameters */ if (cv_mem->cv_fQSDQ) { /* Test if quadratures are defined, so we can use fQ */ if (!cv_mem->cv_quadr) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NULL_FQ); return(CV_ILL_INPUT); } /* Test if we have the problem parameters */ if(cv_mem->cv_p == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NULL_P); return(CV_ILL_INPUT); } } if (cv_mem->cv_errconQS) { /* Did the user specify tolerances? */ if (cv_mem->cv_itolQS == CV_NN) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NO_TOLQS); return(CV_ILL_INPUT); } /* If needed, did the user provide quadrature tolerances? */ if ( (cv_mem->cv_itolQS == CV_EE) && (cv_mem->cv_itolQ == CV_NN) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_NO_TOLQ); return(CV_ILL_INPUT); } /* Load ewtQS */ ier = cvQuadSensEwtSet(cv_mem, cv_mem->cv_znQS[0], cv_mem->cv_ewtQS); if (ier != 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "cvInitialSetup", MSGCV_BAD_EWTQS); return(CV_ILL_INPUT); } } } else { cv_mem->cv_errconQS = SUNFALSE; } /* Call linit function (if it exists) */ if (cv_mem->cv_linit != NULL) { ier = cv_mem->cv_linit(cv_mem); if (ier != 0) { cvProcessError(cv_mem, CV_LINIT_FAIL, "CVODES", "cvInitialSetup", MSGCV_LINIT_FAIL); return(CV_LINIT_FAIL); } } /* Initialize the nonlinear solver (must occur after linear solver is initialized) so that lsetup and lsolve pointer have been set */ /* always initialize the ODE NLS in case the user disables sensitivities */ ier = cvNlsInit(cv_mem); if (ier != 0) { cvProcessError(cv_mem, CV_NLS_INIT_FAIL, "CVODES", "cvInitialSetup", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } if (cv_mem->NLSsim != NULL) { ier = cvNlsInitSensSim(cv_mem); if (ier != 0) { cvProcessError(cv_mem, CV_NLS_INIT_FAIL, "CVODES", "cvInitialSetup", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } } if (cv_mem->NLSstg != NULL) { ier = cvNlsInitSensStg(cv_mem); if (ier != 0) { cvProcessError(cv_mem, CV_NLS_INIT_FAIL, "CVODES", "cvInitialSetup", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } } if (cv_mem->NLSstg1 != NULL) { ier = cvNlsInitSensStg1(cv_mem); if (ier != 0) { cvProcessError(cv_mem, CV_NLS_INIT_FAIL, "CVODES", "cvInitialSetup", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } } return(CV_SUCCESS); } /* * cvEwtSet * * This routine is responsible for setting the error weight vector ewt, * according to tol_type, as follows: * * (1) ewt[i] = 1 / (reltol * SUNRabs(ycur[i]) + *abstol), i=0,...,neq-1 * if tol_type = CV_SS * (2) ewt[i] = 1 / (reltol * SUNRabs(ycur[i]) + abstol[i]), i=0,...,neq-1 * if tol_type = CV_SV * * cvEwtSet returns 0 if ewt is successfully set as above to a * positive vector and -1 otherwise. In the latter case, ewt is * considered undefined. * * All the real work is done in the routines cvEwtSetSS, cvEwtSetSV. */ int cvEwtSet(N_Vector ycur, N_Vector weight, void *data) { CVodeMem cv_mem; int flag = 0; /* data points to cv_mem here */ cv_mem = (CVodeMem) data; switch(cv_mem->cv_itol) { case CV_SS: flag = cvEwtSetSS(cv_mem, ycur, weight); break; case CV_SV: flag = cvEwtSetSV(cv_mem, ycur, weight); break; } return(flag); } /* * cvEwtSetSS * * This routine sets ewt as decribed above in the case tol_type = CV_SS. * It tests for non-positive components before inverting. cvEwtSetSS * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered undefined. */ static int cvEwtSetSS(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, cv_mem->cv_tempv); N_VScale(cv_mem->cv_reltol, cv_mem->cv_tempv, cv_mem->cv_tempv); N_VAddConst(cv_mem->cv_tempv, cv_mem->cv_Sabstol, cv_mem->cv_tempv); if (N_VMin(cv_mem->cv_tempv) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempv, weight); return(0); } /* * cvEwtSetSV * * This routine sets ewt as decribed above in the case tol_type = CV_SV. * It tests for non-positive components before inverting. cvEwtSetSV * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered undefined. */ static int cvEwtSetSV(CVodeMem cv_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, cv_mem->cv_tempv); N_VLinearSum(cv_mem->cv_reltol, cv_mem->cv_tempv, ONE, cv_mem->cv_Vabstol, cv_mem->cv_tempv); if (N_VMin(cv_mem->cv_tempv) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempv, weight); return(0); } /* * cvQuadEwtSet * */ static int cvQuadEwtSet(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) { int flag=0; switch (cv_mem->cv_itolQ) { case CV_SS: flag = cvQuadEwtSetSS(cv_mem, qcur, weightQ); break; case CV_SV: flag = cvQuadEwtSetSV(cv_mem, qcur, weightQ); break; } return(flag); } /* * cvQuadEwtSetSS * */ static int cvQuadEwtSetSS(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) { N_VAbs(qcur, cv_mem->cv_tempvQ); N_VScale(cv_mem->cv_reltolQ, cv_mem->cv_tempvQ, cv_mem->cv_tempvQ); N_VAddConst(cv_mem->cv_tempvQ, cv_mem->cv_SabstolQ, cv_mem->cv_tempvQ); if (N_VMin(cv_mem->cv_tempvQ) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempvQ, weightQ); return(0); } /* * cvQuadEwtSetSV * */ static int cvQuadEwtSetSV(CVodeMem cv_mem, N_Vector qcur, N_Vector weightQ) { N_VAbs(qcur, cv_mem->cv_tempvQ); N_VLinearSum(cv_mem->cv_reltolQ, cv_mem->cv_tempvQ, ONE, cv_mem->cv_VabstolQ, cv_mem->cv_tempvQ); if (N_VMin(cv_mem->cv_tempvQ) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempvQ, weightQ); return(0); } /* * cvSensEwtSet * */ static int cvSensEwtSet(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) { int flag=0; switch (cv_mem->cv_itolS) { case CV_EE: flag = cvSensEwtSetEE(cv_mem, yScur, weightS); break; case CV_SS: flag = cvSensEwtSetSS(cv_mem, yScur, weightS); break; case CV_SV: flag = cvSensEwtSetSV(cv_mem, yScur, weightS); break; } return(flag); } /* * cvSensEwtSetEE * * In this case, the error weight vector for the i-th sensitivity is set to * * ewtS_i = pbar_i * efun(pbar_i*yS_i) * * In other words, the scaled sensitivity pbar_i * yS_i has the same error * weight vector calculation as the solution vector. * */ static int cvSensEwtSetEE(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) { int is; N_Vector pyS; int flag; /* Use tempvS[0] as temporary storage for the scaled sensitivity */ pyS = cv_mem->cv_tempvS[0]; for (is=0; iscv_Ns; is++) { N_VScale(cv_mem->cv_pbar[is], yScur[is], pyS); flag = cv_mem->cv_efun(pyS, weightS[is], cv_mem->cv_e_data); if (flag != 0) return(-1); N_VScale(cv_mem->cv_pbar[is], weightS[is], weightS[is]); } return(0); } /* * cvSensEwtSetSS * */ static int cvSensEwtSetSS(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) { int is; for (is=0; iscv_Ns; is++) { N_VAbs(yScur[is], cv_mem->cv_tempv); N_VScale(cv_mem->cv_reltolS, cv_mem->cv_tempv, cv_mem->cv_tempv); N_VAddConst(cv_mem->cv_tempv, cv_mem->cv_SabstolS[is], cv_mem->cv_tempv); if (N_VMin(cv_mem->cv_tempv) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempv, weightS[is]); } return(0); } /* * cvSensEwtSetSV * */ static int cvSensEwtSetSV(CVodeMem cv_mem, N_Vector *yScur, N_Vector *weightS) { int is; for (is=0; iscv_Ns; is++) { N_VAbs(yScur[is], cv_mem->cv_tempv); N_VLinearSum(cv_mem->cv_reltolS, cv_mem->cv_tempv, ONE, cv_mem->cv_VabstolS[is], cv_mem->cv_tempv); if (N_VMin(cv_mem->cv_tempv) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempv, weightS[is]); } return(0); } /* * cvQuadSensEwtSet * */ static int cvQuadSensEwtSet(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS) { int flag=0; switch (cv_mem->cv_itolQS) { case CV_EE: flag = cvQuadSensEwtSetEE(cv_mem, yQScur, weightQS); break; case CV_SS: flag = cvQuadSensEwtSetSS(cv_mem, yQScur, weightQS); break; case CV_SV: flag = cvQuadSensEwtSetSV(cv_mem, yQScur, weightQS); break; } return(flag); } /* * cvQuadSensEwtSetEE * * In this case, the error weight vector for the i-th quadrature sensitivity * is set to * * ewtQS_i = pbar_i * cvQuadEwtSet(pbar_i*yQS_i) * * In other words, the scaled sensitivity pbar_i * yQS_i has the same error * weight vector calculation as the quadrature vector. * */ static int cvQuadSensEwtSetEE(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS) { int is; N_Vector pyS; int flag; /* Use tempvQS[0] as temporary storage for the scaled sensitivity */ pyS = cv_mem->cv_tempvQS[0]; for (is=0; iscv_Ns; is++) { N_VScale(cv_mem->cv_pbar[is], yQScur[is], pyS); flag = cvQuadEwtSet(cv_mem, pyS, weightQS[is]); if (flag != 0) return(-1); N_VScale(cv_mem->cv_pbar[is], weightQS[is], weightQS[is]); } return(0); } static int cvQuadSensEwtSetSS(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS) { int is; for (is=0; iscv_Ns; is++) { N_VAbs(yQScur[is], cv_mem->cv_tempvQ); N_VScale(cv_mem->cv_reltolQS, cv_mem->cv_tempvQ, cv_mem->cv_tempvQ); N_VAddConst(cv_mem->cv_tempvQ, cv_mem->cv_SabstolQS[is], cv_mem->cv_tempvQ); if (N_VMin(cv_mem->cv_tempvQ) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempvQ, weightQS[is]); } return(0); } static int cvQuadSensEwtSetSV(CVodeMem cv_mem, N_Vector *yQScur, N_Vector *weightQS) { int is; for (is=0; iscv_Ns; is++) { N_VAbs(yQScur[is], cv_mem->cv_tempvQ); N_VLinearSum(cv_mem->cv_reltolQS, cv_mem->cv_tempvQ, ONE, cv_mem->cv_VabstolQS[is], cv_mem->cv_tempvQ); if (N_VMin(cv_mem->cv_tempvQ) <= ZERO) return(-1); N_VInv(cv_mem->cv_tempvQ, weightQS[is]); } return(0); } /* * ----------------------------------------------------------------- * Main cvStep function * ----------------------------------------------------------------- */ /* * cvStep * * This routine performs one internal cvode step, from tn to tn + h. * It calls other routines to do all the work. * * The main operations done here are as follows: * - preliminary adjustments if a new step size was chosen; * - prediction of the Nordsieck history array zn at tn + h; * - setting of multistep method coefficients and test quantities; * - solution of the nonlinear system; * - testing the local error; * - updating zn and other state data if successful; * - resetting stepsize and order for the next step. * - if SLDET is on, check for stability, reduce order if necessary. * On a failure in the nonlinear system solution or error test, the * step may be reattempted, depending on the nature of the failure. */ static int cvStep(CVodeMem cv_mem) { realtype saved_t, dsm, dsmQ, dsmS, dsmQS; booleantype do_sensi_stg, do_sensi_stg1; int ncf, ncfS; int nef, nefQ, nefS, nefQS; int nflag, kflag, eflag; int retval, is; /* Are we computing sensitivities with a staggered approach? */ do_sensi_stg = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED)); do_sensi_stg1 = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED1)); /* Initialize local counters for convergence and error test failures */ ncf = nef = 0; nefQ = nefQS = 0; ncfS = nefS = 0; if (do_sensi_stg1) { for (is=0; iscv_Ns; is++) cv_mem->cv_ncfS1[is] = 0; } /* If needed, adjust method parameters */ if ((cv_mem->cv_nst > 0) && (cv_mem->cv_hprime != cv_mem->cv_h)) cvAdjustParams(cv_mem); /* Looping point for attempts to take a step */ saved_t = cv_mem->cv_tn; nflag = FIRST_CALL; for(;;) { cvPredict(cv_mem); cvSet(cv_mem); /* ------ Correct state variables ------ */ nflag = cvNls(cv_mem, nflag); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &(cv_mem->cv_ncfn)); /* Go back in loop if we need to predict again (nflag=PREV_CONV_FAIL) */ if (kflag == PREDICT_AGAIN) continue; /* Return if nonlinear solve failed and recovery not possible. */ if (kflag != DO_ERROR_TEST) return(kflag); /* Perform error test (nflag=CV_SUCCESS) */ eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, cv_mem->cv_acnrm, &nef, &(cv_mem->cv_netf), &dsm); /* Go back in loop if we need to predict again (nflag=PREV_ERR_FAIL) */ if (eflag == TRY_AGAIN) continue; /* Return if error test failed and recovery not possible. */ if (eflag != CV_SUCCESS) return(eflag); /* Error test passed (eflag=CV_SUCCESS, nflag=CV_SUCCESS), go on */ /* ------ Correct the quadrature variables ------ */ if (cv_mem->cv_quadr) { ncf = nef = 0; /* reset counters for states */ nflag = cvQuadNls(cv_mem); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &(cv_mem->cv_ncfn)); if (kflag == PREDICT_AGAIN) continue; if (kflag != DO_ERROR_TEST) return(kflag); /* Error test on quadratures */ if (cv_mem->cv_errconQ) { cv_mem->cv_acnrmQ = N_VWrmsNorm(cv_mem->cv_acorQ, cv_mem->cv_ewtQ); eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, cv_mem->cv_acnrmQ, &nefQ, &(cv_mem->cv_netfQ), &dsmQ); if (eflag == TRY_AGAIN) continue; if (eflag != CV_SUCCESS) return(eflag); /* Set dsm = max(dsm, dsmQ) to be used in cvPrepareNextStep */ if (dsmQ > dsm) dsm = dsmQ; } } /* ------ Correct the sensitivity variables (STAGGERED or STAGGERED1) ------- */ if (do_sensi_stg || do_sensi_stg1) { ncf = nef = 0; /* reset counters for states */ if (cv_mem->cv_quadr) nefQ = 0; /* reset counter for quadratures */ /* Evaluate f at converged y, needed for future evaluations of sens. RHS * If f() fails recoverably, treat it as a convergence failure and * attempt the step again */ retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) { nflag = PREV_CONV_FAIL; continue; } if (do_sensi_stg) { /* Nonlinear solve for sensitivities (all-at-once) */ nflag = cvStgrNls(cv_mem); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncfS, &(cv_mem->cv_ncfnS)); } else { /* Nonlinear solve for sensitivities (one-by-one) */ for (is=0; iscv_Ns; is++) { cv_mem->sens_solve_idx = is; nflag = cvStgr1Nls(cv_mem, is); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &(cv_mem->cv_ncfS1[is]), &(cv_mem->cv_ncfnS1[is])); if (kflag != DO_ERROR_TEST) break; } } if (kflag == PREDICT_AGAIN) continue; if (kflag != DO_ERROR_TEST) return(kflag); /* Error test on sensitivities */ if (cv_mem->cv_errconS) { if (do_sensi_stg1) cv_mem->cv_acnrmS = cvSensNorm(cv_mem, cv_mem->cv_acorS, cv_mem->cv_ewtS); eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, cv_mem->cv_acnrmS, &nefS, &(cv_mem->cv_netfS), &dsmS); if (eflag == TRY_AGAIN) continue; if (eflag != CV_SUCCESS) return(eflag); /* Set dsm = max(dsm, dsmS) to be used in cvPrepareNextStep */ if (dsmS > dsm) dsm = dsmS; } } /* ------ Correct the quadrature sensitivity variables ------ */ if (cv_mem->cv_quadr_sensi) { /* Reset local convergence and error test failure counters */ ncf = nef = 0; if (cv_mem->cv_quadr) nefQ = 0; if (do_sensi_stg) ncfS = nefS = 0; if (do_sensi_stg1) { for (is=0; iscv_Ns; is++) cv_mem->cv_ncfS1[is] = 0; nefS = 0; } /* Note that ftempQ contains yQdot evaluated at the converged y * (stored in cvQuadNls) and can be used in evaluating fQS */ nflag = cvQuadSensNls(cv_mem); kflag = cvHandleNFlag(cv_mem, &nflag, saved_t, &ncf, &(cv_mem->cv_ncfn)); if (kflag == PREDICT_AGAIN) continue; if (kflag != DO_ERROR_TEST) return(kflag); /* Error test on quadrature sensitivities */ if (cv_mem->cv_errconQS) { cv_mem->cv_acnrmQS = cvQuadSensNorm(cv_mem, cv_mem->cv_acorQS, cv_mem->cv_ewtQS); eflag = cvDoErrorTest(cv_mem, &nflag, saved_t, cv_mem->cv_acnrmQS, &nefQS, &(cv_mem->cv_netfQS), &dsmQS); if (eflag == TRY_AGAIN) continue; if (eflag != CV_SUCCESS) return(eflag); /* Set dsm = max(dsm, dsmQS) to be used in cvPrepareNextStep */ if (dsmQS > dsm) dsm = dsmQS; } } /* Everything went fine; exit loop */ break; } /* Nonlinear system solve and error test were both successful. Update data, and consider change of step and/or order. */ cvCompleteStep(cv_mem); cvPrepareNextStep(cv_mem, dsm); /* If Stablilty Limit Detection is turned on, call stability limit detection routine for possible order reduction. */ if (cv_mem->cv_sldeton) cvBDFStab(cv_mem); cv_mem->cv_etamax = (cv_mem->cv_nst <= SMALL_NST) ? ETAMX2 : ETAMX3; /* Finally, we rescale the acor array to be the estimated local error vector. */ N_VScale(cv_mem->cv_tq[2], cv_mem->cv_acor, cv_mem->cv_acor); if (cv_mem->cv_quadr) N_VScale(cv_mem->cv_tq[2], cv_mem->cv_acorQ, cv_mem->cv_acorQ); if (cv_mem->cv_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_tq[2]; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_acorS, cv_mem->cv_acorS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } if (cv_mem->cv_quadr_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_tq[2]; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_acorQS, cv_mem->cv_acorQS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Function called at beginning of step * ----------------------------------------------------------------- */ /* * cvAdjustParams * * This routine is called when a change in step size was decided upon, * and it handles the required adjustments to the history array zn. * If there is to be a change in order, we call cvAdjustOrder and reset * q, L = q+1, and qwait. Then in any case, we call cvRescale, which * resets h and rescales the Nordsieck array. */ static void cvAdjustParams(CVodeMem cv_mem) { if (cv_mem->cv_qprime != cv_mem->cv_q) { cvAdjustOrder(cv_mem, cv_mem->cv_qprime-cv_mem->cv_q); cv_mem->cv_q = cv_mem->cv_qprime; cv_mem->cv_L = cv_mem->cv_q+1; cv_mem->cv_qwait = cv_mem->cv_L; } cvRescale(cv_mem); } /* * cvAdjustOrder * * This routine is a high level routine which handles an order * change by an amount deltaq (= +1 or -1). If a decrease in order * is requested and q==2, then the routine returns immediately. * Otherwise cvAdjustAdams or cvAdjustBDF is called to handle the * order change (depending on the value of lmm). */ static void cvAdjustOrder(CVodeMem cv_mem, int deltaq) { if ((cv_mem->cv_q==2) && (deltaq != 1)) return; switch(cv_mem->cv_lmm){ case CV_ADAMS: cvAdjustAdams(cv_mem, deltaq); break; case CV_BDF: cvAdjustBDF(cv_mem, deltaq); break; } } /* * cvAdjustAdams * * This routine adjusts the history array on a change of order q by * deltaq, in the case that lmm == CV_ADAMS. */ static void cvAdjustAdams(CVodeMem cv_mem, int deltaq) { int i, j; realtype xi, hsum; /* On an order increase, set new column of zn to zero and return */ if (deltaq==1) { N_VConst(ZERO, cv_mem->cv_zn[cv_mem->cv_L]); if (cv_mem->cv_quadr) N_VConst(ZERO, cv_mem->cv_znQ[cv_mem->cv_L]); if (cv_mem->cv_sensi) (void) N_VConstVectorArray(cv_mem->cv_Ns, ZERO, cv_mem->cv_znS[cv_mem->cv_L]); return; } /* * On an order decrease, each zn[j] is adjusted by a multiple of zn[q]. * The coeffs. in the adjustment are the coeffs. of the polynomial: * x * q * INT { u * ( u + xi_1 ) * ... * ( u + xi_{q-2} ) } du * 0 * where xi_j = [t_n - t_(n-j)]/h => xi_0 = 0 */ for (i=0; i <= cv_mem->cv_qmax; i++) cv_mem->cv_l[i] = ZERO; cv_mem->cv_l[1] = ONE; hsum = ZERO; for (j=1; j <= cv_mem->cv_q-2; j++) { hsum += cv_mem->cv_tau[j]; xi = hsum / cv_mem->cv_hscale; for (i=j+1; i >= 1; i--) cv_mem->cv_l[i] = cv_mem->cv_l[i]*xi + cv_mem->cv_l[i-1]; } for (j=1; j <= cv_mem->cv_q-2; j++) cv_mem->cv_l[j+1] = cv_mem->cv_q * (cv_mem->cv_l[j] / (j+1)); if (cv_mem->cv_q > 2) { for (j=2; j < cv_mem->cv_q; j++) cv_mem->cv_cvals[j-2] = -cv_mem->cv_l[j]; (void) N_VScaleAddMulti(cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_zn[cv_mem->cv_q], cv_mem->cv_zn+2, cv_mem->cv_zn+2); if (cv_mem->cv_quadr) (void) N_VScaleAddMulti(cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_znQ[cv_mem->cv_q], cv_mem->cv_znQ+2, cv_mem->cv_znQ+2); if (cv_mem->cv_sensi) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_znS[cv_mem->cv_q], cv_mem->cv_znS+2, cv_mem->cv_znS+2); } } /* * cvAdjustBDF * * This is a high level routine which handles adjustments to the * history array on a change of order by deltaq in the case that * lmm == CV_BDF. cvAdjustBDF calls cvIncreaseBDF if deltaq = +1 and * cvDecreaseBDF if deltaq = -1 to do the actual work. */ static void cvAdjustBDF(CVodeMem cv_mem, int deltaq) { switch(deltaq) { case 1: cvIncreaseBDF(cv_mem); return; case -1: cvDecreaseBDF(cv_mem); return; } } /* * cvIncreaseBDF * * This routine adjusts the history array on an increase in the * order q in the case that lmm == CV_BDF. * A new column zn[q+1] is set equal to a multiple of the saved * vector (= acor) in zn[indx_acor]. Then each zn[j] is adjusted by * a multiple of zn[q+1]. The coefficients in the adjustment are the * coefficients of the polynomial x*x*(x+xi_1)*...*(x+xi_j), * where xi_j = [t_n - t_(n-j)]/h. */ static void cvIncreaseBDF(CVodeMem cv_mem) { realtype alpha0, alpha1, prod, xi, xiold, hsum, A1; int i, j; int is; for (i=0; i <= cv_mem->cv_qmax; i++) cv_mem->cv_l[i] = ZERO; cv_mem->cv_l[2] = alpha1 = prod = xiold = ONE; alpha0 = -ONE; hsum = cv_mem->cv_hscale; if (cv_mem->cv_q > 1) { for (j=1; j < cv_mem->cv_q; j++) { hsum += cv_mem->cv_tau[j+1]; xi = hsum / cv_mem->cv_hscale; prod *= xi; alpha0 -= ONE / (j+1); alpha1 += ONE / xi; for (i=j+2; i >= 2; i--) cv_mem->cv_l[i] = cv_mem->cv_l[i]*xiold + cv_mem->cv_l[i-1]; xiold = xi; } } A1 = (-alpha0 - alpha1) / prod; /* zn[indx_acor] contains the value Delta_n = y_n - y_n(0) This value was stored there at the previous successful step (in cvCompleteStep) A1 contains dbar = (1/xi* - 1/xi_q)/prod(xi_j) */ N_VScale(A1, cv_mem->cv_zn[cv_mem->cv_indx_acor], cv_mem->cv_zn[cv_mem->cv_L]); /* for (j=2; j <= cv_mem->cv_q; j++) */ if (cv_mem->cv_q > 1) (void) N_VScaleAddMulti(cv_mem->cv_q-1, cv_mem->cv_l+2, cv_mem->cv_zn[cv_mem->cv_L], cv_mem->cv_zn+2, cv_mem->cv_zn+2); if (cv_mem->cv_quadr) { N_VScale(A1, cv_mem->cv_znQ[cv_mem->cv_indx_acor], cv_mem->cv_znQ[cv_mem->cv_L]); /* for (j=2; j <= cv_mem->cv_q; j++) */ if (cv_mem->cv_q > 1) (void) N_VScaleAddMulti(cv_mem->cv_q-1, cv_mem->cv_l+2, cv_mem->cv_znQ[cv_mem->cv_L], cv_mem->cv_znQ+2, cv_mem->cv_znQ+2); } if (cv_mem->cv_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = A1; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[cv_mem->cv_indx_acor], cv_mem->cv_znS[cv_mem->cv_L]); /* for (j=2; j <= cv_mem->cv_q; j++) */ if (cv_mem->cv_q > 1) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q-1, cv_mem->cv_l+2, cv_mem->cv_znS[cv_mem->cv_L], cv_mem->cv_znS+2, cv_mem->cv_znS+2); } if (cv_mem->cv_quadr_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = A1; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znQS[cv_mem->cv_indx_acor], cv_mem->cv_znQS[cv_mem->cv_L]); /* for (j=2; j <= cv_mem->cv_q; j++) */ if (cv_mem->cv_q > 1) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q-1, cv_mem->cv_l+2, cv_mem->cv_znQS[cv_mem->cv_L], cv_mem->cv_znQS+2, cv_mem->cv_znQS+2); } } /* * cvDecreaseBDF * * This routine adjusts the history array on a decrease in the * order q in the case that lmm == CV_BDF. * Each zn[j] is adjusted by a multiple of zn[q]. The coefficients * in the adjustment are the coefficients of the polynomial * x*x*(x+xi_1)*...*(x+xi_j), where xi_j = [t_n - t_(n-j)]/h. */ static void cvDecreaseBDF(CVodeMem cv_mem) { realtype hsum, xi; int i, j; for (i=0; i <= cv_mem->cv_qmax; i++) cv_mem->cv_l[i] = ZERO; cv_mem->cv_l[2] = ONE; hsum = ZERO; for (j=1; j <= cv_mem->cv_q-2; j++) { hsum += cv_mem->cv_tau[j]; xi = hsum / cv_mem->cv_hscale; for (i=j+2; i >= 2; i--) cv_mem->cv_l[i] = cv_mem->cv_l[i]*xi + cv_mem->cv_l[i-1]; } if (cv_mem->cv_q > 2) { for (j=2; j < cv_mem->cv_q; j++) cv_mem->cv_cvals[j-2] = -cv_mem->cv_l[j]; (void) N_VScaleAddMulti(cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_zn[cv_mem->cv_q], cv_mem->cv_zn+2, cv_mem->cv_zn+2); if (cv_mem->cv_quadr) (void) N_VScaleAddMulti(cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_znQ[cv_mem->cv_q], cv_mem->cv_znQ+2, cv_mem->cv_znQ+2); if (cv_mem->cv_sensi) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_znS[cv_mem->cv_q], cv_mem->cv_znS+2, cv_mem->cv_znS+2); if (cv_mem->cv_quadr_sensi) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q-2, cv_mem->cv_cvals, cv_mem->cv_znQS[cv_mem->cv_q], cv_mem->cv_znQS+2, cv_mem->cv_znQS+2); } } /* * cvRescale * * This routine rescales the Nordsieck array by multiplying the * jth column zn[j] by eta^j, j = 1, ..., q. Then the value of * h is rescaled by eta, and hscale is reset to h. */ static void cvRescale(CVodeMem cv_mem) { int j; int is; /* compute scaling factors */ cv_mem->cv_cvals[0] = cv_mem->cv_eta; for (j=1; j < cv_mem->cv_q; j++) cv_mem->cv_cvals[j] = cv_mem->cv_eta * cv_mem->cv_cvals[j-1]; (void) N_VScaleVectorArray(cv_mem->cv_q, cv_mem->cv_cvals, cv_mem->cv_zn+1, cv_mem->cv_zn+1); if (cv_mem->cv_quadr) (void) N_VScaleVectorArray(cv_mem->cv_q, cv_mem->cv_cvals, cv_mem->cv_znQ+1, cv_mem->cv_znQ+1); /* compute sensi scaling factors */ if (cv_mem->cv_sensi || cv_mem->cv_quadr_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_eta; for (j=1; j < cv_mem->cv_q; j++) for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[j*cv_mem->cv_Ns+is] = cv_mem->cv_eta * cv_mem->cv_cvals[(j-1)*cv_mem->cv_Ns+is]; } if (cv_mem->cv_sensi) { for (j=1; j <= cv_mem->cv_q; j++) for (is=0; iscv_Ns; is++) cv_mem->cv_Xvecs[(j-1)*cv_mem->cv_Ns+is] = cv_mem->cv_znS[j][is]; (void) N_VScaleVectorArray(cv_mem->cv_q*cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_Xvecs, cv_mem->cv_Xvecs); } if (cv_mem->cv_quadr_sensi) { for (j=1; j <= cv_mem->cv_q; j++) for (is=0; iscv_Ns; is++) cv_mem->cv_Xvecs[(j-1)*cv_mem->cv_Ns+is] = cv_mem->cv_znQS[j][is]; (void) N_VScaleVectorArray(cv_mem->cv_q*cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_Xvecs, cv_mem->cv_Xvecs); } cv_mem->cv_h = cv_mem->cv_hscale * cv_mem->cv_eta; cv_mem->cv_next_h = cv_mem->cv_h; cv_mem->cv_hscale = cv_mem->cv_h; cv_mem->cv_nscon = 0; } /* * cvPredict * * This routine advances tn by the tentative step size h, and computes * the predicted array z_n(0), which is overwritten on zn. The * prediction of zn is done by repeated additions. * If tstop is enabled, it is possible for tn + h to be past tstop by roundoff, * and in that case, we reset tn (after incrementing by h) to tstop. */ static void cvPredict(CVodeMem cv_mem) { int j, k; cv_mem->cv_tn += cv_mem->cv_h; if (cv_mem->cv_tstopset) { if ((cv_mem->cv_tn - cv_mem->cv_tstop)*cv_mem->cv_h > ZERO) cv_mem->cv_tn = cv_mem->cv_tstop; } for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) N_VLinearSum(ONE, cv_mem->cv_zn[j-1], ONE, cv_mem->cv_zn[j], cv_mem->cv_zn[j-1]); if (cv_mem->cv_quadr) { for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) N_VLinearSum(ONE, cv_mem->cv_znQ[j-1], ONE, cv_mem->cv_znQ[j], cv_mem->cv_znQ[j-1]); } if (cv_mem->cv_sensi) { for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) (void) N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[j-1], ONE, cv_mem->cv_znS[j], cv_mem->cv_znS[j-1]); } if (cv_mem->cv_quadr_sensi) { for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) (void) N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znQS[j-1], ONE, cv_mem->cv_znQS[j], cv_mem->cv_znQS[j-1]); } } /* * cvSet * * This routine is a high level routine which calls cvSetAdams or * cvSetBDF to set the polynomial l, the test quantity array tq, * and the related variables rl1, gamma, and gamrat. * * The array tq is loaded with constants used in the control of estimated * local errors and in the nonlinear convergence test. Specifically, while * running at order q, the components of tq are as follows: * tq[1] = a coefficient used to get the est. local error at order q-1 * tq[2] = a coefficient used to get the est. local error at order q * tq[3] = a coefficient used to get the est. local error at order q+1 * tq[4] = constant used in nonlinear iteration convergence test * tq[5] = coefficient used to get the order q+2 derivative vector used in * the est. local error at order q+1 */ static void cvSet(CVodeMem cv_mem) { switch(cv_mem->cv_lmm) { case CV_ADAMS: cvSetAdams(cv_mem); break; case CV_BDF: cvSetBDF(cv_mem); break; } cv_mem->cv_rl1 = ONE / cv_mem->cv_l[1]; cv_mem->cv_gamma = cv_mem->cv_h * cv_mem->cv_rl1; if (cv_mem->cv_nst == 0) cv_mem->cv_gammap = cv_mem->cv_gamma; cv_mem->cv_gamrat = (cv_mem->cv_nst > 0) ? cv_mem->cv_gamma / cv_mem->cv_gammap : ONE; /* protect x / x != 1.0 */ } /* * cvSetAdams * * This routine handles the computation of l and tq for the * case lmm == CV_ADAMS. * * The components of the array l are the coefficients of a * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by * q-1 * (d/dx) Lambda(x) = c * PRODUCT (1 + x / xi_i) , where * i=1 * Lambda(-1) = 0, Lambda(0) = 1, and c is a normalization factor. * Here xi_i = [t_n - t_(n-i)] / h. * * The array tq is set to test quantities used in the convergence * test, the error test, and the selection of h at a new order. */ static void cvSetAdams(CVodeMem cv_mem) { realtype m[L_MAX], M[3], hsum; if (cv_mem->cv_q == 1) { cv_mem->cv_l[0] = cv_mem->cv_l[1] = cv_mem->cv_tq[1] = cv_mem->cv_tq[5] = ONE; cv_mem->cv_tq[2] = HALF; cv_mem->cv_tq[3] = ONE/TWELVE; cv_mem->cv_tq[4] = cv_mem->cv_nlscoef / cv_mem->cv_tq[2]; /* = 0.1 / tq[2] */ return; } hsum = cvAdamsStart(cv_mem, m); M[0] = cvAltSum(cv_mem->cv_q-1, m, 1); M[1] = cvAltSum(cv_mem->cv_q-1, m, 2); cvAdamsFinish(cv_mem, m, M, hsum); } /* * cvAdamsStart * * This routine generates in m[] the coefficients of the product * polynomial needed for the Adams l and tq coefficients for q > 1. */ static realtype cvAdamsStart(CVodeMem cv_mem, realtype m[]) { realtype hsum, xi_inv, sum; int i, j; hsum = cv_mem->cv_h; m[0] = ONE; for (i=1; i <= cv_mem->cv_q; i++) m[i] = ZERO; for (j=1; j < cv_mem->cv_q; j++) { if ((j==cv_mem->cv_q-1) && (cv_mem->cv_qwait == 1)) { sum = cvAltSum(cv_mem->cv_q-2, m, 2); cv_mem->cv_tq[1] = cv_mem->cv_q * sum / m[cv_mem->cv_q-2]; } xi_inv = cv_mem->cv_h / hsum; for (i=j; i >= 1; i--) m[i] += m[i-1] * xi_inv; hsum += cv_mem->cv_tau[j]; /* The m[i] are coefficients of product(1 to j) (1 + x/xi_i) */ } return(hsum); } /* * cvAdamsFinish * * This routine completes the calculation of the Adams l and tq. */ static void cvAdamsFinish(CVodeMem cv_mem, realtype m[], realtype M[], realtype hsum) { int i; realtype M0_inv, xi, xi_inv; M0_inv = ONE / M[0]; cv_mem->cv_l[0] = ONE; for (i=1; i <= cv_mem->cv_q; i++) cv_mem->cv_l[i] = M0_inv * (m[i-1] / i); xi = hsum / cv_mem->cv_h; xi_inv = ONE / xi; cv_mem->cv_tq[2] = M[1] * M0_inv / xi; cv_mem->cv_tq[5] = xi / cv_mem->cv_l[cv_mem->cv_q]; if (cv_mem->cv_qwait == 1) { for (i=cv_mem->cv_q; i >= 1; i--) m[i] += m[i-1] * xi_inv; M[2] = cvAltSum(cv_mem->cv_q, m, 2); cv_mem->cv_tq[3] = M[2] * M0_inv / cv_mem->cv_L; } cv_mem->cv_tq[4] = cv_mem->cv_nlscoef / cv_mem->cv_tq[2]; } /* * cvAltSum * * cvAltSum returns the value of the alternating sum * sum (i= 0 ... iend) [ (-1)^i * (a[i] / (i + k)) ]. * If iend < 0 then cvAltSum returns 0. * This operation is needed to compute the integral, from -1 to 0, * of a polynomial x^(k-1) M(x) given the coefficients of M(x). */ static realtype cvAltSum(int iend, realtype a[], int k) { int i, sign; realtype sum; if (iend < 0) return(ZERO); sum = ZERO; sign = 1; for (i=0; i <= iend; i++) { sum += sign * (a[i] / (i+k)); sign = -sign; } return(sum); } /* * cvSetBDF * * This routine computes the coefficients l and tq in the case * lmm == CV_BDF. cvSetBDF calls cvSetTqBDF to set the test * quantity array tq. * * The components of the array l are the coefficients of a * polynomial Lambda(x) = l_0 + l_1 x + ... + l_q x^q, given by * q-1 * Lambda(x) = (1 + x / xi*_q) * PRODUCT (1 + x / xi_i) , where * i=1 * xi_i = [t_n - t_(n-i)] / h. * * The array tq is set to test quantities used in the convergence * test, the error test, and the selection of h at a new order. */ static void cvSetBDF(CVodeMem cv_mem) { realtype alpha0, alpha0_hat, xi_inv, xistar_inv, hsum; int i,j; cv_mem->cv_l[0] = cv_mem->cv_l[1] = xi_inv = xistar_inv = ONE; for (i=2; i <= cv_mem->cv_q; i++) cv_mem->cv_l[i] = ZERO; alpha0 = alpha0_hat = -ONE; hsum = cv_mem->cv_h; if (cv_mem->cv_q > 1) { for (j=2; j < cv_mem->cv_q; j++) { hsum += cv_mem->cv_tau[j-1]; xi_inv = cv_mem->cv_h / hsum; alpha0 -= ONE / j; for (i=j; i >= 1; i--) cv_mem->cv_l[i] += cv_mem->cv_l[i-1]*xi_inv; /* The l[i] are coefficients of product(1 to j) (1 + x/xi_i) */ } /* j = q */ alpha0 -= ONE / cv_mem->cv_q; xistar_inv = -cv_mem->cv_l[1] - alpha0; hsum += cv_mem->cv_tau[cv_mem->cv_q-1]; xi_inv = cv_mem->cv_h / hsum; alpha0_hat = -cv_mem->cv_l[1] - xi_inv; for (i=cv_mem->cv_q; i >= 1; i--) cv_mem->cv_l[i] += cv_mem->cv_l[i-1]*xistar_inv; } cvSetTqBDF(cv_mem, hsum, alpha0, alpha0_hat, xi_inv, xistar_inv); } /* * cvSetTqBDF * * This routine sets the test quantity array tq in the case * lmm == CV_BDF. */ static void cvSetTqBDF(CVodeMem cv_mem, realtype hsum, realtype alpha0, realtype alpha0_hat, realtype xi_inv, realtype xistar_inv) { realtype A1, A2, A3, A4, A5, A6; realtype C, Cpinv, Cppinv; A1 = ONE - alpha0_hat + alpha0; A2 = ONE + cv_mem->cv_q * A1; cv_mem->cv_tq[2] = SUNRabs(A1 / (alpha0 * A2)); cv_mem->cv_tq[5] = SUNRabs(A2 * xistar_inv / (cv_mem->cv_l[cv_mem->cv_q] * xi_inv)); if (cv_mem->cv_qwait == 1) { if (cv_mem->cv_q > 1) { C = xistar_inv / cv_mem->cv_l[cv_mem->cv_q]; A3 = alpha0 + ONE / cv_mem->cv_q; A4 = alpha0_hat + xi_inv; Cpinv = (ONE - A4 + A3) / A3; cv_mem->cv_tq[1] = SUNRabs(C * Cpinv); } else cv_mem->cv_tq[1] = ONE; hsum += cv_mem->cv_tau[cv_mem->cv_q]; xi_inv = cv_mem->cv_h / hsum; A5 = alpha0 - (ONE / (cv_mem->cv_q+1)); A6 = alpha0_hat - xi_inv; Cppinv = (ONE - A6 + A5) / A2; cv_mem->cv_tq[3] = SUNRabs(Cppinv / (xi_inv * (cv_mem->cv_q+2) * A5)); } cv_mem->cv_tq[4] = cv_mem->cv_nlscoef / cv_mem->cv_tq[2]; } /* * ----------------------------------------------------------------- * Nonlinear solver functions * ----------------------------------------------------------------- */ /* * cvNls * * This routine attempts to solve the nonlinear system associated * with a single implicit step of the linear multistep method. */ static int cvNls(CVodeMem cv_mem, int nflag) { int flag = CV_SUCCESS; booleantype callSetup; booleantype do_sensi_sim; /* Are we computing sensitivities with the CV_SIMULTANEOUS approach? */ do_sensi_sim = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_SIMULTANEOUS)); /* Decide whether or not to call setup routine (if one exists) and */ /* set flag convfail (input to lsetup for its evaluation decision) */ if (cv_mem->cv_lsetup) { cv_mem->convfail = ((nflag == FIRST_CALL) || (nflag == PREV_ERR_FAIL)) ? CV_NO_FAILURES : CV_FAIL_OTHER; callSetup = (nflag == PREV_CONV_FAIL) || (nflag == PREV_ERR_FAIL) || (cv_mem->cv_nst == 0) || (cv_mem->cv_nst >= cv_mem->cv_nstlp + MSBP) || (SUNRabs(cv_mem->cv_gamrat-ONE) > DGMAX); /* Decide whether to force a call to setup */ if (cv_mem->cv_forceSetup) { callSetup = SUNTRUE; cv_mem->convfail = CV_FAIL_OTHER; } } else { cv_mem->cv_crate = ONE; cv_mem->cv_crateS = ONE; /* if NO lsetup all conv. rates are set to ONE */ callSetup = SUNFALSE; } /* initial guess for the correction to the predictor */ if (do_sensi_sim) N_VConst(ZERO, cv_mem->ycor0Sim); else N_VConst(ZERO, cv_mem->cv_tempv); /* call nonlinear solver setup if it exists */ if ((cv_mem->NLS)->ops->setup) { if (do_sensi_sim) flag = SUNNonlinSolSetup(cv_mem->NLS, cv_mem->ycor0Sim, cv_mem); else flag = SUNNonlinSolSetup(cv_mem->NLS, cv_mem->cv_tempv, cv_mem); if (flag < 0) return(CV_NLS_SETUP_FAIL); if (flag > 0) return(SUN_NLS_CONV_RECVR); } /* solve the nonlinear system */ if (do_sensi_sim) flag = SUNNonlinSolSolve(cv_mem->NLSsim, cv_mem->ycor0Sim, cv_mem->ycorSim, cv_mem->ewtSim, cv_mem->cv_tq[4], callSetup, cv_mem); else flag = SUNNonlinSolSolve(cv_mem->NLS, cv_mem->cv_tempv, cv_mem->cv_acor, cv_mem->cv_ewt, cv_mem->cv_tq[4], callSetup, cv_mem); /* update the state based on the final correction from the nonlinear solver */ N_VLinearSum(ONE, cv_mem->cv_zn[0], ONE, cv_mem->cv_acor, cv_mem->cv_y); /* update the sensitivities based on the final correction from the nonlinear solver */ if (do_sensi_sim) { N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[0], ONE, cv_mem->cv_acorS, cv_mem->cv_yS); } /* if the solve failed return */ if (flag != CV_SUCCESS) return(flag); /* solve successful, update Jacobian status and check constraints */ cv_mem->cv_jcur = SUNFALSE; if (cv_mem->cv_constraintsSet) flag = cvCheckConstraints(cv_mem); return(flag); } /* * cvCheckConstraints * * This routine determines if the constraints of the problem * are satisfied by the proposed step * * Possible return values are: * * CV_SUCCESS ---> allows stepping forward * * CONSTR_RECVR ---> values failed to satisfy constraints */ static int cvCheckConstraints(CVodeMem cv_mem) { booleantype constraintsPassed; realtype vnorm; cv_mem->cv_mm = cv_mem->cv_ftemp; /* Get mask vector mm, set where constraints failed */ constraintsPassed = N_VConstrMask(cv_mem->cv_constraints, cv_mem->cv_y, cv_mem->cv_mm); if (constraintsPassed) return(CV_SUCCESS); else { N_VCompare(ONEPT5, cv_mem->cv_constraints, cv_mem->cv_tempv); /* a, where a[i]=1 when |c[i]|=2; c the vector of constraints */ N_VProd(cv_mem->cv_tempv, cv_mem->cv_constraints, cv_mem->cv_tempv); /* a * c */ N_VDiv(cv_mem->cv_tempv, cv_mem->cv_ewt, cv_mem->cv_tempv); /* a * c * wt */ N_VLinearSum(ONE, cv_mem->cv_y, -PT1, cv_mem->cv_tempv, cv_mem->cv_tempv); /* y - 0.1 * a * c * wt */ N_VProd(cv_mem->cv_tempv, cv_mem->cv_mm, cv_mem->cv_tempv); /* v = mm*(y-0.1*a*c*wt) */ vnorm = N_VWrmsNorm(cv_mem->cv_tempv, cv_mem->cv_ewt); /* ||v|| */ /* If vector v of constraint corrections is small in norm, correct and accept this step */ if (vnorm <= cv_mem->cv_tq[4]) { N_VLinearSum(ONE, cv_mem->cv_acor, -ONE, cv_mem->cv_tempv, cv_mem->cv_acor); /* acor <- acor - v */ return(CV_SUCCESS); } else { /* Constraints not met - reduce h by computing eta = h'/h */ N_VLinearSum(ONE, cv_mem->cv_zn[0], -ONE, cv_mem->cv_y, cv_mem->cv_tempv); N_VProd(cv_mem->cv_mm, cv_mem->cv_tempv, cv_mem->cv_tempv); cv_mem->cv_eta = PT9*N_VMinQuotient(cv_mem->cv_zn[0], cv_mem->cv_tempv); cv_mem->cv_eta = SUNMAX(cv_mem->cv_eta, PT1); return(CONSTR_RECVR); } } return(CV_SUCCESS); } /* * cvQuadNls * * This routine solves for the quadrature variables at the new step. * It does not solve a nonlinear system, but rather updates the * quadrature variables. The name for this function is just for * uniformity purposes. * * Possible return values (interpreted by cvHandleNFlag) * * CV_SUCCESS -> continue with error test * CV_QRHSFUNC_FAIL -> halt the integration * QRHSFUNC_RECVR -> predict again or stop if too many * */ static int cvQuadNls(CVodeMem cv_mem) { int retval; /* Save quadrature correction in acorQ */ retval = cv_mem->cv_fQ(cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_acorQ, cv_mem->cv_user_data); cv_mem->cv_nfQe++; if (retval < 0) return(CV_QRHSFUNC_FAIL); if (retval > 0) return(QRHSFUNC_RECVR); /* If needed, save the value of yQdot = fQ into ftempQ * for use in evaluating fQS */ if (cv_mem->cv_quadr_sensi) { N_VScale(ONE, cv_mem->cv_acorQ, cv_mem->cv_ftempQ); } N_VLinearSum(cv_mem->cv_h, cv_mem->cv_acorQ, -ONE, cv_mem->cv_znQ[1], cv_mem->cv_acorQ); N_VScale(cv_mem->cv_rl1, cv_mem->cv_acorQ, cv_mem->cv_acorQ); /* Apply correction to quadrature variables */ N_VLinearSum(ONE, cv_mem->cv_znQ[0], ONE, cv_mem->cv_acorQ, cv_mem->cv_yQ); return(CV_SUCCESS); } /* * cvQuadSensNls * * This routine solves for the quadrature sensitivity variables * at the new step. It does not solve a nonlinear system, but * rather updates the quadrature variables. The name for this * function is just for uniformity purposes. * * Possible return values (interpreted by cvHandleNFlag) * * CV_SUCCESS -> continue with error test * CV_QSRHSFUNC_FAIL -> halt the integration * QSRHSFUNC_RECVR -> predict again or stop if too many * */ static int cvQuadSensNls(CVodeMem cv_mem) { int is, retval; /* Save quadrature correction in acorQ */ retval = cv_mem->cv_fQS(cv_mem->cv_Ns, cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_yS, cv_mem->cv_ftempQ, cv_mem->cv_acorQS, cv_mem->cv_user_data, cv_mem->cv_tempv, cv_mem->cv_tempvQ); cv_mem->cv_nfQSe++; if (retval < 0) return(CV_QSRHSFUNC_FAIL); if (retval > 0) return(QSRHSFUNC_RECVR); for (is=0; iscv_Ns; is++) { N_VLinearSum(cv_mem->cv_h, cv_mem->cv_acorQS[is], -ONE, cv_mem->cv_znQS[1][is], cv_mem->cv_acorQS[is]); N_VScale(cv_mem->cv_rl1, cv_mem->cv_acorQS[is], cv_mem->cv_acorQS[is]); /* Apply correction to quadrature sensitivity variables */ N_VLinearSum(ONE, cv_mem->cv_znQS[0][is], ONE, cv_mem->cv_acorQS[is], cv_mem->cv_yQS[is]); } return(CV_SUCCESS); } /* * cvStgrNls * * This is a high-level routine that attempts to solve the * sensitivity linear systems using the attached nonlinear solver * once the states y_n were obtained and passed the error test. */ static int cvStgrNls(CVodeMem cv_mem) { booleantype callSetup; int flag=CV_SUCCESS; cv_mem->sens_solve = SUNTRUE; callSetup = SUNFALSE; if (cv_mem->cv_lsetup == NULL) cv_mem->cv_crateS = ONE; /* initial guess for the correction to the predictor */ N_VConst(ZERO, cv_mem->ycor0Stg); /* solve the nonlinear system */ flag = SUNNonlinSolSolve(cv_mem->NLSstg, cv_mem->ycor0Stg, cv_mem->ycorStg, cv_mem->ewtStg, cv_mem->cv_tq[4], callSetup, cv_mem); /* update the sensitivities based on the final correction from the nonlinear solver */ N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[0], ONE, cv_mem->cv_acorS, cv_mem->cv_yS); /* if the solve is successful, update Jacobian status */ if (flag == CV_SUCCESS) cv_mem->cv_jcur = SUNFALSE; cv_mem->sens_solve = SUNFALSE; return(flag); } /* * cvStgr1Nls * * This is a high-level routine that attempts to solve the i-th * sensitivity linear system using the attached nonlinear solver * once the states y_n were obtained and passed the error test. */ static int cvStgr1Nls(CVodeMem cv_mem, int is) { booleantype callSetup; long int nni; int flag=CV_SUCCESS; cv_mem->sens_solve = SUNTRUE; callSetup = SUNFALSE; if (cv_mem->cv_lsetup == NULL) cv_mem->cv_crateS = ONE; /* initial guess for the correction to the predictor */ N_VConst(ZERO, cv_mem->cv_tempvS[is]); /* solve the nonlinear system */ flag = SUNNonlinSolSolve(cv_mem->NLSstg1, cv_mem->cv_tempvS[is], cv_mem->cv_acorS[is], cv_mem->cv_ewtS[is], cv_mem->cv_tq[4], callSetup, cv_mem); /* update the sensitivity with the final correction from the nonlinear solver */ N_VLinearSum(ONE, cv_mem->cv_znS[0][is], ONE, cv_mem->cv_acorS[is], cv_mem->cv_yS[is]); /* if the solve is successful, update Jacobian status */ if (flag == CV_SUCCESS) cv_mem->cv_jcur = SUNFALSE; /* update nniS iteration count */ (void) SUNNonlinSolGetNumIters(cv_mem->NLSstg1, &nni); cv_mem->cv_nniS1[is] += nni - cv_mem->nnip; cv_mem->nnip = nni; cv_mem->sens_solve = SUNFALSE; return(flag); } /* * cvHandleNFlag * * This routine takes action on the return value nflag = *nflagPtr * returned by cvNls, as follows: * * If cvNls succeeded in solving the nonlinear system, then * cvHandleNFlag returns the constant DO_ERROR_TEST, which tells cvStep * to perform the error test. * * If the nonlinear system was not solved successfully, then ncfn and * ncf = *ncfPtr are incremented and Nordsieck array zn is restored. * * If the solution of the nonlinear system failed due to an * unrecoverable failure by setup, we return the value CV_LSETUP_FAIL. * * If it failed due to an unrecoverable failure in solve, then we return * the value CV_LSOLVE_FAIL. * * If it failed due to an unrecoverable failure in rhs, then we return * the value CV_RHSFUNC_FAIL. * * If it failed due to an unrecoverable failure in quad rhs, then we return * the value CV_QRHSFUNC_FAIL. * * If it failed due to an unrecoverable failure in sensi rhs, then we return * the value CV_SRHSFUNC_FAIL. * * Otherwise, a recoverable failure occurred when solving the * nonlinear system (cvNls returned nflag = SUN_NLS_CONV_RECVT, RHSFUNC_RECVR, * or SRHSFUNC_RECVR). * In this case, if ncf is now equal to maxncf or |h| = hmin, * we return the value CV_CONV_FAILURE (if nflag=SUN_NLS_CONV_RECVR), or * CV_REPTD_RHSFUNC_ERR (if nflag=RHSFUNC_RECVR), or CV_REPTD_SRHSFUNC_ERR * (if nflag=SRHSFUNC_RECVR). * If not, we set *nflagPtr = PREV_CONV_FAIL and return the value * PREDICT_AGAIN, telling cvStep to reattempt the step. * */ static int cvHandleNFlag(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, int *ncfPtr, long int *ncfnPtr) { int nflag; nflag = *nflagPtr; if (nflag == CV_SUCCESS) return(DO_ERROR_TEST); /* The nonlinear soln. failed; increment ncfn and restore zn */ (*ncfnPtr)++; cvRestore(cv_mem, saved_t); /* Return if failed unrecoverably */ if (nflag < 0) return(nflag); /* At this point, nflag = SUN_NLS_CONV_RECVR, CONSTR_RECVR, RHSFUNC_RECVR, or SRHSFUNC_RECVR; increment ncf */ (*ncfPtr)++; cv_mem->cv_etamax = ONE; /* If we had maxncf failures or |h| = hmin, return CV_CONV_FAILURE, CV_CONSTR_FAIL, CV_REPTD_RHSFUNC_ERR, CV_REPTD_QRHSFUNC_ERR, CV_REPTD_SRHSFUNC_ERR, or CV_CONSTR_FAIL */ if ((SUNRabs(cv_mem->cv_h) <= cv_mem->cv_hmin*ONEPSM) || (*ncfPtr == cv_mem->cv_maxncf)) { if (nflag == SUN_NLS_CONV_RECVR) return(CV_CONV_FAILURE); if (nflag == CONSTR_RECVR) return(CV_CONSTR_FAIL); if (nflag == RHSFUNC_RECVR) return(CV_REPTD_RHSFUNC_ERR); if (nflag == QRHSFUNC_RECVR) return(CV_REPTD_QRHSFUNC_ERR); if (nflag == SRHSFUNC_RECVR) return(CV_REPTD_SRHSFUNC_ERR); if (nflag == QSRHSFUNC_RECVR) return(CV_REPTD_QSRHSFUNC_ERR); } /* Reduce step size; return to reattempt the step Note that if nflag=CONSTR_RECVR then eta was already set in CVNls */ if (nflag != CONSTR_RECVR) cv_mem->cv_eta = SUNMAX(ETACF, cv_mem->cv_hmin / SUNRabs(cv_mem->cv_h)); *nflagPtr = PREV_CONV_FAIL; cvRescale(cv_mem); return(PREDICT_AGAIN); } /* * cvRestore * * This routine restores the value of cv_mem->cv_tn to saved_t and undoes the * prediction. After execution of cvRestore, the Nordsieck array zn has * the same values as before the call to cvPredict. */ static void cvRestore(CVodeMem cv_mem, realtype saved_t) { int j, k; cv_mem->cv_tn = saved_t; for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) N_VLinearSum(ONE, cv_mem->cv_zn[j-1], -ONE, cv_mem->cv_zn[j], cv_mem->cv_zn[j-1]); if (cv_mem->cv_quadr) { for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) N_VLinearSum(ONE, cv_mem->cv_znQ[j-1], -ONE, cv_mem->cv_znQ[j], cv_mem->cv_znQ[j-1]); } if (cv_mem->cv_sensi) { for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) (void) N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[j-1], -ONE, cv_mem->cv_znS[j], cv_mem->cv_znS[j-1]); } if (cv_mem->cv_quadr_sensi) { for (k = 1; k <= cv_mem->cv_q; k++) for (j = cv_mem->cv_q; j >= k; j--) (void) N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znQS[j-1], -ONE, cv_mem->cv_znQS[j], cv_mem->cv_znQS[j-1]); } } /* * ----------------------------------------------------------------- * Error Test * ----------------------------------------------------------------- */ /* * cvDoErrorTest * * This routine performs the local error test, for the state, quadrature, * or sensitivity variables. Its last three arguments change depending * on which variables the error test is to be performed on. * * The weighted local error norm dsm is loaded into *dsmPtr, and * the test dsm ?<= 1 is made. * * If the test passes, cvDoErrorTest returns CV_SUCCESS. * * If the test fails, we undo the step just taken (call cvRestore) and * * - if maxnef error test failures have occurred or if SUNRabs(h) = hmin, * we return CV_ERR_FAILURE. * * - if more than MXNEF1 error test failures have occurred, an order * reduction is forced. If already at order 1, restart by reloading * zn from scratch (also znQ and znS if appropriate). * If f() fails, we return CV_RHSFUNC_FAIL or CV_UNREC_RHSFUNC_ERR; * if fQ() fails, we return CV_QRHSFUNC_FAIL or CV_UNREC_QRHSFUNC_ERR; * if cvSensRhsWrapper() fails, we return CV_SRHSFUNC_FAIL or CV_UNREC_SRHSFUNC_ERR; * (no recovery is possible at this stage). * * - otherwise, set *nflagPtr to PREV_ERR_FAIL, and return TRY_AGAIN. * */ static int cvDoErrorTest(CVodeMem cv_mem, int *nflagPtr, realtype saved_t, realtype acor_nrm, int *nefPtr, long int *netfPtr, realtype *dsmPtr) { realtype dsm; int retval, is; N_Vector wrk1, wrk2; dsm = acor_nrm * cv_mem->cv_tq[2]; /* If est. local error norm dsm passes test, return CV_SUCCESS */ *dsmPtr = dsm; if (dsm <= ONE) return(CV_SUCCESS); /* Test failed; increment counters, set nflag, and restore zn array */ (*nefPtr)++; (*netfPtr)++; *nflagPtr = PREV_ERR_FAIL; cvRestore(cv_mem, saved_t); /* At maxnef failures or |h| = hmin, return CV_ERR_FAILURE */ if ((SUNRabs(cv_mem->cv_h) <= cv_mem->cv_hmin*ONEPSM) || (*nefPtr == cv_mem->cv_maxnef)) return(CV_ERR_FAILURE); /* Set etamax = 1 to prevent step size increase at end of this step */ cv_mem->cv_etamax = ONE; /* Set h ratio eta from dsm, rescale, and return for retry of step */ if (*nefPtr <= MXNEF1) { cv_mem->cv_eta = ONE / (SUNRpowerR(BIAS2*dsm,ONE/cv_mem->cv_L) + ADDON); cv_mem->cv_eta = SUNMAX(ETAMIN, SUNMAX(cv_mem->cv_eta, cv_mem->cv_hmin / SUNRabs(cv_mem->cv_h))); if (*nefPtr >= SMALL_NEF) cv_mem->cv_eta = SUNMIN(cv_mem->cv_eta, ETAMXF); cvRescale(cv_mem); return(TRY_AGAIN); } /* After MXNEF1 failures, force an order reduction and retry step */ if (cv_mem->cv_q > 1) { cv_mem->cv_eta = SUNMAX(ETAMIN, cv_mem->cv_hmin / SUNRabs(cv_mem->cv_h)); cvAdjustOrder(cv_mem,-1); cv_mem->cv_L = cv_mem->cv_q; cv_mem->cv_q--; cv_mem->cv_qwait = cv_mem->cv_L; cvRescale(cv_mem); return(TRY_AGAIN); } /* If already at order 1, restart: reload zn, znQ, znS, znQS from scratch */ cv_mem->cv_eta = SUNMAX(ETAMIN, cv_mem->cv_hmin / SUNRabs(cv_mem->cv_h)); cv_mem->cv_h *= cv_mem->cv_eta; cv_mem->cv_next_h = cv_mem->cv_h; cv_mem->cv_hscale = cv_mem->cv_h; cv_mem->cv_qwait = LONG_WAIT; cv_mem->cv_nscon = 0; retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_tempv, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_RHSFUNC_ERR); N_VScale(cv_mem->cv_h, cv_mem->cv_tempv, cv_mem->cv_zn[1]); if (cv_mem->cv_quadr) { retval = cv_mem->cv_fQ(cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_tempvQ, cv_mem->cv_user_data); cv_mem->cv_nfQe++; if (retval < 0) return(CV_QRHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_QRHSFUNC_ERR); N_VScale(cv_mem->cv_h, cv_mem->cv_tempvQ, cv_mem->cv_znQ[1]); } if (cv_mem->cv_sensi) { wrk1 = cv_mem->cv_ftemp; wrk2 = cv_mem->cv_ftempS[0]; retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_tempv, cv_mem->cv_znS[0], cv_mem->cv_tempvS, wrk1, wrk2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_SRHSFUNC_ERR); for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_h; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_tempvS, cv_mem->cv_znS[1]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } if (cv_mem->cv_quadr_sensi) { wrk1 = cv_mem->cv_ftemp; wrk2 = cv_mem->cv_ftempQ; retval = cv_mem->cv_fQS(cv_mem->cv_Ns, cv_mem->cv_tn, cv_mem->cv_zn[0], cv_mem->cv_znS[0], cv_mem->cv_tempvQ, cv_mem->cv_tempvQS, cv_mem->cv_fQS_data, wrk1, wrk2); cv_mem->cv_nfQSe++; if (retval < 0) return(CV_QSRHSFUNC_FAIL); if (retval > 0) return(CV_UNREC_QSRHSFUNC_ERR); for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = cv_mem->cv_h; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_tempvQS, cv_mem->cv_znQS[1]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } return(TRY_AGAIN); } /* * ----------------------------------------------------------------- * Functions called after a successful step * ----------------------------------------------------------------- */ /* * cvCompleteStep * * This routine performs various update operations when the solution * to the nonlinear system has passed the local error test. * We increment the step counter nst, record the values hu and qu, * update the tau array, and apply the corrections to the zn array. * The tau[i] are the last q values of h, with tau[1] the most recent. * The counter qwait is decremented, and if qwait == 1 (and q < qmax) * we save acor and tq[5] for a possible order increase. */ static void cvCompleteStep(CVodeMem cv_mem) { int i; int is; cv_mem->cv_nst++; cv_mem->cv_nscon++; cv_mem->cv_hu = cv_mem->cv_h; cv_mem->cv_qu = cv_mem->cv_q; for (i=cv_mem->cv_q; i >= 2; i--) cv_mem->cv_tau[i] = cv_mem->cv_tau[i-1]; if ((cv_mem->cv_q==1) && (cv_mem->cv_nst > 1)) cv_mem->cv_tau[2] = cv_mem->cv_tau[1]; cv_mem->cv_tau[1] = cv_mem->cv_h; /* Apply correction to column j of zn: l_j * Delta_n */ (void) N_VScaleAddMulti(cv_mem->cv_q+1, cv_mem->cv_l, cv_mem->cv_acor, cv_mem->cv_zn, cv_mem->cv_zn); if (cv_mem->cv_quadr) (void) N_VScaleAddMulti(cv_mem->cv_q+1, cv_mem->cv_l, cv_mem->cv_acorQ, cv_mem->cv_znQ, cv_mem->cv_znQ); if (cv_mem->cv_sensi) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q+1, cv_mem->cv_l, cv_mem->cv_acorS, cv_mem->cv_znS, cv_mem->cv_znS); if (cv_mem->cv_quadr_sensi) (void) N_VScaleAddMultiVectorArray(cv_mem->cv_Ns, cv_mem->cv_q+1, cv_mem->cv_l, cv_mem->cv_acorQS, cv_mem->cv_znQS, cv_mem->cv_znQS); /* If necessary, store Delta_n in zn[qmax] to be used in order increase. * This actually will be Delta_{n-1} in the ELTE at q+1 since it happens at * the next to last step of order q before a possible one at order q+1 */ cv_mem->cv_qwait--; if ((cv_mem->cv_qwait == 1) && (cv_mem->cv_q != cv_mem->cv_qmax)) { N_VScale(ONE, cv_mem->cv_acor, cv_mem->cv_zn[cv_mem->cv_qmax]); if (cv_mem->cv_quadr) N_VScale(ONE, cv_mem->cv_acorQ, cv_mem->cv_znQ[cv_mem->cv_qmax]); if (cv_mem->cv_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_acorS, cv_mem->cv_znS[cv_mem->cv_qmax]); } if (cv_mem->cv_quadr_sensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_acorQS, cv_mem->cv_znQS[cv_mem->cv_qmax]); } cv_mem->cv_saved_tq5 = cv_mem->cv_tq[5]; cv_mem->cv_indx_acor = cv_mem->cv_qmax; } } /* * cvPrepareNextStep * * This routine handles the setting of stepsize and order for the * next step -- hprime and qprime. Along with hprime, it sets the * ratio eta = hprime/h. It also updates other state variables * related to a change of step size or order. */ static void cvPrepareNextStep(CVodeMem cv_mem, realtype dsm) { /* If etamax = 1, defer step size or order changes */ if (cv_mem->cv_etamax == ONE) { cv_mem->cv_qwait = SUNMAX(cv_mem->cv_qwait, 2); cv_mem->cv_qprime = cv_mem->cv_q; cv_mem->cv_hprime = cv_mem->cv_h; cv_mem->cv_eta = ONE; return; } /* etaq is the ratio of new to old h at the current order */ cv_mem->cv_etaq = ONE /(SUNRpowerR(BIAS2*dsm,ONE/cv_mem->cv_L) + ADDON); /* If no order change, adjust eta and acor in cvSetEta and return */ if (cv_mem->cv_qwait != 0) { cv_mem->cv_eta = cv_mem->cv_etaq; cv_mem->cv_qprime = cv_mem->cv_q; cvSetEta(cv_mem); return; } /* If qwait = 0, consider an order change. etaqm1 and etaqp1 are the ratios of new to old h at orders q-1 and q+1, respectively. cvChooseEta selects the largest; cvSetEta adjusts eta and acor */ cv_mem->cv_qwait = 2; cv_mem->cv_etaqm1 = cvComputeEtaqm1(cv_mem); cv_mem->cv_etaqp1 = cvComputeEtaqp1(cv_mem); cvChooseEta(cv_mem); cvSetEta(cv_mem); } /* * cvSetEta * * This routine adjusts the value of eta according to the various * heuristic limits and the optional input hmax. */ static void cvSetEta(CVodeMem cv_mem) { /* If eta below the threshhold THRESH, reject a change of step size */ if (cv_mem->cv_eta < THRESH) { cv_mem->cv_eta = ONE; cv_mem->cv_hprime = cv_mem->cv_h; } else { /* Limit eta by etamax and hmax, then set hprime */ cv_mem->cv_eta = SUNMIN(cv_mem->cv_eta, cv_mem->cv_etamax); cv_mem->cv_eta /= SUNMAX(ONE, SUNRabs(cv_mem->cv_h) * cv_mem->cv_hmax_inv*cv_mem->cv_eta); cv_mem->cv_hprime = cv_mem->cv_h * cv_mem->cv_eta; if (cv_mem->cv_qprime < cv_mem->cv_q) cv_mem->cv_nscon = 0; } } /* * cvComputeEtaqm1 * * This routine computes and returns the value of etaqm1 for a * possible decrease in order by 1. */ static realtype cvComputeEtaqm1(CVodeMem cv_mem) { realtype ddn; cv_mem->cv_etaqm1 = ZERO; if (cv_mem->cv_q > 1) { ddn = N_VWrmsNorm(cv_mem->cv_zn[cv_mem->cv_q], cv_mem->cv_ewt); if ( cv_mem->cv_quadr && cv_mem->cv_errconQ ) ddn = cvQuadUpdateNorm(cv_mem, ddn, cv_mem->cv_znQ[cv_mem->cv_q], cv_mem->cv_ewtQ); if ( cv_mem->cv_sensi && cv_mem->cv_errconS ) ddn = cvSensUpdateNorm(cv_mem, ddn, cv_mem->cv_znS[cv_mem->cv_q], cv_mem->cv_ewtS); if ( cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS ) ddn = cvQuadSensUpdateNorm(cv_mem, ddn, cv_mem->cv_znQS[cv_mem->cv_q], cv_mem->cv_ewtQS); ddn = ddn * cv_mem->cv_tq[1]; cv_mem->cv_etaqm1 = ONE/(SUNRpowerR(BIAS1*ddn, ONE/cv_mem->cv_q) + ADDON); } return(cv_mem->cv_etaqm1); } /* * cvComputeEtaqp1 * * This routine computes and returns the value of etaqp1 for a * possible increase in order by 1. */ static realtype cvComputeEtaqp1(CVodeMem cv_mem) { realtype dup, cquot; cv_mem->cv_etaqp1 = ZERO; if (cv_mem->cv_q != cv_mem->cv_qmax) { if (cv_mem->cv_saved_tq5 == ZERO) return(cv_mem->cv_etaqp1); cquot = (cv_mem->cv_tq[5] / cv_mem->cv_saved_tq5) * SUNRpowerI(cv_mem->cv_h/cv_mem->cv_tau[2], cv_mem->cv_L); N_VLinearSum(-cquot, cv_mem->cv_zn[cv_mem->cv_qmax], ONE, cv_mem->cv_acor, cv_mem->cv_tempv); dup = N_VWrmsNorm(cv_mem->cv_tempv, cv_mem->cv_ewt); if ( cv_mem->cv_quadr && cv_mem->cv_errconQ ) { N_VLinearSum(-cquot, cv_mem->cv_znQ[cv_mem->cv_qmax], ONE, cv_mem->cv_acorQ, cv_mem->cv_tempvQ); dup = cvQuadUpdateNorm(cv_mem, dup, cv_mem->cv_tempvQ, cv_mem->cv_ewtQ); } if ( cv_mem->cv_sensi && cv_mem->cv_errconS ) { (void) N_VLinearSumVectorArray(cv_mem->cv_Ns, -cquot, cv_mem->cv_znS[cv_mem->cv_qmax], ONE, cv_mem->cv_acorS, cv_mem->cv_tempvS); dup = cvSensUpdateNorm(cv_mem, dup, cv_mem->cv_tempvS, cv_mem->cv_ewtS); } if ( cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS ) { (void) N_VLinearSumVectorArray(cv_mem->cv_Ns, -cquot, cv_mem->cv_znQS[cv_mem->cv_qmax], ONE, cv_mem->cv_acorQS, cv_mem->cv_tempvQS); dup = cvSensUpdateNorm(cv_mem, dup, cv_mem->cv_tempvQS, cv_mem->cv_ewtQS); } dup = dup * cv_mem->cv_tq[3]; cv_mem->cv_etaqp1 = ONE / (SUNRpowerR(BIAS3*dup, ONE/(cv_mem->cv_L+1)) + ADDON); } return(cv_mem->cv_etaqp1); } /* * cvChooseEta * Given etaqm1, etaq, etaqp1 (the values of eta for qprime = * q - 1, q, or q + 1, respectively), this routine chooses the * maximum eta value, sets eta to that value, and sets qprime to the * corresponding value of q. If there is a tie, the preference * order is to (1) keep the same order, then (2) decrease the order, * and finally (3) increase the order. If the maximum eta value * is below the threshhold THRESH, the order is kept unchanged and * eta is set to 1. */ static void cvChooseEta(CVodeMem cv_mem) { realtype etam; int is; etam = SUNMAX(cv_mem->cv_etaqm1, SUNMAX(cv_mem->cv_etaq, cv_mem->cv_etaqp1)); if (etam < THRESH) { cv_mem->cv_eta = ONE; cv_mem->cv_qprime = cv_mem->cv_q; return; } if (etam == cv_mem->cv_etaq) { cv_mem->cv_eta = cv_mem->cv_etaq; cv_mem->cv_qprime = cv_mem->cv_q; } else if (etam == cv_mem->cv_etaqm1) { cv_mem->cv_eta = cv_mem->cv_etaqm1; cv_mem->cv_qprime = cv_mem->cv_q - 1; } else { cv_mem->cv_eta = cv_mem->cv_etaqp1; cv_mem->cv_qprime = cv_mem->cv_q + 1; if (cv_mem->cv_lmm == CV_BDF) { /* * Store Delta_n in zn[qmax] to be used in order increase * * This happens at the last step of order q before an increase * to order q+1, so it represents Delta_n in the ELTE at q+1 */ N_VScale(ONE, cv_mem->cv_acor, cv_mem->cv_zn[cv_mem->cv_qmax]); if (cv_mem->cv_quadr && cv_mem->cv_errconQ) N_VScale(ONE, cv_mem->cv_acorQ, cv_mem->cv_znQ[cv_mem->cv_qmax]); if (cv_mem->cv_sensi && cv_mem->cv_errconS) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_acorS, cv_mem->cv_znS[cv_mem->cv_qmax]); } if (cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_acorQS, cv_mem->cv_znQS[cv_mem->cv_qmax]); } } } } /* * ----------------------------------------------------------------- * Function to handle failures * ----------------------------------------------------------------- */ /* * cvHandleFailure * * This routine prints error messages for all cases of failure by * cvHin or cvStep. * It returns to CVode the value that CVode is to return to the user. */ static int cvHandleFailure(CVodeMem cv_mem, int flag) { /* Set vector of absolute weighted local errors */ /* N_VProd(acor, ewt, tempv); N_VAbs(tempv, tempv); */ /* Depending on flag, print error message and return error flag */ switch (flag) { case CV_ERR_FAILURE: cvProcessError(cv_mem, CV_ERR_FAILURE, "CVODES", "CVode", MSGCV_ERR_FAILS, cv_mem->cv_tn, cv_mem->cv_h); break; case CV_CONV_FAILURE: cvProcessError(cv_mem, CV_CONV_FAILURE, "CVODES", "CVode", MSGCV_CONV_FAILS, cv_mem->cv_tn, cv_mem->cv_h); break; case CV_LSETUP_FAIL: cvProcessError(cv_mem, CV_LSETUP_FAIL, "CVODES", "CVode", MSGCV_SETUP_FAILED, cv_mem->cv_tn); break; case CV_LSOLVE_FAIL: cvProcessError(cv_mem, CV_LSOLVE_FAIL, "CVODES", "CVode", MSGCV_SOLVE_FAILED, cv_mem->cv_tn); break; case CV_RHSFUNC_FAIL: cvProcessError(cv_mem, CV_RHSFUNC_FAIL, "CVODES", "CVode", MSGCV_RHSFUNC_FAILED, cv_mem->cv_tn); break; case CV_UNREC_RHSFUNC_ERR: cvProcessError(cv_mem, CV_UNREC_RHSFUNC_ERR, "CVODES", "CVode", MSGCV_RHSFUNC_UNREC, cv_mem->cv_tn); break; case CV_REPTD_RHSFUNC_ERR: cvProcessError(cv_mem, CV_REPTD_RHSFUNC_ERR, "CVODES", "CVode", MSGCV_RHSFUNC_REPTD, cv_mem->cv_tn); break; case CV_RTFUNC_FAIL: cvProcessError(cv_mem, CV_RTFUNC_FAIL, "CVODES", "CVode", MSGCV_RTFUNC_FAILED, cv_mem->cv_tn); break; case CV_QRHSFUNC_FAIL: cvProcessError(cv_mem, CV_QRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QRHSFUNC_FAILED, cv_mem->cv_tn); break; case CV_UNREC_QRHSFUNC_ERR: cvProcessError(cv_mem, CV_UNREC_QRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QRHSFUNC_UNREC, cv_mem->cv_tn); break; case CV_REPTD_QRHSFUNC_ERR: cvProcessError(cv_mem, CV_REPTD_QRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QRHSFUNC_REPTD, cv_mem->cv_tn); break; case CV_SRHSFUNC_FAIL: cvProcessError(cv_mem, CV_SRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_SRHSFUNC_FAILED, cv_mem->cv_tn); break; case CV_UNREC_SRHSFUNC_ERR: cvProcessError(cv_mem, CV_UNREC_SRHSFUNC_ERR, "CVODES", "CVode", MSGCV_SRHSFUNC_UNREC, cv_mem->cv_tn); break; case CV_REPTD_SRHSFUNC_ERR: cvProcessError(cv_mem, CV_REPTD_SRHSFUNC_ERR, "CVODES", "CVode", MSGCV_SRHSFUNC_REPTD, cv_mem->cv_tn); break; case CV_QSRHSFUNC_FAIL: cvProcessError(cv_mem, CV_QSRHSFUNC_FAIL, "CVODES", "CVode", MSGCV_QSRHSFUNC_FAILED, cv_mem->cv_tn); break; case CV_UNREC_QSRHSFUNC_ERR: cvProcessError(cv_mem, CV_UNREC_QSRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QSRHSFUNC_UNREC, cv_mem->cv_tn); break; case CV_REPTD_QSRHSFUNC_ERR: cvProcessError(cv_mem, CV_REPTD_QSRHSFUNC_ERR, "CVODES", "CVode", MSGCV_QSRHSFUNC_REPTD, cv_mem->cv_tn); break; case CV_TOO_CLOSE: cvProcessError(cv_mem, CV_TOO_CLOSE, "CVODES", "CVode", MSGCV_TOO_CLOSE); break; case CV_MEM_NULL: cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVode", MSGCV_NO_MEM); break; case SUN_NLS_MEM_NULL: cvProcessError(cv_mem, CV_MEM_NULL, "CVODES", "CVode", MSGCV_NLS_INPUT_NULL, cv_mem->cv_tn); break; case CV_NLS_SETUP_FAIL: cvProcessError(cv_mem, CV_NLS_SETUP_FAIL, "CVODES", "CVode", MSGCV_NLS_SETUP_FAILED, cv_mem->cv_tn); break; case CV_CONSTR_FAIL: cvProcessError(cv_mem, CV_CONSTR_FAIL, "CVODES", "CVode", MSGCV_FAILED_CONSTR, cv_mem->cv_tn); default: return(CV_SUCCESS); } return(flag); } /* * ----------------------------------------------------------------- * Functions for BDF Stability Limit Detection * ----------------------------------------------------------------- */ /* * cvBDFStab * * This routine handles the BDF Stability Limit Detection Algorithm * STALD. It is called if lmm = CV_BDF and the SLDET option is on. * If the order is 3 or more, the required norm data is saved. * If a decision to reduce order has not already been made, and * enough data has been saved, cvSLdet is called. If it signals * a stability limit violation, the order is reduced, and the step * size is reset accordingly. */ static void cvBDFStab(CVodeMem cv_mem) { int i,k, ldflag, factorial; realtype sq, sqm1, sqm2; /* If order is 3 or greater, then save scaled derivative data, push old data down in i, then add current values to top. */ if (cv_mem->cv_q >= 3) { for (k = 1; k <= 3; k++) for (i = 5; i >= 2; i--) cv_mem->cv_ssdat[i][k] = cv_mem->cv_ssdat[i-1][k]; factorial = 1; for (i = 1; i <= cv_mem->cv_q-1; i++) factorial *= i; sq = factorial * cv_mem->cv_q * (cv_mem->cv_q+1) * cv_mem->cv_acnrm / SUNMAX(cv_mem->cv_tq[5],TINY); sqm1 = factorial * cv_mem->cv_q * N_VWrmsNorm(cv_mem->cv_zn[cv_mem->cv_q], cv_mem->cv_ewt); sqm2 = factorial * N_VWrmsNorm(cv_mem->cv_zn[cv_mem->cv_q-1], cv_mem->cv_ewt); cv_mem->cv_ssdat[1][1] = sqm2*sqm2; cv_mem->cv_ssdat[1][2] = sqm1*sqm1; cv_mem->cv_ssdat[1][3] = sq*sq; } if (cv_mem->cv_qprime >= cv_mem->cv_q) { /* If order is 3 or greater, and enough ssdat has been saved, nscon >= q+5, then call stability limit detection routine. */ if ( (cv_mem->cv_q >= 3) && (cv_mem->cv_nscon >= cv_mem->cv_q+5) ) { ldflag = cvSLdet(cv_mem); if (ldflag > 3) { /* A stability limit violation is indicated by a return flag of 4, 5, or 6. Reduce new order. */ cv_mem->cv_qprime = cv_mem->cv_q-1; cv_mem->cv_eta = cv_mem->cv_etaqm1; cv_mem->cv_eta = SUNMIN(cv_mem->cv_eta,cv_mem->cv_etamax); cv_mem->cv_eta = cv_mem->cv_eta / SUNMAX(ONE,SUNRabs(cv_mem->cv_h)*cv_mem->cv_hmax_inv*cv_mem->cv_eta); cv_mem->cv_hprime = cv_mem->cv_h * cv_mem->cv_eta; cv_mem->cv_nor = cv_mem->cv_nor + 1; } } } else { /* Otherwise, let order increase happen, and reset stability limit counter, nscon. */ cv_mem->cv_nscon = 0; } } /* * cvSLdet * * This routine detects stability limitation using stored scaled * derivatives data. cvSLdet returns the magnitude of the * dominate characteristic root, rr. The presence of a stability * limit is indicated by rr > "something a little less then 1.0", * and a positive kflag. This routine should only be called if * order is greater than or equal to 3, and data has been collected * for 5 time steps. * * Returned values: * kflag = 1 -> Found stable characteristic root, normal matrix case * kflag = 2 -> Found stable characteristic root, quartic solution * kflag = 3 -> Found stable characteristic root, quartic solution, * with Newton correction * kflag = 4 -> Found stability violation, normal matrix case * kflag = 5 -> Found stability violation, quartic solution * kflag = 6 -> Found stability violation, quartic solution, * with Newton correction * * kflag < 0 -> No stability limitation, * or could not compute limitation. * * kflag = -1 -> Min/max ratio of ssdat too small. * kflag = -2 -> For normal matrix case, vmax > vrrt2*vrrt2 * kflag = -3 -> For normal matrix case, The three ratios * are inconsistent. * kflag = -4 -> Small coefficient prevents elimination of quartics. * kflag = -5 -> R value from quartics not consistent. * kflag = -6 -> No corrected root passes test on qk values * kflag = -7 -> Trouble solving for sigsq. * kflag = -8 -> Trouble solving for B, or R via B. * kflag = -9 -> R via sigsq[k] disagrees with R from data. */ static int cvSLdet(CVodeMem cv_mem) { int i, k, j, it, kmin = 0, kflag = 0; realtype rat[5][4], rav[4], qkr[4], sigsq[4], smax[4], ssmax[4]; realtype drr[4], rrc[4],sqmx[4], qjk[4][4], vrat[5], qc[6][4], qco[6][4]; realtype rr, rrcut, vrrtol, vrrt2, sqtol, rrtol; realtype smink, smaxk, sumrat, sumrsq, vmin, vmax, drrmax, adrr; realtype tem, sqmax, saqk, qp, s, sqmaxk, saqj, sqmin; realtype rsa, rsb, rsc, rsd, rd1a, rd1b, rd1c; realtype rd2a, rd2b, rd3a, cest1, corr1; realtype ratp, ratm, qfac1, qfac2, bb, rrb; /* The following are cutoffs and tolerances used by this routine */ rrcut = RCONST(0.98); vrrtol = RCONST(1.0e-4); vrrt2 = RCONST(5.0e-4); sqtol = RCONST(1.0e-3); rrtol = RCONST(1.0e-2); rr = ZERO; /* Index k corresponds to the degree of the interpolating polynomial. */ /* k = 1 -> q-1 */ /* k = 2 -> q */ /* k = 3 -> q+1 */ /* Index i is a backward-in-time index, i = 1 -> current time, */ /* i = 2 -> previous step, etc */ /* get maxima, minima, and variances, and form quartic coefficients */ for (k=1; k<=3; k++) { smink = cv_mem->cv_ssdat[1][k]; smaxk = ZERO; for (i=1; i<=5; i++) { smink = SUNMIN(smink,cv_mem->cv_ssdat[i][k]); smaxk = SUNMAX(smaxk,cv_mem->cv_ssdat[i][k]); } if (smink < TINY*smaxk) { kflag = -1; return(kflag); } smax[k] = smaxk; ssmax[k] = smaxk*smaxk; sumrat = ZERO; sumrsq = ZERO; for (i=1; i<=4; i++) { rat[i][k] = cv_mem->cv_ssdat[i][k] / cv_mem->cv_ssdat[i+1][k]; sumrat = sumrat + rat[i][k]; sumrsq = sumrsq + rat[i][k]*rat[i][k]; } rav[k] = FOURTH*sumrat; vrat[k] = SUNRabs(FOURTH*sumrsq - rav[k]*rav[k]); qc[5][k] = cv_mem->cv_ssdat[1][k] * cv_mem->cv_ssdat[3][k] - cv_mem->cv_ssdat[2][k] * cv_mem->cv_ssdat[2][k]; qc[4][k] = cv_mem->cv_ssdat[2][k] * cv_mem->cv_ssdat[3][k] - cv_mem->cv_ssdat[1][k] * cv_mem->cv_ssdat[4][k]; qc[3][k] = ZERO; qc[2][k] = cv_mem->cv_ssdat[2][k] * cv_mem->cv_ssdat[5][k] - cv_mem->cv_ssdat[3][k] * cv_mem->cv_ssdat[4][k]; qc[1][k] = cv_mem->cv_ssdat[4][k] * cv_mem->cv_ssdat[4][k] - cv_mem->cv_ssdat[3][k] * cv_mem->cv_ssdat[5][k]; for (i=1; i<=5; i++) { qco[i][k] = qc[i][k]; } } /* End of k loop */ /* Isolate normal or nearly-normal matrix case. The three quartics will have a common or nearly-common root in this case. Return a kflag = 1 if this procedure works. If the three roots differ more than vrrt2, return error kflag = -3. */ vmin = SUNMIN(vrat[1],SUNMIN(vrat[2],vrat[3])); vmax = SUNMAX(vrat[1],SUNMAX(vrat[2],vrat[3])); if (vmin < vrrtol*vrrtol) { if (vmax > vrrt2*vrrt2) { kflag = -2; return(kflag); } else { rr = (rav[1] + rav[2] + rav[3])/THREE; drrmax = ZERO; for (k = 1;k<=3;k++) { adrr = SUNRabs(rav[k] - rr); drrmax = SUNMAX(drrmax, adrr); } if (drrmax > vrrt2) { kflag = -3; return(kflag); } kflag = 1; /* can compute charactistic root, drop to next section */ } } else { /* use the quartics to get rr. */ if (SUNRabs(qco[1][1]) < TINY*ssmax[1]) { kflag = -4; return(kflag); } tem = qco[1][2]/qco[1][1]; for (i=2; i<=5; i++) { qco[i][2] = qco[i][2] - tem*qco[i][1]; } qco[1][2] = ZERO; tem = qco[1][3]/qco[1][1]; for (i=2; i<=5; i++) { qco[i][3] = qco[i][3] - tem*qco[i][1]; } qco[1][3] = ZERO; if (SUNRabs(qco[2][2]) < TINY*ssmax[2]) { kflag = -4; return(kflag); } tem = qco[2][3]/qco[2][2]; for (i=3; i<=5; i++) { qco[i][3] = qco[i][3] - tem*qco[i][2]; } if (SUNRabs(qco[4][3]) < TINY*ssmax[3]) { kflag = -4; return(kflag); } rr = -qco[5][3]/qco[4][3]; if (rr < TINY || rr > HUNDRED) { kflag = -5; return(kflag); } for (k=1; k<=3; k++) qkr[k] = qc[5][k] + rr*(qc[4][k] + rr*rr*(qc[2][k] + rr*qc[1][k])); sqmax = ZERO; for (k=1; k<=3; k++) { saqk = SUNRabs(qkr[k])/ssmax[k]; if (saqk > sqmax) sqmax = saqk; } if (sqmax < sqtol) { kflag = 2; /* can compute charactistic root, drop to "given rr,etc" */ } else { /* do Newton corrections to improve rr. */ for (it=1; it<=3; it++) { for (k=1; k<=3; k++) { qp = qc[4][k] + rr*rr*(THREE*qc[2][k] + rr*FOUR*qc[1][k]); drr[k] = ZERO; if (SUNRabs(qp) > TINY*ssmax[k]) drr[k] = -qkr[k]/qp; rrc[k] = rr + drr[k]; } for (k=1; k<=3; k++) { s = rrc[k]; sqmaxk = ZERO; for (j=1; j<=3; j++) { qjk[j][k] = qc[5][j] + s*(qc[4][j] + s*s*(qc[2][j] + s*qc[1][j])); saqj = SUNRabs(qjk[j][k])/ssmax[j]; if (saqj > sqmaxk) sqmaxk = saqj; } sqmx[k] = sqmaxk; } sqmin = sqmx[1] + ONE; for (k=1; k<=3; k++) { if (sqmx[k] < sqmin) { kmin = k; sqmin = sqmx[k]; } } rr = rrc[kmin]; if (sqmin < sqtol) { kflag = 3; /* can compute charactistic root */ /* break out of Newton correction loop and drop to "given rr,etc" */ break; } else { for (j=1; j<=3; j++) { qkr[j] = qjk[j][kmin]; } } } /* end of Newton correction loop */ if (sqmin > sqtol) { kflag = -6; return(kflag); } } /* end of if (sqmax < sqtol) else */ } /* end of if (vmin < vrrtol*vrrtol) else, quartics to get rr. */ /* given rr, find sigsq[k] and verify rr. */ /* All positive kflag drop to this section */ for (k=1; k<=3; k++) { rsa = cv_mem->cv_ssdat[1][k]; rsb = cv_mem->cv_ssdat[2][k]*rr; rsc = cv_mem->cv_ssdat[3][k]*rr*rr; rsd = cv_mem->cv_ssdat[4][k]*rr*rr*rr; rd1a = rsa - rsb; rd1b = rsb - rsc; rd1c = rsc - rsd; rd2a = rd1a - rd1b; rd2b = rd1b - rd1c; rd3a = rd2a - rd2b; if (SUNRabs(rd1b) < TINY*smax[k]) { kflag = -7; return(kflag); } cest1 = -rd3a/rd1b; if (cest1 < TINY || cest1 > FOUR) { kflag = -7; return(kflag); } corr1 = (rd2b/cest1)/(rr*rr); sigsq[k] = cv_mem->cv_ssdat[3][k] + corr1; } if (sigsq[2] < TINY) { kflag = -8; return(kflag); } ratp = sigsq[3]/sigsq[2]; ratm = sigsq[1]/sigsq[2]; qfac1 = FOURTH*(cv_mem->cv_q*cv_mem->cv_q - ONE); qfac2 = TWO/(cv_mem->cv_q - ONE); bb = ratp*ratm - ONE - qfac1*ratp; tem = ONE - qfac2*bb; if (SUNRabs(tem) < TINY) { kflag = -8; return(kflag); } rrb = ONE/tem; if (SUNRabs(rrb - rr) > rrtol) { kflag = -9; return(kflag); } /* Check to see if rr is above cutoff rrcut */ if (rr > rrcut) { if (kflag == 1) kflag = 4; if (kflag == 2) kflag = 5; if (kflag == 3) kflag = 6; } /* All positive kflag returned at this point */ return(kflag); } /* * ----------------------------------------------------------------- * Functions for rootfinding * ----------------------------------------------------------------- */ /* * cvRcheck1 * * This routine completes the initialization of rootfinding memory * information, and checks whether g has a zero both at and very near * the initial point of the IVP. * * This routine returns an int equal to: * CV_RTFUNC_FAIL < 0 if the g function failed, or * CV_SUCCESS = 0 otherwise. */ static int cvRcheck1(CVodeMem cv_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_iroots[i] = 0; cv_mem->cv_tlo = cv_mem->cv_tn; cv_mem->cv_ttol = (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_h)) * cv_mem->cv_uround*HUNDRED; /* Evaluate g at initial t and check for zero values. */ retval = cv_mem->cv_gfun(cv_mem->cv_tlo, cv_mem->cv_zn[0], cv_mem->cv_glo, cv_mem->cv_user_data); cv_mem->cv_nge = 1; if (retval != 0) return(CV_RTFUNC_FAIL); zroot = SUNFALSE; for (i = 0; i < cv_mem->cv_nrtfn; i++) { if (SUNRabs(cv_mem->cv_glo[i]) == ZERO) { zroot = SUNTRUE; cv_mem->cv_gactive[i] = SUNFALSE; } } if (!zroot) return(CV_SUCCESS); /* Some g_i is zero at t0; look at g at t0+(small increment). */ hratio = SUNMAX(cv_mem->cv_ttol/SUNRabs(cv_mem->cv_h), PT1); smallh = hratio*cv_mem->cv_h; tplus = cv_mem->cv_tlo + smallh; N_VLinearSum(ONE, cv_mem->cv_zn[0], hratio, cv_mem->cv_zn[1], cv_mem->cv_y); retval = cv_mem->cv_gfun(tplus, cv_mem->cv_y, cv_mem->cv_ghi, cv_mem->cv_user_data); cv_mem->cv_nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* We check now only the components of g which were exactly 0.0 at t0 * to see if we can 'activate' them. */ for (i = 0; i < cv_mem->cv_nrtfn; i++) { if (!cv_mem->cv_gactive[i] && SUNRabs(cv_mem->cv_ghi[i]) != ZERO) { cv_mem->cv_gactive[i] = SUNTRUE; cv_mem->cv_glo[i] = cv_mem->cv_ghi[i]; } } return(CV_SUCCESS); } /* * cvRcheck2 * * This routine checks for exact zeros of g at the last root found, * if the last return was a root. It then checks for a close pair of * zeros (an error condition), and for a new root at a nearby point. * The array glo = g(tlo) at the left endpoint of the search interval * is adjusted if necessary to assure that all g_i are nonzero * there, before returning to do a root search in the interval. * * On entry, tlo = tretlast is the last value of tret returned by * CVode. This may be the previous tn, the previous tout value, * or the last root location. * * This routine returns an int equal to: * CV_RTFUNC_FAIL < 0 if the g function failed, or * CLOSERT = 3 if a close pair of zeros was found, or * RTFOUND = 1 if a new zero of g was found near tlo, or * CV_SUCCESS = 0 otherwise. */ static int cvRcheck2(CVodeMem cv_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; if (cv_mem->cv_irfnd == 0) return(CV_SUCCESS); (void) CVodeGetDky(cv_mem, cv_mem->cv_tlo, 0, cv_mem->cv_y); retval = cv_mem->cv_gfun(cv_mem->cv_tlo, cv_mem->cv_y, cv_mem->cv_glo, cv_mem->cv_user_data); cv_mem->cv_nge++; if (retval != 0) return(CV_RTFUNC_FAIL); zroot = SUNFALSE; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_iroots[i] = 0; for (i = 0; i < cv_mem->cv_nrtfn; i++) { if (!cv_mem->cv_gactive[i]) continue; if (SUNRabs(cv_mem->cv_glo[i]) == ZERO) { zroot = SUNTRUE; cv_mem->cv_iroots[i] = 1; } } if (!zroot) return(CV_SUCCESS); /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ cv_mem->cv_ttol = (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_h)) * cv_mem->cv_uround*HUNDRED; smallh = (cv_mem->cv_h > ZERO) ? cv_mem->cv_ttol : -cv_mem->cv_ttol; tplus = cv_mem->cv_tlo + smallh; if ( (tplus - cv_mem->cv_tn)*cv_mem->cv_h >= ZERO) { hratio = smallh/cv_mem->cv_h; N_VLinearSum(ONE, cv_mem->cv_y, hratio, cv_mem->cv_zn[1], cv_mem->cv_y); } else { (void) CVodeGetDky(cv_mem, tplus, 0, cv_mem->cv_y); } retval = cv_mem->cv_gfun(tplus, cv_mem->cv_y, cv_mem->cv_ghi, cv_mem->cv_user_data); cv_mem->cv_nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* Check for close roots (error return), for a new zero at tlo+smallh, and for a g_i that changed from zero to nonzero. */ zroot = SUNFALSE; for (i = 0; i < cv_mem->cv_nrtfn; i++) { if (!cv_mem->cv_gactive[i]) continue; if (SUNRabs(cv_mem->cv_ghi[i]) == ZERO) { if (cv_mem->cv_iroots[i] == 1) return(CLOSERT); zroot = SUNTRUE; cv_mem->cv_iroots[i] = 1; } else { if (cv_mem->cv_iroots[i] == 1) cv_mem->cv_glo[i] = cv_mem->cv_ghi[i]; } } if (zroot) return(RTFOUND); return(CV_SUCCESS); } /* * cvRcheck3 * * This routine interfaces to cvRootfind to look for a root of g * between tlo and either tn or tout, whichever comes first. * Only roots beyond tlo in the direction of integration are sought. * * This routine returns an int equal to: * CV_RTFUNC_FAIL < 0 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * CV_SUCCESS = 0 otherwise. */ static int cvRcheck3(CVodeMem cv_mem) { int i, ier, retval; /* Set thi = tn or tout, whichever comes first; set y = y(thi). */ if (cv_mem->cv_taskc == CV_ONE_STEP) { cv_mem->cv_thi = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], cv_mem->cv_y); } if (cv_mem->cv_taskc == CV_NORMAL) { if ( (cv_mem->cv_toutc - cv_mem->cv_tn)*cv_mem->cv_h >= ZERO) { cv_mem->cv_thi = cv_mem->cv_tn; N_VScale(ONE, cv_mem->cv_zn[0], cv_mem->cv_y); } else { cv_mem->cv_thi = cv_mem->cv_toutc; (void) CVodeGetDky(cv_mem, cv_mem->cv_thi, 0, cv_mem->cv_y); } } /* Set ghi = g(thi) and call cvRootfind to search (tlo,thi) for roots. */ retval = cv_mem->cv_gfun(cv_mem->cv_thi, cv_mem->cv_y, cv_mem->cv_ghi, cv_mem->cv_user_data); cv_mem->cv_nge++; if (retval != 0) return(CV_RTFUNC_FAIL); cv_mem->cv_ttol = (SUNRabs(cv_mem->cv_tn) + SUNRabs(cv_mem->cv_h)) * cv_mem->cv_uround*HUNDRED; ier = cvRootfind(cv_mem); if (ier == CV_RTFUNC_FAIL) return(CV_RTFUNC_FAIL); for(i=0; icv_nrtfn; i++) { if(!cv_mem->cv_gactive[i] && cv_mem->cv_grout[i] != ZERO) cv_mem->cv_gactive[i] = SUNTRUE; } cv_mem->cv_tlo = cv_mem->cv_trout; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_glo[i] = cv_mem->cv_grout[i]; /* If no root found, return CV_SUCCESS. */ if (ier == CV_SUCCESS) return(CV_SUCCESS); /* If a root was found, interpolate to get y(trout) and return. */ (void) CVodeGetDky(cv_mem, cv_mem->cv_trout, 0, cv_mem->cv_y); return(RTFOUND); } /* * cvRootfind * * This routine solves for a root of g(t) between tlo and thi, if * one exists. Only roots of odd multiplicity (i.e. with a change * of sign in one of the g_i), or exact zeros, are found. * Here the sign of tlo - thi is arbitrary, but if multiple roots * are found, the one closest to tlo is returned. * * The method used is the Illinois algorithm, a modified secant method. * Reference: Kathie L. Hiebert and Lawrence F. Shampine, Implicitly * Defined Output Points for Solutions of ODEs, Sandia National * Laboratory Report SAND80-0180, February 1980. * * This routine uses the following parameters for communication: * * nrtfn = number of functions g_i, or number of components of * the vector-valued function g(t). Input only. * * gfun = user-defined function for g(t). Its form is * (void) gfun(t, y, gt, user_data) * * rootdir = in array specifying the direction of zero-crossings. * If rootdir[i] > 0, search for roots of g_i only if * g_i is increasing; if rootdir[i] < 0, search for * roots of g_i only if g_i is decreasing; otherwise * always search for roots of g_i. * * gactive = array specifying whether a component of g should * or should not be monitored. gactive[i] is initially * set to SUNTRUE for all i=0,...,nrtfn-1, but it may be * reset to SUNFALSE if at the first step g[i] is 0.0 * both at the I.C. and at a small perturbation of them. * gactive[i] is then set back on SUNTRUE only after the * corresponding g function moves away from 0.0. * * nge = cumulative counter for gfun calls. * * ttol = a convergence tolerance for trout. Input only. * When a root at trout is found, it is located only to * within a tolerance of ttol. Typically, ttol should * be set to a value on the order of * 100 * UROUND * max (SUNRabs(tlo), SUNRabs(thi)) * where UROUND is the unit roundoff of the machine. * * tlo, thi = endpoints of the interval in which roots are sought. * On input, these must be distinct, but tlo - thi may * be of either sign. The direction of integration is * assumed to be from tlo to thi. On return, tlo and thi * are the endpoints of the final relevant interval. * * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) * and g(thi) respectively. Input and output. On input, * none of the glo[i] should be zero. * * trout = root location, if a root was found, or thi if not. * Output only. If a root was found other than an exact * zero of g, trout is the endpoint thi of the final * interval bracketing the root, with size at most ttol. * * grout = array of length nrtfn containing g(trout) on return. * * iroots = int array of length nrtfn with root information. * Output only. If a root was found, iroots indicates * which components g_i have a root at trout. For * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root * and g_i is increasing, iroots[i] = -1 if g_i has a * root and g_i is decreasing, and iroots[i] = 0 if g_i * has no roots or g_i varies in the direction opposite * to that indicated by rootdir[i]. * * This routine returns an int equal to: * CV_RTFUNC_FAIL < 0 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * CV_SUCCESS = 0 otherwise. */ static int cvRootfind(CVodeMem cv_mem) { realtype alph, tmid, gfrac, maxfrac, fracint, fracsub; int i, retval, imax, side, sideprev; booleantype zroot, sgnchg; imax = 0; /* First check for change in sign in ghi or for a zero in ghi. */ maxfrac = ZERO; zroot = SUNFALSE; sgnchg = SUNFALSE; for (i = 0; i < cv_mem->cv_nrtfn; i++) { if(!cv_mem->cv_gactive[i]) continue; if (SUNRabs(cv_mem->cv_ghi[i]) == ZERO) { if(cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) { zroot = SUNTRUE; } } else { if ( (cv_mem->cv_glo[i]*cv_mem->cv_ghi[i] < ZERO) && (cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) ) { gfrac = SUNRabs(cv_mem->cv_ghi[i]/(cv_mem->cv_ghi[i] - cv_mem->cv_glo[i])); if (gfrac > maxfrac) { sgnchg = SUNTRUE; maxfrac = gfrac; imax = i; } } } } /* If no sign change was found, reset trout and grout. Then return CV_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ if (!sgnchg) { cv_mem->cv_trout = cv_mem->cv_thi; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_grout[i] = cv_mem->cv_ghi[i]; if (!zroot) return(CV_SUCCESS); for (i = 0; i < cv_mem->cv_nrtfn; i++) { cv_mem->cv_iroots[i] = 0; if(!cv_mem->cv_gactive[i]) continue; if ( (SUNRabs(cv_mem->cv_ghi[i]) == ZERO) && (cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) ) cv_mem->cv_iroots[i] = cv_mem->cv_glo[i] > 0 ? -1:1; } return(RTFOUND); } /* Initialize alph to avoid compiler warning */ alph = ONE; /* A sign change was found. Loop to locate nearest root. */ side = 0; sideprev = -1; for(;;) { /* Looping point */ /* If interval size is already less than tolerance ttol, break. */ if (SUNRabs(cv_mem->cv_thi - cv_mem->cv_tlo) <= cv_mem->cv_ttol) break; /* Set weight alph. On the first two passes, set alph = 1. Thereafter, reset alph according to the side (low vs high) of the subinterval in which the sign change was found in the previous two passes. If the sides were opposite, set alph = 1. If the sides were the same, then double alph (if high side), or halve alph (if low side). The next guess tmid is the secant method value if alph = 1, but is closer to cv_mem->cv_tlo if alph < 1, and closer to thi if alph > 1. */ if (sideprev == side) { alph = (side == 2) ? alph*TWO : alph*HALF; } else { alph = ONE; } /* Set next root approximation tmid and get g(tmid). If tmid is too close to tlo or thi, adjust it inward, by a fractional distance that is between 0.1 and 0.5. */ tmid = cv_mem->cv_thi - (cv_mem->cv_thi - cv_mem->cv_tlo) * cv_mem->cv_ghi[imax] / (cv_mem->cv_ghi[imax] - alph*cv_mem->cv_glo[imax]); if (SUNRabs(tmid - cv_mem->cv_tlo) < HALF*cv_mem->cv_ttol) { fracint = SUNRabs(cv_mem->cv_thi - cv_mem->cv_tlo)/cv_mem->cv_ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = cv_mem->cv_tlo + fracsub*(cv_mem->cv_thi - cv_mem->cv_tlo); } if (SUNRabs(cv_mem->cv_thi - tmid) < HALF*cv_mem->cv_ttol) { fracint = SUNRabs(cv_mem->cv_thi - cv_mem->cv_tlo)/cv_mem->cv_ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = cv_mem->cv_thi - fracsub*(cv_mem->cv_thi - cv_mem->cv_tlo); } (void) CVodeGetDky(cv_mem, tmid, 0, cv_mem->cv_y); retval = cv_mem->cv_gfun(tmid, cv_mem->cv_y, cv_mem->cv_grout, cv_mem->cv_user_data); cv_mem->cv_nge++; if (retval != 0) return(CV_RTFUNC_FAIL); /* Check to see in which subinterval g changes sign, and reset imax. Set side = 1 if sign change is on low side, or 2 if on high side. */ maxfrac = ZERO; zroot = SUNFALSE; sgnchg = SUNFALSE; sideprev = side; for (i = 0; i < cv_mem->cv_nrtfn; i++) { if(!cv_mem->cv_gactive[i]) continue; if (SUNRabs(cv_mem->cv_grout[i]) == ZERO) { if(cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) zroot = SUNTRUE; } else { if ( (cv_mem->cv_glo[i]*cv_mem->cv_grout[i] < ZERO) && (cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) ) { gfrac = SUNRabs(cv_mem->cv_grout[i] / (cv_mem->cv_grout[i] - cv_mem->cv_glo[i])); if (gfrac > maxfrac) { sgnchg = SUNTRUE; maxfrac = gfrac; imax = i; } } } } if (sgnchg) { /* Sign change found in (tlo,tmid); replace thi with tmid. */ cv_mem->cv_thi = tmid; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_ghi[i] = cv_mem->cv_grout[i]; side = 1; /* Stop at root thi if converged; otherwise loop. */ if (SUNRabs(cv_mem->cv_thi - cv_mem->cv_tlo) <= cv_mem->cv_ttol) break; continue; /* Return to looping point. */ } if (zroot) { /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ cv_mem->cv_thi = tmid; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_ghi[i] = cv_mem->cv_grout[i]; break; } /* No sign change in (tlo,tmid), and no zero at tmid. Sign change must be in (tmid,thi). Replace tlo with tmid. */ cv_mem->cv_tlo = tmid; for (i = 0; i < cv_mem->cv_nrtfn; i++) cv_mem->cv_glo[i] = cv_mem->cv_grout[i]; side = 2; /* Stop at root thi if converged; otherwise loop back. */ if (SUNRabs(cv_mem->cv_thi - cv_mem->cv_tlo) <= cv_mem->cv_ttol) break; } /* End of root-search loop */ /* Reset trout and grout, set iroots, and return RTFOUND. */ cv_mem->cv_trout = cv_mem->cv_thi; for (i = 0; i < cv_mem->cv_nrtfn; i++) { cv_mem->cv_grout[i] = cv_mem->cv_ghi[i]; cv_mem->cv_iroots[i] = 0; if(!cv_mem->cv_gactive[i]) continue; if ( (SUNRabs(cv_mem->cv_ghi[i]) == ZERO) && (cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) ) cv_mem->cv_iroots[i] = cv_mem->cv_glo[i] > 0 ? -1:1; if ( (cv_mem->cv_glo[i]*cv_mem->cv_ghi[i] < ZERO) && (cv_mem->cv_rootdir[i]*cv_mem->cv_glo[i] <= ZERO) ) cv_mem->cv_iroots[i] = cv_mem->cv_glo[i] > 0 ? -1:1; } return(RTFOUND); } /* * ----------------------------------------------------------------- * Functions for combined norms * ----------------------------------------------------------------- */ /* * cvQuadUpdateNorm * * Updates the norm old_nrm to account for all quadratures. */ static realtype cvQuadUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ) { realtype qnrm; qnrm = N_VWrmsNorm(xQ, wQ); if (old_nrm > qnrm) return(old_nrm); else return(qnrm); } /* * cvSensNorm * * This routine returns the maximum over the weighted root mean * square norm of xS with weight vectors wS: * * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) } * * Called by cvSensUpdateNorm or directly in the CV_STAGGERED approach * during the NLS solution and before the error test. */ realtype cvSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS) { int is; realtype nrm; (void) N_VWrmsNormVectorArray(cv_mem->cv_Ns, xS, wS, cv_mem->cv_cvals); nrm = cv_mem->cv_cvals[0]; for (is=1; iscv_Ns; is++) if ( cv_mem->cv_cvals[is] > nrm ) nrm = cv_mem->cv_cvals[is]; return(nrm); } /* * cvSensUpdateNorm * * Updates the norm old_nrm to account for all sensitivities. */ realtype cvSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS) { realtype snrm; snrm = cvSensNorm(cv_mem, xS, wS); if (old_nrm > snrm) return(old_nrm); else return(snrm); } /* * cvQuadSensNorm * * This routine returns the maximum over the weighted root mean * square norm of xQS with weight vectors wQS: * * max { wrms(xQS[0],wS[0]) ... wrms(xQS[Ns-1],wS[Ns-1]) } * * Called by cvQuadSensUpdateNorm. */ static realtype cvQuadSensNorm(CVodeMem cv_mem, N_Vector *xQS, N_Vector *wQS) { int is; realtype nrm; (void) N_VWrmsNormVectorArray(cv_mem->cv_Ns, xQS, wQS, cv_mem->cv_cvals); nrm = cv_mem->cv_cvals[0]; for (is=1; iscv_Ns; is++) if ( cv_mem->cv_cvals[is] > nrm ) nrm = cv_mem->cv_cvals[is]; return(nrm); } /* * cvSensUpdateNorm * * Updates the norm old_nrm to account for all quadrature sensitivities. */ static realtype cvQuadSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS) { realtype snrm; snrm = cvQuadSensNorm(cv_mem, xQS, wQS); if (old_nrm > snrm) return(old_nrm); else return(snrm); } /* * ----------------------------------------------------------------- * Wrappers for sensitivity RHS * ----------------------------------------------------------------- */ /* * cvSensRhsWrapper * * CVSensRhs is a high level routine that returns right hand side * of sensitivity equations. Depending on the 'ifS' flag, it either * calls directly the fS routine (ifS=CV_ALLSENS) or (if ifS=CV_ONESENS) * calls the fS1 routine in a loop over all sensitivities. * * CVSensRhs is called: * (*) by CVode at the first step * (*) by cvYddNorm if errcon=SUNTRUE * (*) by the nonlinear solver if ism=CV_SIMULTANEOUS * (*) by cvDoErrorTest when restarting from scratch * (*) in the corrector loop if ism=CV_STAGGERED * (*) by cvStgrDoErrorTest when restarting from scratch * * The return value is that of the sensitivity RHS function fS, * */ int cvSensRhsWrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, N_Vector *yScur, N_Vector *fScur, N_Vector temp1, N_Vector temp2) { int retval=0, is; if (cv_mem->cv_ifS==CV_ALLSENS) { retval = cv_mem->cv_fS(cv_mem->cv_Ns, time, ycur, fcur, yScur, fScur, cv_mem->cv_fS_data, temp1, temp2); cv_mem->cv_nfSe++; } else { for (is=0; iscv_Ns; is++) { retval = cv_mem->cv_fS1(cv_mem->cv_Ns, time, ycur, fcur, is, yScur[is], fScur[is], cv_mem->cv_fS_data, temp1, temp2); cv_mem->cv_nfSe++; if (retval != 0) break; } } return(retval); } /* * cvSensRhs1Wrapper * * cvSensRhs1Wrapper is a high level routine that returns right-hand * side of the is-th sensitivity equation. * * cvSensRhs1Wrapper is called only during the CV_STAGGERED1 corrector loop * (ifS must be CV_ONESENS, otherwise CVodeSensInit would have * issued an error message). * * The return value is that of the sensitivity RHS function fS1, */ int cvSensRhs1Wrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, int is, N_Vector yScur, N_Vector fScur, N_Vector temp1, N_Vector temp2) { int retval; retval = cv_mem->cv_fS1(cv_mem->cv_Ns, time, ycur, fcur, is, yScur, fScur, cv_mem->cv_fS_data, temp1, temp2); cv_mem->cv_nfSe++; return(retval); } /* * ----------------------------------------------------------------- * Internal DQ approximations for sensitivity RHS * ----------------------------------------------------------------- */ /* Undefine Readibility Constants */ #undef y /* * cvSensRhsInternalDQ - internal CVSensRhsFn * * cvSensRhsInternalDQ computes right hand side of all sensitivity equations * by finite differences */ int cvSensRhsInternalDQ(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *cvode_mem, N_Vector ytemp, N_Vector ftemp) { int is, retval; for (is=0; iscv_reltol, cv_mem->cv_uround)); rdelta = ONE/delta; pbari = cv_mem->cv_pbar[is]; which = cv_mem->cv_plist[is]; psave = cv_mem->cv_p[which]; Deltap = pbari * delta; rDeltap = ONE/Deltap; norms = N_VWrmsNorm(yS, cv_mem->cv_ewt) * pbari; rDeltay = SUNMAX(norms, rdelta) / pbari; Deltay = ONE/rDeltay; if (cv_mem->cv_DQrhomax == ZERO) { /* No switching */ method = (cv_mem->cv_DQtype==CV_CENTERED) ? CENTERED1 : FORWARD1; } else { /* switch between simultaneous/separate DQ */ ratio = Deltay * rDeltap; if ( SUNMAX(ONE/ratio, ratio) <= cv_mem->cv_DQrhomax ) method = (cv_mem->cv_DQtype==CV_CENTERED) ? CENTERED1 : FORWARD1; else method = (cv_mem->cv_DQtype==CV_CENTERED) ? CENTERED2 : FORWARD2; } switch(method) { case CENTERED1: Delta = SUNMIN(Deltay, Deltap); r2Delta = HALF/Delta; N_VLinearSum(ONE,y,Delta,yS,ytemp); cv_mem->cv_p[which] = psave + Delta; retval = cv_mem->cv_f(t, ytemp, ySdot, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(ONE,y,-Delta,yS,ytemp); cv_mem->cv_p[which] = psave - Delta; retval = cv_mem->cv_f(t, ytemp, ftemp, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(r2Delta,ySdot,-r2Delta,ftemp,ySdot); break; case CENTERED2: r2Deltap = HALF/Deltap; r2Deltay = HALF/Deltay; N_VLinearSum(ONE,y,Deltay,yS,ytemp); retval = cv_mem->cv_f(t, ytemp, ySdot, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(ONE,y,-Deltay,yS,ytemp); retval = cv_mem->cv_f(t, ytemp, ftemp, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(r2Deltay, ySdot, -r2Deltay, ftemp, ySdot); cv_mem->cv_p[which] = psave + Deltap; retval = cv_mem->cv_f(t, y, ytemp, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); cv_mem->cv_p[which] = psave - Deltap; retval = cv_mem->cv_f(t, y, ftemp, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); /* ySdot = ySdot + r2Deltap * ytemp - r2Deltap * ftemp */ cvals[0] = ONE; Xvecs[0] = ySdot; cvals[1] = r2Deltap; Xvecs[1] = ytemp; cvals[2] = -r2Deltap; Xvecs[2] = ftemp; retval = N_VLinearCombination(3, cvals, Xvecs, ySdot); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); break; case FORWARD1: Delta = SUNMIN(Deltay, Deltap); rDelta = ONE/Delta; N_VLinearSum(ONE,y,Delta,yS,ytemp); cv_mem->cv_p[which] = psave + Delta; retval = cv_mem->cv_f(t, ytemp, ySdot, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(rDelta,ySdot,-rDelta,ydot,ySdot); break; case FORWARD2: N_VLinearSum(ONE,y,Deltay,yS,ytemp); retval = cv_mem->cv_f(t, ytemp, ySdot, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(rDeltay, ySdot, -rDeltay, ydot, ySdot); cv_mem->cv_p[which] = psave + Deltap; retval = cv_mem->cv_f(t, y, ytemp, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); /* ySdot = ySdot + rDeltap * ytemp - rDeltap * ydot */ cvals[0] = ONE; Xvecs[0] = ySdot; cvals[1] = rDeltap; Xvecs[1] = ytemp; cvals[2] = -rDeltap; Xvecs[2] = ydot; retval = N_VLinearCombination(3, cvals, Xvecs, ySdot); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); break; } cv_mem->cv_p[which] = psave; /* Increment counter nfeS */ cv_mem->cv_nfeS += nfel; return(0); } /* * cvQuadSensRhsInternalDQ - internal CVQuadSensRhsFn * * cvQuadSensRhsInternalDQ computes right hand side of all quadrature * sensitivity equations by finite differences. All work is actually * done in cvQuadSensRhs1InternalDQ. */ static int cvQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *cvode_mem, N_Vector tmp, N_Vector tmpQ) { CVodeMem cv_mem; int is, retval; /* cvode_mem is passed here as user data */ cv_mem = (CVodeMem) cvode_mem; for (is=0; iscv_reltol, cv_mem->cv_uround)); rdelta = ONE/delta; pbari = cv_mem->cv_pbar[is]; which = cv_mem->cv_plist[is]; psave = cv_mem->cv_p[which]; Deltap = pbari * delta; norms = N_VWrmsNorm(yS, cv_mem->cv_ewt) * pbari; rDeltay = SUNMAX(norms, rdelta) / pbari; Deltay = ONE/rDeltay; method = (cv_mem->cv_DQtype==CV_CENTERED) ? CENTERED1 : FORWARD1; switch(method) { case CENTERED1: Delta = SUNMIN(Deltay, Deltap); r2Delta = HALF/Delta; N_VLinearSum(ONE, y, Delta, yS, tmp); cv_mem->cv_p[which] = psave + Delta; retval = cv_mem->cv_fQ(t, tmp, yQSdot, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(ONE, y, -Delta, yS, tmp); cv_mem->cv_p[which] = psave - Delta; retval = cv_mem->cv_fQ(t, tmp, tmpQ, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(r2Delta, yQSdot, -r2Delta, tmpQ, yQSdot); break; case FORWARD1: Delta = SUNMIN(Deltay, Deltap); rDelta = ONE/Delta; N_VLinearSum(ONE, y, Delta, yS, tmp); cv_mem->cv_p[which] = psave + Delta; retval = cv_mem->cv_fQ(t, tmp, yQSdot, cv_mem->cv_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(rDelta, yQSdot, -rDelta, yQdot, yQSdot); break; } cv_mem->cv_p[which] = psave; /* Increment counter nfQeS */ cv_mem->cv_nfQeS += nfel; return(0); } /* * ----------------------------------------------------------------- * Error message handling functions * ----------------------------------------------------------------- */ /* * cvProcessError is a high level error handling function. * - If cv_mem==NULL it prints the error message to stderr. * - Otherwise, it sets up and calls the error handling function * pointed to by cv_ehfun. */ void cvProcessError(CVodeMem cv_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to cvProcessError) */ va_start(ap, msgfmt); /* Compose the message */ vsprintf(msg, msgfmt, ap); if (cv_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT STAN_SUNDIALS_FPRINTF(stderr, "\n[%s ERROR] %s\n ", module, fname); STAN_SUNDIALS_FPRINTF(stderr, "%s\n\n", msg); #endif } else { /* We can call ehfun */ cv_mem->cv_ehfun(error_code, module, fname, msg, cv_mem->cv_eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* * cvErrHandler is the default error handling function. * It sends the error message to the stream pointed to by cv_errfp. */ void cvErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { CVodeMem cv_mem; char err_type[10]; /* data points to cv_mem here */ cv_mem = (CVodeMem) data; if (error_code == CV_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (cv_mem->cv_errfp!=NULL) { STAN_SUNDIALS_FPRINTF(cv_mem->cv_errfp,"\n[%s %s] %s\n",module,err_type,function); STAN_SUNDIALS_FPRINTF(cv_mem->cv_errfp," %s\n\n",msg); } #endif return; } StanHeaders/src/cvodes/cvodes_ls_impl.h0000644000176200001440000002271613766554457017736 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation header file for the scaled, preconditioned * linear solver interface. *-----------------------------------------------------------------*/ #ifndef _CVSLS_IMPL_H #define _CVSLS_IMPL_H #include #include "cvodes_impl.h" #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------------------------------------------------------- CVSLS solver constants CVLS_MSBJ maximum number of steps between Jacobian and/or preconditioner evaluations CVLS_DGMAX maximum change in gamma between Jacobian and/or preconditioner evaluations CVLS_EPLIN default value for factor by which the tolerance on the nonlinear iteration is multiplied to get a tolerance on the linear iteration -----------------------------------------------------------------*/ #define CVLS_MSBJ 50 #define CVLS_DGMAX RCONST(0.2) #define CVLS_EPLIN RCONST(0.05) /*================================================================= PART I: Forward Problems =================================================================*/ /*----------------------------------------------------------------- Types : CVLsMemRec, CVLsMem The type CVLsMem is pointer to a CVLsMemRec. -----------------------------------------------------------------*/ typedef struct CVLsMemRec { /* Jacobian construction & storage */ booleantype jacDQ; /* SUNTRUE if using internal DQ Jac approx. */ CVLsJacFn jac; /* Jacobian routine to be called */ void *J_data; /* user data is passed to jac */ booleantype jbad; /* heuristic suggestion for pset */ /* Iterative solver tolerance */ realtype sqrtN; /* sqrt(N) */ realtype eplifac; /* eplifac = user specified or EPLIN_DEFAULT */ /* Linear solver, matrix and vector objects/pointers */ SUNLinearSolver LS; /* generic linear solver object */ SUNMatrix A; /* A = I - gamma * df/dy */ SUNMatrix savedJ; /* savedJ = old Jacobian */ N_Vector ytemp; /* temp vector passed to jtimes and psolve */ N_Vector x; /* temp vector used by CVLsSolve */ N_Vector ycur; /* CVODE current y vector in Newton Iteration */ N_Vector fcur; /* fcur = f(tn, ycur) */ /* Statistics and associated parameters */ long int msbj; /* max num steps between jac/pset calls */ long int nje; /* nje = no. of calls to jac */ long int nfeDQ; /* no. of calls to f due to DQ Jacobian or J*v approximations */ long int nstlj; /* nstlj = nst at last jac/pset call */ long int npe; /* npe = total number of pset calls */ long int nli; /* nli = total number of linear iterations */ long int nps; /* nps = total number of psolve calls */ long int ncfl; /* ncfl = total number of convergence failures */ long int njtsetup; /* njtsetup = total number of calls to jtsetup */ long int njtimes; /* njtimes = total number of calls to jtimes */ /* Preconditioner computation * (a) user-provided: * - P_data == user_data * - pfree == NULL (the user dealocates memory for user_data) * (b) internal preconditioner module * - P_data == cvode_mem * - pfree == set by the prec. module and called in CVodeFree */ CVLsPrecSetupFn pset; CVLsPrecSolveFn psolve; int (*pfree)(CVodeMem cv_mem); void *P_data; /* Jacobian times vector compuation * (a) jtimes function provided by the user: * - jt_data == user_data * - jtimesDQ == SUNFALSE * (b) internal jtimes * - jt_data == cvode_mem * - jtimesDQ == SUNTRUE */ booleantype jtimesDQ; CVLsJacTimesSetupFn jtsetup; CVLsJacTimesVecFn jtimes; void *jt_data; long int last_flag; /* last error flag returned by any function */ } *CVLsMem; /*----------------------------------------------------------------- Prototypes of internal functions -----------------------------------------------------------------*/ /* Interface routines called by system SUNLinearSolver */ int cvLsATimes(void* cvode_mem, N_Vector v, N_Vector z); int cvLsPSetup(void* cvode_mem); int cvLsPSolve(void* cvode_mem, N_Vector r, N_Vector z, realtype tol, int lr); /* Difference quotient approximation for Jac times vector */ int cvLsDQJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *data, N_Vector work); /* Difference-quotient Jacobian approximation routines */ int cvLsDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int cvLsDenseDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, CVodeMem cv_mem, N_Vector tmp1); int cvLsBandDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, CVodeMem cv_mem, N_Vector tmp1, N_Vector tmp2); /* Generic linit/lsetup/lsolve/lfree interface routines for CVode to call */ int cvLsInitialize(CVodeMem cv_mem); int cvLsSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int cvLsSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); int cvLsFree(CVodeMem cv_mem); /* Auxilliary functions */ int cvLsInitializeCounters(CVLsMem cvls_mem); int cvLs_AccessLMem(void* cvode_mem, const char* fname, CVodeMem* cv_mem, CVLsMem* cvls_mem); /*================================================================= PART II: Backward Problems =================================================================*/ /*----------------------------------------------------------------- Types : CVLsMemRecB, CVLsMemB CVodeSetLinearSolverB attaches such a structure to the lmemB field of CVodeBMem -----------------------------------------------------------------*/ typedef struct CVLsMemRecB { CVLsJacFnB jacB; CVLsJacFnBS jacBS; CVLsJacTimesSetupFnB jtsetupB; CVLsJacTimesSetupFnBS jtsetupBS; CVLsJacTimesVecFnB jtimesB; CVLsJacTimesVecFnBS jtimesBS; CVLsPrecSetupFnB psetB; CVLsPrecSetupFnBS psetBS; CVLsPrecSolveFnB psolveB; CVLsPrecSolveFnBS psolveBS; void *P_dataB; } *CVLsMemB; /*----------------------------------------------------------------- Prototypes of internal functions -----------------------------------------------------------------*/ int cvLsFreeB(CVodeBMem cvb_mem); int cvLs_AccessLMemB(void *cvode_mem, int which, const char *fname, CVodeMem *cv_mem, CVadjMem *ca_mem, CVodeBMem *cvB_mem, CVLsMemB *cvlsB_mem); int cvLs_AccessLMemBCur(void *cvode_mem, const char *fname, CVodeMem *cv_mem, CVadjMem *ca_mem, CVodeBMem *cvB_mem, CVLsMemB *cvlsB_mem); /*================================================================= Error Messages =================================================================*/ #define MSG_LS_CVMEM_NULL "Integrator memory is NULL." #define MSG_LS_MEM_FAIL "A memory request failed." #define MSG_LS_BAD_NVECTOR "A required vector operation is not implemented." #define MSG_LS_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSG_LS_BAD_LSTYPE "Incompatible linear solver type." #define MSG_LS_BAD_PRETYPE "Illegal value for pretype. Legal values are PREC_NONE, PREC_LEFT, PREC_RIGHT, and PREC_BOTH." #define MSG_LS_PSOLVE_REQ "pretype != PREC_NONE, but PSOLVE = NULL is illegal." #define MSG_LS_LMEM_NULL "Linear solver memory is NULL." #define MSG_LS_BAD_GSTYPE "Illegal value for gstype. Legal values are MODIFIED_GS and CLASSICAL_GS." #define MSG_LS_BAD_EPLIN "eplifac < 0 illegal." #define MSG_LS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSG_LS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSG_LS_JTSETUP_FAILED "The Jacobian x vector setup routine failed in an unrecoverable manner." #define MSG_LS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." #define MSG_LS_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #define MSG_LS_SUNMAT_FAILED "A SUNMatrix routine failed in an unrecoverable manner." #define MSG_LS_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSG_LS_BAD_WHICH "Illegal value for which." #define MSG_LS_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #define MSG_LS_BAD_TINTERP "Bad t for interpolation." #ifdef __cplusplus } #endif #endif StanHeaders/src/cvodes/cvodes_io.c0000644000176200001440000013254413766554456016701 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the CVODES solver. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWOPT5 RCONST(2.5) /* * ================================================================= * CVODES optional input functions * ================================================================= */ /* * CVodeSetErrHandlerFn * * Specifies the error handler function */ int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetErrHandlerFn", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_ehfun = ehfun; cv_mem->cv_eh_data = eh_data; return(CV_SUCCESS); } /* * CVodeSetErrFile * * Specifies the FILE pointer for output (NULL means no messages) */ int CVodeSetErrFile(void *cvode_mem, FILE *errfp) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetErrFile", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errfp = errfp; return(CV_SUCCESS); } /* * CVodeSetUserData * * Specifies the user data pointer for f */ int CVodeSetUserData(void *cvode_mem, void *user_data) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetUserData", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_user_data = user_data; return(CV_SUCCESS); } /* * CVodeSetMaxOrd * * Specifies the maximum method order */ int CVodeSetMaxOrd(void *cvode_mem, int maxord) { CVodeMem cv_mem; int qmax_alloc; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxOrd", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (maxord <= 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxOrd", MSGCV_NEG_MAXORD); return(CV_ILL_INPUT); } /* Cannot increase maximum order beyond the value that was used when allocating memory */ qmax_alloc = cv_mem->cv_qmax_alloc; qmax_alloc = SUNMIN(qmax_alloc, cv_mem->cv_qmax_allocQ); qmax_alloc = SUNMIN(qmax_alloc, cv_mem->cv_qmax_allocS); if (maxord > qmax_alloc) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxOrd", MSGCV_BAD_MAXORD); return(CV_ILL_INPUT); } cv_mem->cv_qmax = maxord; return(CV_SUCCESS); } /* * CVodeSetMaxNumSteps * * Specifies the maximum number of integration steps */ int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxNumSteps", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) cv_mem->cv_mxstep = MXSTEP_DEFAULT; else cv_mem->cv_mxstep = mxsteps; return(CV_SUCCESS); } /* * CVodeSetMaxHnilWarns * * Specifies the maximum number of warnings for small h */ int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxHnilWarns", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_mxhnil = mxhnil; return(CV_SUCCESS); } /* *CVodeSetStabLimDet * * Turns on/off the stability limit detection algorithm */ int CVodeSetStabLimDet(void *cvode_mem, booleantype sldet) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetStabLimDet", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if( sldet && (cv_mem->cv_lmm != CV_BDF) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetStabLimDet", MSGCV_SET_SLDET); return(CV_ILL_INPUT); } cv_mem->cv_sldeton = sldet; return(CV_SUCCESS); } /* * CVodeSetInitStep * * Specifies the initial step size */ int CVodeSetInitStep(void *cvode_mem, realtype hin) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetInitStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_hin = hin; return(CV_SUCCESS); } /* * CVodeSetMinStep * * Specifies the minimum step size */ int CVodeSetMinStep(void *cvode_mem, realtype hmin) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMinStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (hmin<0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMinStep", MSGCV_NEG_HMIN); return(CV_ILL_INPUT); } /* Passing 0 sets hmin = zero */ if (hmin == ZERO) { cv_mem->cv_hmin = HMIN_DEFAULT; return(CV_SUCCESS); } if (hmin * cv_mem->cv_hmax_inv > ONE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMinStep", MSGCV_BAD_HMIN_HMAX); return(CV_ILL_INPUT); } cv_mem->cv_hmin = hmin; return(CV_SUCCESS); } /* * CVodeSetMaxStep * * Specifies the maximum step size */ int CVodeSetMaxStep(void *cvode_mem, realtype hmax) { realtype hmax_inv; CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxStep", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (hmax < 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxStep", MSGCV_NEG_HMAX); return(CV_ILL_INPUT); } /* Passing 0 sets hmax = infinity */ if (hmax == ZERO) { cv_mem->cv_hmax_inv = HMAX_INV_DEFAULT; return(CV_SUCCESS); } hmax_inv = ONE/hmax; if (hmax_inv * cv_mem->cv_hmin > ONE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetMaxStep", MSGCV_BAD_HMIN_HMAX); return(CV_ILL_INPUT); } cv_mem->cv_hmax_inv = hmax_inv; return(CV_SUCCESS); } /* * CVodeSetStopTime * * Specifies the time beyond which the integration is not to proceed. */ int CVodeSetStopTime(void *cvode_mem, realtype tstop) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetStopTime", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* If CVode was called at least once, test if tstop is legal * (i.e. if it was not already passed). * If CVodeSetStopTime is called before the first call to CVode, * tstop will be checked in CVode. */ if (cv_mem->cv_nst > 0) { if ( (tstop - cv_mem->cv_tn) * cv_mem->cv_h < ZERO ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetStopTime", MSGCV_BAD_TSTOP, tstop, cv_mem->cv_tn); return(CV_ILL_INPUT); } } cv_mem->cv_tstop = tstop; cv_mem->cv_tstopset = SUNTRUE; return(CV_SUCCESS); } /* * CVodeSetMaxErrTestFails * * Specifies the maximum number of error test failures during one * step try. */ int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxErrTestFails", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxnef = maxnef; return(CV_SUCCESS); } /* * CVodeSetMaxConvFails * * Specifies the maximum number of nonlinear convergence failures * during one step try. */ int CVodeSetMaxConvFails(void *cvode_mem, int maxncf) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxConvFails", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_maxncf = maxncf; return(CV_SUCCESS); } /* * CVodeSetMaxNonlinIters * * Specifies the maximum number of nonlinear iterations during * one solve. */ int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor) { CVodeMem cv_mem; booleantype sensi_sim; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetMaxNonlinIters", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Are we computing sensitivities with the simultaneous approach? */ sensi_sim = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_SIMULTANEOUS)); if (sensi_sim) { /* check that the NLS is non-NULL */ if (cv_mem->NLSsim == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeSetMaxNonlinIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(cv_mem->NLSsim, maxcor)); } else { /* check that the NLS is non-NULL */ if (cv_mem->NLS == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeSetMaxNonlinIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(cv_mem->NLS, maxcor)); } return(CV_SUCCESS); } /* * CVodeSetNonlinConvCoef * * Specifies the coeficient in the nonlinear solver convergence * test */ int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinConvCoef", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_nlscoef = nlscoef; return(CV_SUCCESS); } /* * CVodeSetRootDirection * * Specifies the direction of zero-crossings to be monitored. * The default is to monitor both crossings. */ int CVodeSetRootDirection(void *cvode_mem, int *rootdir) { CVodeMem cv_mem; int i, nrt; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetRootDirection", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = cv_mem->cv_nrtfn; if (nrt==0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetRootDirection", MSGCV_NO_ROOT); return(CV_ILL_INPUT); } for(i=0; icv_rootdir[i] = rootdir[i]; return(CV_SUCCESS); } /* * CVodeSetNoInactiveRootWarn * * Disables issuing a warning if some root function appears * to be identically zero at the beginning of the integration */ int CVodeSetNoInactiveRootWarn(void *cvode_mem) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNoInactiveRootWarn", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_mxgnull = 0; return(CV_SUCCESS); } /* * CVodeSetConstraints * * Setup for constraint handling feature */ int CVodeSetConstraints(void *cvode_mem, N_Vector constraints) { CVodeMem cv_mem; realtype temptest; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetConstraints", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* If there are no constraints, destroy data structures */ if (constraints == NULL) { if (cv_mem->cv_constraintsMallocDone) { N_VDestroy(cv_mem->cv_constraints); cv_mem->cv_lrw -= cv_mem->cv_lrw1; cv_mem->cv_liw -= cv_mem->cv_liw1; } cv_mem->cv_constraintsMallocDone = SUNFALSE; cv_mem->cv_constraintsSet = SUNFALSE; return(CV_SUCCESS); } /* Test if required vector ops. are defined */ if (constraints->ops->nvdiv == NULL || constraints->ops->nvmaxnorm == NULL || constraints->ops->nvcompare == NULL || constraints->ops->nvconstrmask == NULL || constraints->ops->nvminquotient == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetConstraints", MSGCV_BAD_NVECTOR); return(CV_ILL_INPUT); } /* Check the constraints vector */ temptest = N_VMaxNorm(constraints); if ((temptest > TWOPT5) || (temptest < HALF)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetConstraints", MSGCV_BAD_CONSTR); return(CV_ILL_INPUT); } if ( !(cv_mem->cv_constraintsMallocDone) ) { cv_mem->cv_constraints = N_VClone(constraints); cv_mem->cv_lrw += cv_mem->cv_lrw1; cv_mem->cv_liw += cv_mem->cv_liw1; cv_mem->cv_constraintsMallocDone = SUNTRUE; } /* Load the constraints vector */ N_VScale(ONE, constraints, cv_mem->cv_constraints); cv_mem->cv_constraintsSet = SUNTRUE; return(CV_SUCCESS); } /* * ================================================================= * Quadrature optional input functions * ================================================================= */ int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetQuadErrCon", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errconQ = errconQ; return(CV_SUCCESS); } /* * ================================================================= * FSA optional input functions * ================================================================= */ int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensDQMethod", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if ( (DQtype != CV_CENTERED) && (DQtype != CV_FORWARD) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetSensDQMethod", MSGCV_BAD_DQTYPE); return(CV_ILL_INPUT); } if (DQrhomax < ZERO ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetSensDQMethod", MSGCV_BAD_DQRHO); return(CV_ILL_INPUT); } cv_mem->cv_DQtype = DQtype; cv_mem->cv_DQrhomax = DQrhomax; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensErrCon", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; cv_mem->cv_errconS = errconS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS) { CVodeMem cv_mem; booleantype sensi_stg; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensMaxNonlinIters", MSGCV_NO_MEM); return (CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Are we computing sensitivities with a staggered approach? */ sensi_stg = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED)); if (sensi_stg) { /* check that the NLS is non-NULL */ if (cv_mem->NLSstg == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeSetSensMaxNonlinIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(cv_mem->NLSstg, maxcorS)); } else { /* check that the NLS is non-NULL */ if (cv_mem->NLSstg1 == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeSetMaxNonlinIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(cv_mem->NLSstg1, maxcorS)); } return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetSensParams", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSetSensParams", MSGCV_NO_SENSI); return(CV_NO_SENS); } Ns = cv_mem->cv_Ns; /* Parameters */ cv_mem->cv_p = p; /* pbar */ if (pbar != NULL) for (is=0; iscv_pbar[is] = SUNRabs(pbar[is]); } else for (is=0; iscv_pbar[is] = ONE; /* plist */ if (plist != NULL) for (is=0; iscv_plist[is] = plist[is]; } else for (is=0; iscv_plist[is] = is; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetQuadSensErrCon", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was sensitivity initialized? */ if (cv_mem->cv_SensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeSetQuadSensTolerances", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Ckeck if quadrature sensitivity was initialized? */ if (cv_mem->cv_QuadSensMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeSetQuadSensErrCon", MSGCV_NO_QUADSENSI); return(CV_NO_QUAD); } cv_mem->cv_errconQS = errconQS; return(CV_SUCCESS); } /* * ================================================================= * CVODES optional output functions * ================================================================= */ /* * CVodeGetNumSteps * * Returns the current number of integration steps */ int CVodeGetNumSteps(void *cvode_mem, long int *nsteps) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumSteps", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nsteps = cv_mem->cv_nst; return(CV_SUCCESS); } /* * CVodeGetNumRhsEvals * * Returns the current number of calls to f */ int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nfevals = cv_mem->cv_nfe; return(CV_SUCCESS); } /* * CVodeGetNumLinSolvSetups * * Returns the current number of calls to the linear solver setup routine */ int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumLinSolvSetups", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nlinsetups = cv_mem->cv_nsetups; return(CV_SUCCESS); } /* * CVodeGetNumErrTestFails * * Returns the current number of error test failures */ int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *netfails = cv_mem->cv_netf; return(CV_SUCCESS); } /* * CVodeGetLastOrder * * Returns the order on the last succesful step */ int CVodeGetLastOrder(void *cvode_mem, int *qlast) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetLastOrder", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *qlast = cv_mem->cv_qu; return(CV_SUCCESS); } /* * CVodeGetCurrentOrder * * Returns the order to be attempted on the next step */ int CVodeGetCurrentOrder(void *cvode_mem, int *qcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentOrder", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *qcur = cv_mem->cv_next_q; return(CV_SUCCESS); } /* * CVodeGetNumStabLimOrderReds * * Returns the number of order reductions triggered by the stability * limit detection algorithm */ int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumStabLimOrderReds", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sldeton==SUNFALSE) *nslred = 0; else *nslred = cv_mem->cv_nor; return(CV_SUCCESS); } /* * CVodeGetActualInitStep * * Returns the step size used on the first step */ int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetActualInitStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hinused = cv_mem->cv_h0u; return(CV_SUCCESS); } /* * CVodeGetLastStep * * Returns the step size used on the last successful step */ int CVodeGetLastStep(void *cvode_mem, realtype *hlast) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetLastStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hlast = cv_mem->cv_hu; return(CV_SUCCESS); } /* * CVodeGetCurrentStep * * Returns the step size to be attempted on the next step */ int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentStep", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *hcur = cv_mem->cv_next_h; return(CV_SUCCESS); } /* * CVodeGetCurrentTime * * Returns the current value of the independent variable */ int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetCurrentTime", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tcur = cv_mem->cv_tn; return(CV_SUCCESS); } /* * CVodeGetTolScaleFactor * * Returns a suggested factor for scaling tolerances */ int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfact) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetTolScaleFactor", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *tolsfact = cv_mem->cv_tolsf; return(CV_SUCCESS); } /* * CVodeGetErrWeights * * This routine returns the current weight vector. */ int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; N_VScale(ONE, cv_mem->cv_ewt, eweight); return(CV_SUCCESS); } /* * CVodeGetEstLocalErrors * * Returns an estimate of the local error */ int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetEstLocalErrors", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; N_VScale(ONE, cv_mem->cv_acor, ele); return(CV_SUCCESS); } /* * CVodeGetWorkSpace * * Returns integrator work space requirements */ int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetWorkSpace", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *leniw = cv_mem->cv_liw; *lenrw = cv_mem->cv_lrw; return(CV_SUCCESS); } /* * CVodeGetIntegratorStats * * Returns integrator statistics */ int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetIntegratorStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nsteps = cv_mem->cv_nst; *nfevals = cv_mem->cv_nfe; *nlinsetups = cv_mem->cv_nsetups; *netfails = cv_mem->cv_netf; *qlast = cv_mem->cv_qu; *qcur = cv_mem->cv_next_q; *hinused = cv_mem->cv_h0u; *hlast = cv_mem->cv_hu; *hcur = cv_mem->cv_next_h; *tcur = cv_mem->cv_tn; return(CV_SUCCESS); } /* * CVodeGetNumGEvals * * Returns the current number of calls to g (for rootfinding) */ int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumGEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *ngevals = cv_mem->cv_nge; return(CV_SUCCESS); } /* * CVodeGetRootInfo * * Returns pointer to array rootsfound showing roots found */ int CVodeGetRootInfo(void *cvode_mem, int *rootsfound) { CVodeMem cv_mem; int i, nrt; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetRootInfo", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; nrt = cv_mem->cv_nrtfn; for (i=0; icv_iroots[i]; return(CV_SUCCESS); } /* * CVodeGetNumNonlinSolvIters * * Returns the current number of iterations in the nonlinear solver */ int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters) { CVodeMem cv_mem; booleantype sensi_sim; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumNonlinSolvIters", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* are we computing sensitivities with the simultaneous approach? */ sensi_sim = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_SIMULTANEOUS)); /* get number of iterations from the NLS */ if (sensi_sim) { /* check that the NLS is non-NULL */ if (cv_mem->NLSsim == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetNumNonlinSolvIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLSsim, nniters)); } else { /* check that the NLS is non-NULL */ if (cv_mem->NLS == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetNumNonlinSolvIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLS, nniters)); } return(CV_SUCCESS); } /* * CVodeGetNumNonlinSolvConvFails * * Returns the current number of convergence failures in the * nonlinear solver */ int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumNonlinSolvConvFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nncfails = cv_mem->cv_ncfn; return(CV_SUCCESS); } /* * CVodeGetNonlinSolvStats * * Returns nonlinear solver statistics */ int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, long int *nncfails) { CVodeMem cv_mem; booleantype sensi_sim; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNonlinSolvStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; *nncfails = cv_mem->cv_ncfn; /* are we computing sensitivities with the simultaneous approach? */ sensi_sim = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_SIMULTANEOUS)); /* get number of iterations from the NLS */ if (sensi_sim) { /* check that the NLS is non-NULL */ if (cv_mem->NLSsim == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetNumNonlinSolvIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLSsim, nniters)); } else { /* check that the NLS is non-NULL */ if (cv_mem->NLS == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetNumNonlinSolvIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLS, nniters)); } return(CV_SUCCESS); } /* * ================================================================= * Quadrature optional output functions * ================================================================= */ /*-----------------------------------------------------------------*/ int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr==SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadNumRhsEvals", MSGCV_NO_QUAD); return(CV_NO_QUAD); } *nfQevals = cv_mem->cv_nfQe; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr==SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadNumErrTestFails", MSGCV_NO_QUAD); return(CV_NO_QUAD); } *nQetfails = cv_mem->cv_netfQ; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr==SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadErrWeights", MSGCV_NO_QUAD); return(CV_NO_QUAD); } if(cv_mem->cv_errconQ) N_VScale(ONE, cv_mem->cv_ewtQ, eQweight); return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, long int *nQetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr==SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUAD, "CVODES", "CVodeGetQuadStats", MSGCV_NO_QUAD); return(CV_NO_QUAD); } *nfQevals = cv_mem->cv_nfQe; *nQetfails = cv_mem->cv_netfQ; return(CV_SUCCESS); } /* * ================================================================= * Quadrature FSA optional output functions * ================================================================= */ /*-----------------------------------------------------------------*/ int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr_sensi == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensNumRhsEvals", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } *nfQSevals = cv_mem->cv_nfQSe; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr_sensi == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensNumErrTestFails", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } *nQSetfails = cv_mem->cv_netfQS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr_sensi == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensErrWeights", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } Ns = cv_mem->cv_Ns; if (cv_mem->cv_errconQS) for (is=0; iscv_ewtQS[is], eQSweight[is]); return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetQuadSensStats(void *cvode_mem, long int *nfQSevals, long int *nQSetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetQuadSensStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_quadr_sensi == SUNFALSE) { cvProcessError(cv_mem, CV_NO_QUADSENS, "CVODES", "CVodeGetQuadSensStats", MSGCV_NO_QUADSENSI); return(CV_NO_QUADSENS); } *nfQSevals = cv_mem->cv_nfQSe; *nQSetfails = cv_mem->cv_netfQS; return(CV_SUCCESS); } /* * ================================================================= * FSA optional output functions * ================================================================= */ /*-----------------------------------------------------------------*/ int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumRhsEvals", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumRhsEvals", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nfSevals = cv_mem->cv_nfSe; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetNumRhsEvalsSens", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetNumRhsEvalsSens", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nfevalsS = cv_mem->cv_nfeS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumErrTestFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumErrTestFails", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nSetfails = cv_mem->cv_netfS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumLinSolvSetups", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumLinSolvSetups", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nlinsetupsS = cv_mem->cv_nsetupsS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensErrWeights", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensErrWeights", MSGCV_NO_SENSI); return(CV_NO_SENS); } Ns = cv_mem->cv_Ns; for (is=0; iscv_ewtS[is], eSweight[is]); return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, long int *nSetfails, long int *nlinsetupsS) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensStats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensStats", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nfSevals = cv_mem->cv_nfSe; *nfevalsS = cv_mem->cv_nfeS; *nSetfails = cv_mem->cv_netfS; *nlinsetupsS = cv_mem->cv_nsetupsS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensNumNonlinSolvIters(void *cvode_mem, long int *nSniters) { CVodeMem cv_mem; booleantype sensi_stg; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumNonlinSolvIters", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumNonlinSolvIters", MSGCV_NO_SENSI); return(CV_NO_SENS); } /* Are we computing sensitivities with a staggered approach? */ sensi_stg = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED)); if (sensi_stg) { /* check that the NLS is non-NULL */ if (cv_mem->NLSstg == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetSensNumNonlinSolvIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLSstg, nSniters)); } else { /* check that the NLS is non-NULL */ if (cv_mem->NLSstg1 == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetSensNumNonlinSolvIters", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLSstg1, nSniters)); } } /*-----------------------------------------------------------------*/ int CVodeGetSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSncfails) { CVodeMem cv_mem; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNumNonlinSolvConvFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNumNonlinSolvConvFails", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nSncfails = cv_mem->cv_ncfnS; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetStgrSensNumNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetStgrSensNumNonlinSolvIters", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; Ns = cv_mem->cv_Ns; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetStgrSensNumNonlinSolvIters", MSGCV_NO_SENSI); return(CV_NO_SENS); } if(cv_mem->cv_ism==CV_STAGGERED1) for(is=0; iscv_nniS1[is]; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetStgrSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSTGR1ncfails) { CVodeMem cv_mem; int is, Ns; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetStgrSensNumNonlinSolvConvFails", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; Ns = cv_mem->cv_Ns; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetStgrSensNumNonlinSolvConvFails", MSGCV_NO_SENSI); return(CV_NO_SENS); } if(cv_mem->cv_ism==CV_STAGGERED1) for(is=0; iscv_ncfnS1[is]; return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, long int *nSncfails) { CVodeMem cv_mem; booleantype sensi_stg; if (cvode_mem==NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeGetSensNonlinSolvstats", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_sensi==SUNFALSE) { cvProcessError(cv_mem, CV_NO_SENS, "CVODES", "CVodeGetSensNonlinSolvStats", MSGCV_NO_SENSI); return(CV_NO_SENS); } *nSncfails = cv_mem->cv_ncfnS; /* Are we computing sensitivities with a staggered approach? */ sensi_stg = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED)); if (sensi_stg) { /* check that the NLS is non-NULL */ if (cv_mem->NLSstg == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetSensNumNonlinSolvStats", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLSstg, nSniters)); } else { /* check that the NLS is non-NULL */ if (cv_mem->NLSstg1 == NULL) { cvProcessError(NULL, CV_MEM_FAIL, "CVODES", "CVodeGetSensNumNonlinSolvStats", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } return(SUNNonlinSolGetNumIters(cv_mem->NLSstg1, nSniters)); } return(CV_SUCCESS); } /*-----------------------------------------------------------------*/ char *CVodeGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(24*sizeof(char)); switch(flag) { case CV_SUCCESS: sprintf(name,"CV_SUCCESS"); break; case CV_TSTOP_RETURN: sprintf(name,"CV_TSTOP_RETURN"); break; case CV_ROOT_RETURN: sprintf(name,"CV_ROOT_RETURN"); break; case CV_TOO_MUCH_WORK: sprintf(name,"CV_TOO_MUCH_WORK"); break; case CV_TOO_MUCH_ACC: sprintf(name,"CV_TOO_MUCH_ACC"); break; case CV_ERR_FAILURE: sprintf(name,"CV_ERR_FAILURE"); break; case CV_CONV_FAILURE: sprintf(name,"CV_CONV_FAILURE"); break; case CV_LINIT_FAIL: sprintf(name,"CV_LINIT_FAIL"); break; case CV_LSETUP_FAIL: sprintf(name,"CV_LSETUP_FAIL"); break; case CV_LSOLVE_FAIL: sprintf(name,"CV_LSOLVE_FAIL"); break; case CV_RHSFUNC_FAIL: sprintf(name,"CV_RHSFUNC_FAIL"); break; case CV_FIRST_RHSFUNC_ERR: sprintf(name,"CV_FIRST_RHSFUNC_ERR"); break; case CV_REPTD_RHSFUNC_ERR: sprintf(name,"CV_REPTD_RHSFUNC_ERR"); break; case CV_UNREC_RHSFUNC_ERR: sprintf(name,"CV_UNREC_RHSFUNC_ERR"); break; case CV_RTFUNC_FAIL: sprintf(name,"CV_RTFUNC_FAIL"); break; case CV_MEM_FAIL: sprintf(name,"CV_MEM_FAIL"); break; case CV_MEM_NULL: sprintf(name,"CV_MEM_NULL"); break; case CV_ILL_INPUT: sprintf(name,"CV_ILL_INPUT"); break; case CV_NO_MALLOC: sprintf(name,"CV_NO_MALLOC"); break; case CV_BAD_K: sprintf(name,"CV_BAD_K"); break; case CV_BAD_T: sprintf(name,"CV_BAD_T"); break; case CV_BAD_DKY: sprintf(name,"CV_BAD_DKY"); break; case CV_NO_QUAD: sprintf(name,"CV_NO_QUAD"); break; case CV_QRHSFUNC_FAIL: sprintf(name,"CV_QRHSFUNC_FAIL"); break; case CV_FIRST_QRHSFUNC_ERR: sprintf(name,"CV_FIRST_QRHSFUNC_ERR"); break; case CV_REPTD_QRHSFUNC_ERR: sprintf(name,"CV_REPTD_QRHSFUNC_ERR"); break; case CV_UNREC_QRHSFUNC_ERR: sprintf(name,"CV_UNREC_QRHSFUNC_ERR"); break; case CV_BAD_IS: sprintf(name,"CV_BAD_IS"); break; case CV_NO_SENS: sprintf(name,"CV_NO_SENS"); break; case CV_SRHSFUNC_FAIL: sprintf(name,"CV_SRHSFUNC_FAIL"); break; case CV_FIRST_SRHSFUNC_ERR: sprintf(name,"CV_FIRST_SRHSFUNC_ERR"); break; case CV_REPTD_SRHSFUNC_ERR: sprintf(name,"CV_REPTD_SRHSFUNC_ERR"); break; case CV_UNREC_SRHSFUNC_ERR: sprintf(name,"CV_UNREC_SRHSFUNC_ERR"); break; case CV_TOO_CLOSE: sprintf(name,"CV_TOO_CLOSE"); break; case CV_NO_ADJ: sprintf(name,"CV_NO_ADJ"); break; case CV_NO_FWD: sprintf(name,"CV_NO_FWD"); break; case CV_NO_BCK: sprintf(name,"CV_NO_BCK"); break; case CV_BAD_TB0: sprintf(name,"CV_BAD_TB0"); break; case CV_REIFWD_FAIL: sprintf(name,"CV_REIFWD_FAIL"); break; case CV_FWD_FAIL: sprintf(name,"CV_FWD_FAIL"); break; case CV_GETY_BADT: sprintf(name,"CV_GETY_BADT"); break; default: sprintf(name,"NONE"); } return(name); } StanHeaders/src/cvodes/cvodea.c0000644000176200001440000024310313766554456016162 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the CVODEA adjoint integrator. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "cvodes_impl.h" #include #include /* * ================================================================= * CVODEA PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) /* real 0.0 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define FUZZ_FACTOR RCONST(1000000.0) /* fuzz factor for IMget */ /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static CkpntMem CVAckpntInit(CVodeMem cv_mem); static CkpntMem CVAckpntNew(CVodeMem cv_mem); static void CVAckpntDelete(CkpntMem *ck_memPtr); static void CVAbckpbDelete(CVodeBMem *cvB_memPtr); static int CVAdataStore(CVodeMem cv_mem, CkpntMem ck_mem); static int CVAckpntGet(CVodeMem cv_mem, CkpntMem ck_mem); static int CVAfindIndex(CVodeMem cv_mem, realtype t, long int *indx, booleantype *newpoint); static booleantype CVAhermiteMalloc(CVodeMem cv_mem); static void CVAhermiteFree(CVodeMem cv_mem); static int CVAhermiteGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); static int CVAhermiteStorePnt(CVodeMem cv_mem, DtpntMem d); static booleantype CVApolynomialMalloc(CVodeMem cv_mem); static void CVApolynomialFree(CVodeMem cv_mem); static int CVApolynomialGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); static int CVApolynomialStorePnt(CVodeMem cv_mem, DtpntMem d); /* Wrappers */ static int CVArhs(realtype t, N_Vector yB, N_Vector yBdot, void *cvode_mem); static int CVArhsQ(realtype t, N_Vector yB, N_Vector qBdot, void *cvode_mem); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * CVodeAdjInit * * This routine initializes ASA and allocates space for the adjoint * memory structure. */ int CVodeAdjInit(void *cvode_mem, long int steps, int interp) { CVadjMem ca_mem; CVodeMem cv_mem; long int i, ii; /* --------------- * Check arguments * --------------- */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeAdjInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem)cvode_mem; if (steps <= 0) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeAdjInit", MSGCV_BAD_STEPS); return(CV_ILL_INPUT); } if ( (interp != CV_HERMITE) && (interp != CV_POLYNOMIAL) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeAdjInit", MSGCV_BAD_INTERP); return(CV_ILL_INPUT); } /* ---------------------------- * Allocate CVODEA memory block * ---------------------------- */ ca_mem = NULL; ca_mem = (CVadjMem) malloc(sizeof(struct CVadjMemRec)); if (ca_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Attach ca_mem to CVodeMem structure */ cv_mem->cv_adj_mem = ca_mem; /* ------------------------------ * Initialization of check points * ------------------------------ */ /* Set Check Points linked list to NULL */ ca_mem->ck_mem = NULL; /* Initialize nckpnts to ZERO */ ca_mem->ca_nckpnts = 0; /* No interpolation data is available */ ca_mem->ca_ckpntData = NULL; /* ------------------------------------ * Initialization of interpolation data * ------------------------------------ */ /* Interpolation type */ ca_mem->ca_IMtype = interp; /* Number of steps between check points */ ca_mem->ca_nsteps = steps; /* Last index used in CVAfindIndex, initailize to invalid value */ ca_mem->ca_ilast = -1; /* Allocate space for the array of Data Point structures */ ca_mem->dt_mem = NULL; ca_mem->dt_mem = (DtpntMem *) malloc((steps+1)*sizeof(struct DtpntMemRec *)); if (ca_mem->dt_mem == NULL) { free(ca_mem); ca_mem = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } for (i=0; i<=steps; i++) { ca_mem->dt_mem[i] = NULL; ca_mem->dt_mem[i] = (DtpntMem) malloc(sizeof(struct DtpntMemRec)); if (ca_mem->dt_mem[i] == NULL) { for(ii=0; iidt_mem[ii]); ca_mem->dt_mem[ii] = NULL;} free(ca_mem->dt_mem); ca_mem->dt_mem = NULL; free(ca_mem); ca_mem = NULL; cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeAdjInit", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } } /* Attach functions for the appropriate interpolation module */ switch(interp) { case CV_HERMITE: ca_mem->ca_IMmalloc = CVAhermiteMalloc; ca_mem->ca_IMfree = CVAhermiteFree; ca_mem->ca_IMget = CVAhermiteGetY; ca_mem->ca_IMstore = CVAhermiteStorePnt; break; case CV_POLYNOMIAL: ca_mem->ca_IMmalloc = CVApolynomialMalloc; ca_mem->ca_IMfree = CVApolynomialFree; ca_mem->ca_IMget = CVApolynomialGetY; ca_mem->ca_IMstore = CVApolynomialStorePnt; break; } /* The interpolation module has not been initialized yet */ ca_mem->ca_IMmallocDone = SUNFALSE; /* By default we will store but not interpolate sensitivities * - IMstoreSensi will be set in CVodeF to SUNFALSE if FSA is not enabled * or if the user can force this through CVodeSetAdjNoSensi * - IMinterpSensi will be set in CVodeB to SUNTRUE if IMstoreSensi is * SUNTRUE and if at least one backward problem requires sensitivities */ ca_mem->ca_IMstoreSensi = SUNTRUE; ca_mem->ca_IMinterpSensi = SUNFALSE; /* ------------------------------------ * Initialize list of backward problems * ------------------------------------ */ ca_mem->cvB_mem = NULL; ca_mem->ca_bckpbCrt = NULL; ca_mem->ca_nbckpbs = 0; /* -------------------------------- * CVodeF and CVodeB not called yet * -------------------------------- */ ca_mem->ca_firstCVodeFcall = SUNTRUE; ca_mem->ca_tstopCVodeFcall = SUNFALSE; ca_mem->ca_firstCVodeBcall = SUNTRUE; /* --------------------------------------------- * ASA initialized and allocated * --------------------------------------------- */ cv_mem->cv_adj = SUNTRUE; cv_mem->cv_adjMallocDone = SUNTRUE; return(CV_SUCCESS); } /* CVodeAdjReInit * * This routine reinitializes the CVODEA memory structure assuming that the * the number of steps between check points and the type of interpolation * remain unchanged. * The list of check points (and associated memory) is deleted. * The list of backward problems is kept (however, new backward problems can * be added to this list by calling CVodeCreateB). * The CVODES memory for the forward and backward problems can be reinitialized * separately by calling CVodeReInit and CVodeReInitB, respectively. * NOTE: if a completely new list of backward problems is also needed, then * simply free the adjoint memory (by calling CVodeAdjFree) and reinitialize * ASA with CVodeAdjInit. */ int CVodeAdjReInit(void *cvode_mem) { CVadjMem ca_mem; CVodeMem cv_mem; /* Check cvode_mem */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeAdjReInit", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeAdjReInit", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Free current list of Check Points */ while (ca_mem->ck_mem != NULL) CVAckpntDelete(&(ca_mem->ck_mem)); /* Initialization of check points */ ca_mem->ck_mem = NULL; ca_mem->ca_nckpnts = 0; ca_mem->ca_ckpntData = NULL; /* CVodeF and CVodeB not called yet */ ca_mem->ca_firstCVodeFcall = SUNTRUE; ca_mem->ca_tstopCVodeFcall = SUNFALSE; ca_mem->ca_firstCVodeBcall = SUNTRUE; return(CV_SUCCESS); } /* * CVodeAdjFree * * This routine frees the memory allocated by CVodeAdjInit. */ void CVodeAdjFree(void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; long int i; if (cvode_mem == NULL) return; cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_adjMallocDone) { ca_mem = cv_mem->cv_adj_mem; /* Delete check points one by one */ while (ca_mem->ck_mem != NULL) CVAckpntDelete(&(ca_mem->ck_mem)); /* Free vectors at all data points */ if (ca_mem->ca_IMmallocDone) { ca_mem->ca_IMfree(cv_mem); } for(i=0; i<=ca_mem->ca_nsteps; i++) { free(ca_mem->dt_mem[i]); ca_mem->dt_mem[i] = NULL; } free(ca_mem->dt_mem); ca_mem->dt_mem = NULL; /* Delete backward problems one by one */ while (ca_mem->cvB_mem != NULL) CVAbckpbDelete(&(ca_mem->cvB_mem)); /* Free CVODEA memory */ free(ca_mem); cv_mem->cv_adj_mem = NULL; } } /* * CVodeF * * This routine integrates to tout and returns solution into yout. * In the same time, it stores check point data every 'steps' steps. * * CVodeF can be called repeatedly by the user. * * ncheckPtr points to the number of check points stored so far. */ int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask, int *ncheckPtr) { CVadjMem ca_mem; CVodeMem cv_mem; CkpntMem tmp; DtpntMem *dt_mem; int flag, i; booleantype iret, allocOK; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeF", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeF", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check for yout != NULL */ if (yout == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_YOUT_NULL); return(CV_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_TRET_NULL); return(CV_ILL_INPUT); } /* Check for valid itask */ if ( (itask != CV_NORMAL) && (itask != CV_ONE_STEP) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeF", MSGCV_BAD_ITASK); return(CV_ILL_INPUT); } /* All error checking done */ dt_mem = ca_mem->dt_mem; /* If tstop is enabled, store some info */ if (cv_mem->cv_tstopset) { ca_mem->ca_tstopCVodeFcall = SUNTRUE; ca_mem->ca_tstopCVodeF = cv_mem->cv_tstop; } /* We will call CVode in CV_ONE_STEP mode, regardless * of what itask is, so flag if we need to return */ if (itask == CV_ONE_STEP) iret = SUNTRUE; else iret = SUNFALSE; /* On the first step: * - set tinitial * - initialize list of check points * - if needed, initialize the interpolation module * - load dt_mem[0] * On subsequent steps, test if taking a new step is necessary. */ if ( ca_mem->ca_firstCVodeFcall ) { ca_mem->ca_tinitial = cv_mem->cv_tn; ca_mem->ck_mem = CVAckpntInit(cv_mem); if (ca_mem->ck_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } if ( !ca_mem->ca_IMmallocDone ) { /* Do we need to store sensitivities? */ if (!cv_mem->cv_sensi) ca_mem->ca_IMstoreSensi = SUNFALSE; /* Allocate space for interpolation data */ allocOK = ca_mem->ca_IMmalloc(cv_mem); if (!allocOK) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Rename zn and, if needed, znS for use in interpolation */ for (i=0;ica_Y[i] = cv_mem->cv_zn[i]; if (ca_mem->ca_IMstoreSensi) { for (i=0;ica_YS[i] = cv_mem->cv_znS[i]; } ca_mem->ca_IMmallocDone = SUNTRUE; } dt_mem[0]->t = ca_mem->ck_mem->ck_t0; ca_mem->ca_IMstore(cv_mem, dt_mem[0]); ca_mem->ca_firstCVodeFcall = SUNFALSE; } else if ( (cv_mem->cv_tn - tout)*cv_mem->cv_h >= ZERO ) { /* If tout was passed, return interpolated solution. No changes to ck_mem or dt_mem are needed. */ *tret = tout; flag = CVodeGetDky(cv_mem, tout, 0, yout); *ncheckPtr = ca_mem->ca_nckpnts; ca_mem->ca_IMnewData = SUNTRUE; ca_mem->ca_ckpntData = ca_mem->ck_mem; ca_mem->ca_np = cv_mem->cv_nst % ca_mem->ca_nsteps + 1; return(flag); } /* Integrate to tout (in CV_ONE_STEP mode) while loading check points */ for(;;) { /* Perform one step of the integration */ flag = CVode(cv_mem, tout, yout, tret, CV_ONE_STEP); if (flag < 0) break; /* Test if a new check point is needed */ if ( cv_mem->cv_nst % ca_mem->ca_nsteps == 0 ) { ca_mem->ck_mem->ck_t1 = *tret; /* Create a new check point, load it, and append it to the list */ tmp = CVAckpntNew(cv_mem); if (tmp == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeF", MSGCV_MEM_FAIL); flag = CV_MEM_FAIL; break; } tmp->ck_next = ca_mem->ck_mem; ca_mem->ck_mem = tmp; ca_mem->ca_nckpnts++; cv_mem->cv_forceSetup = SUNTRUE; /* Reset i=0 and load dt_mem[0] */ dt_mem[0]->t = ca_mem->ck_mem->ck_t0; ca_mem->ca_IMstore(cv_mem, dt_mem[0]); } else { /* Load next point in dt_mem */ dt_mem[cv_mem->cv_nst % ca_mem->ca_nsteps]->t = *tret; ca_mem->ca_IMstore(cv_mem, dt_mem[cv_mem->cv_nst % ca_mem->ca_nsteps]); } /* Set t1 field of the current ckeck point structure for the case in which there will be no future check points */ ca_mem->ck_mem->ck_t1 = *tret; /* tfinal is now set to *tret */ ca_mem->ca_tfinal = *tret; /* Return if in CV_ONE_STEP mode */ if (iret) break; /* Return if tout reached */ if ( (*tret - tout)*cv_mem->cv_h >= ZERO ) { *tret = tout; CVodeGetDky(cv_mem, tout, 0, yout); /* Reset tretlast in cv_mem so that CVodeGetQuad and CVodeGetSens * evaluate quadratures and/or sensitivities at the proper time */ cv_mem->cv_tretlast = tout; break; } } /* end of for(;;)() */ /* Get ncheck from ca_mem */ *ncheckPtr = ca_mem->ca_nckpnts; /* Data is available for the last interval */ ca_mem->ca_IMnewData = SUNTRUE; ca_mem->ca_ckpntData = ca_mem->ck_mem; ca_mem->ca_np = cv_mem->cv_nst % ca_mem->ca_nsteps + 1; return(flag); } /* * ================================================================= * FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ int CVodeCreateB(void *cvode_mem, int lmmB, int *which) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem new_cvB_mem; void *cvodeB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeCreateB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeCreateB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Allocate space for new CVodeBMem object */ new_cvB_mem = NULL; new_cvB_mem = (CVodeBMem) malloc(sizeof(struct CVodeBMemRec)); if (new_cvB_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeCreateB", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } /* Create and set a new CVODES object for the backward problem */ cvodeB_mem = CVodeCreate(lmmB); if (cvodeB_mem == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODEA", "CVodeCreateB", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } CVodeSetUserData(cvodeB_mem, cvode_mem); CVodeSetMaxHnilWarns(cvodeB_mem, -1); CVodeSetErrHandlerFn(cvodeB_mem, cv_mem->cv_ehfun, cv_mem->cv_eh_data); CVodeSetErrFile(cvodeB_mem, cv_mem->cv_errfp); /* Set/initialize fields in the new CVodeBMem object, new_cvB_mem */ new_cvB_mem->cv_index = ca_mem->ca_nbckpbs; new_cvB_mem->cv_mem = (CVodeMem) cvodeB_mem; new_cvB_mem->cv_f = NULL; new_cvB_mem->cv_fs = NULL; new_cvB_mem->cv_fQ = NULL; new_cvB_mem->cv_fQs = NULL; new_cvB_mem->cv_user_data = NULL; new_cvB_mem->cv_lmem = NULL; new_cvB_mem->cv_lfree = NULL; new_cvB_mem->cv_pmem = NULL; new_cvB_mem->cv_pfree = NULL; new_cvB_mem->cv_y = NULL; new_cvB_mem->cv_f_withSensi = SUNFALSE; new_cvB_mem->cv_fQ_withSensi = SUNFALSE; /* Attach the new object to the linked list cvB_mem */ new_cvB_mem->cv_next = ca_mem->cvB_mem; ca_mem->cvB_mem = new_cvB_mem; /* Return the index of the newly created CVodeBMem object. * This must be passed to CVodeInitB and to other ***B * functions to set optional inputs for this backward problem */ *which = ca_mem->ca_nbckpbs; ca_mem->ca_nbckpbs++; return(CV_SUCCESS); } int CVodeInitB(void *cvode_mem, int which, CVRhsFnB fB, realtype tB0, N_Vector yB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Allocate and set the CVODES object */ flag = CVodeInit(cvodeB_mem, CVArhs, tB0, yB0); if (flag != CV_SUCCESS) return(flag); /* Copy fB function in cvB_mem */ cvB_mem->cv_f_withSensi = SUNFALSE; cvB_mem->cv_f = fB; /* Allocate space and initialize the y Nvector in cvB_mem */ cvB_mem->cv_t0 = tB0; cvB_mem->cv_y = N_VClone(yB0); N_VScale(ONE, yB0, cvB_mem->cv_y); return(CV_SUCCESS); } int CVodeInitBS(void *cvode_mem, int which, CVRhsFnBS fBs, realtype tB0, N_Vector yB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeInitBS", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeInitBS", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeInitBS", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Allocate and set the CVODES object */ flag = CVodeInit(cvodeB_mem, CVArhs, tB0, yB0); if (flag != CV_SUCCESS) return(flag); /* Copy fBs function in cvB_mem */ cvB_mem->cv_f_withSensi = SUNTRUE; cvB_mem->cv_fs = fBs; /* Allocate space and initialize the y Nvector in cvB_mem */ cvB_mem->cv_t0 = tB0; cvB_mem->cv_y = N_VClone(yB0); N_VScale(ONE, yB0, cvB_mem->cv_y); return(CV_SUCCESS); } int CVodeReInitB(void *cvode_mem, int which, realtype tB0, N_Vector yB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeReInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeReInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeReInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Reinitialize CVODES object */ flag = CVodeReInit(cvodeB_mem, tB0, yB0); return(flag); } int CVodeSStolerancesB(void *cvode_mem, int which, realtype reltolB, realtype abstolB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSStolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSStolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSStolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Set tolerances */ flag = CVodeSStolerances(cvodeB_mem, reltolB, abstolB); return(flag); } int CVodeSVtolerancesB(void *cvode_mem, int which, realtype reltolB, N_Vector abstolB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSVtolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSVtolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSVtolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Set tolerances */ flag = CVodeSVtolerances(cvodeB_mem, reltolB, abstolB); return(flag); } int CVodeQuadInitB(void *cvode_mem, int which, CVQuadRhsFnB fQB, N_Vector yQB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadInit(cvodeB_mem, CVArhsQ, yQB0); if (flag != CV_SUCCESS) return(flag); cvB_mem->cv_fQ_withSensi = SUNFALSE; cvB_mem->cv_fQ = fQB; return(CV_SUCCESS); } int CVodeQuadInitBS(void *cvode_mem, int which, CVQuadRhsFnBS fQBs, N_Vector yQB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadInitBS", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadInitBS", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadInitBS", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadInit(cvodeB_mem, CVArhsQ, yQB0); if (flag != CV_SUCCESS) return(flag); cvB_mem->cv_fQ_withSensi = SUNTRUE; cvB_mem->cv_fQs = fQBs; return(CV_SUCCESS); } int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadReInitB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadReInitB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadReInitB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadReInit(cvodeB_mem, yQB0); if (flag != CV_SUCCESS) return(flag); return(CV_SUCCESS); } int CVodeQuadSStolerancesB(void *cvode_mem, int which, realtype reltolQB, realtype abstolQB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadSStolerances(cvodeB_mem, reltolQB, abstolQB); return(flag); } int CVodeQuadSVtolerancesB(void *cvode_mem, int which, realtype reltolQB, N_Vector abstolQB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeQuadSStolerancesB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeQuadSVtolerances(cvodeB_mem, reltolQB, abstolQB); return(flag); } /* * CVodeB * * This routine performs the backward integration towards tBout * of all backward problems that were defined. * When necessary, it performs a forward integration between two * consecutive check points to update interpolation data. * * On a successful return, CVodeB returns CV_SUCCESS. * * NOTE that CVodeB DOES NOT return the solution for the backward * problem(s). Use CVodeGetB to extract the solution at tBret * for any given backward problem. * * If there are multiple backward problems and multiple check points, * CVodeB may not succeed in getting all problems to take one step * when called in ONE_STEP mode. */ int CVodeB(void *cvode_mem, realtype tBout, int itaskB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem, tmp_cvB_mem; CkpntMem ck_mem; int sign, flag=0; realtype tfuzz, tBret, tBn; booleantype gotCheckpoint, isActive, reachedTBout; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check if any backward problem has been defined */ if ( ca_mem->ca_nbckpbs == 0 ) { cvProcessError(cv_mem, CV_NO_BCK, "CVODEA", "CVodeB", MSGCV_NO_BCK); return(CV_NO_BCK); } cvB_mem = ca_mem->cvB_mem; /* Check whether CVodeF has been called */ if ( ca_mem->ca_firstCVodeFcall ) { cvProcessError(cv_mem, CV_NO_FWD, "CVODEA", "CVodeB", MSGCV_NO_FWD); return(CV_NO_FWD); } sign = (ca_mem->ca_tfinal - ca_mem->ca_tinitial > ZERO) ? 1 : -1; /* If this is the first call, loop over all backward problems and * - check that tB0 is valid * - check that tBout is ahead of tB0 in the backward direction * - check whether we need to interpolate forward sensitivities */ if ( ca_mem->ca_firstCVodeBcall ) { tmp_cvB_mem = cvB_mem; while(tmp_cvB_mem != NULL) { tBn = tmp_cvB_mem->cv_mem->cv_tn; if ( (sign*(tBn-ca_mem->ca_tinitial) < ZERO) || (sign*(ca_mem->ca_tfinal-tBn) < ZERO) ) { cvProcessError(cv_mem, CV_BAD_TB0, "CVODEA", "CVodeB", MSGCV_BAD_TB0, tmp_cvB_mem->cv_index); return(CV_BAD_TB0); } if (sign*(tBn-tBout) <= ZERO) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_TBOUT, tmp_cvB_mem->cv_index); return(CV_ILL_INPUT); } if ( tmp_cvB_mem->cv_f_withSensi || tmp_cvB_mem->cv_fQ_withSensi ) ca_mem->ca_IMinterpSensi = SUNTRUE; tmp_cvB_mem = tmp_cvB_mem->cv_next; } if ( ca_mem->ca_IMinterpSensi && !ca_mem->ca_IMstoreSensi) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_SENSI); return(CV_ILL_INPUT); } ca_mem->ca_firstCVodeBcall = SUNFALSE; } /* Check if itaskB is legal */ if ( (itaskB != CV_NORMAL) && (itaskB != CV_ONE_STEP) ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_ITASKB); return(CV_ILL_INPUT); } /* Check if tBout is legal */ if ( (sign*(tBout-ca_mem->ca_tinitial) < ZERO) || (sign*(ca_mem->ca_tfinal-tBout) < ZERO) ) { tfuzz = HUNDRED*cv_mem->cv_uround*(SUNRabs(ca_mem->ca_tinitial) + SUNRabs(ca_mem->ca_tfinal)); if ( (sign*(tBout-ca_mem->ca_tinitial) < ZERO) && (SUNRabs(tBout-ca_mem->ca_tinitial) < tfuzz) ) { tBout = ca_mem->ca_tinitial; } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeB", MSGCV_BAD_TBOUT); return(CV_ILL_INPUT); } } /* Loop through the check points and stop as soon as a backward * problem has its tn value behind the current check point's t0_ * value (in the backward direction) */ ck_mem = ca_mem->ck_mem; gotCheckpoint = SUNFALSE; for(;;) { tmp_cvB_mem = cvB_mem; while(tmp_cvB_mem != NULL) { tBn = tmp_cvB_mem->cv_mem->cv_tn; if ( sign*(tBn-ck_mem->ck_t0) > ZERO ) { gotCheckpoint = SUNTRUE; break; } if ( (itaskB==CV_NORMAL) && (tBn == ck_mem->ck_t0) && (sign*(tBout-ck_mem->ck_t0) >= ZERO) ) { gotCheckpoint = SUNTRUE; break; } tmp_cvB_mem = tmp_cvB_mem->cv_next; } if (gotCheckpoint) break; if (ck_mem->ck_next == NULL) break; ck_mem = ck_mem->ck_next; } /* Starting with the current check point from above, loop over check points while propagating backward problems */ for(;;) { /* Store interpolation data if not available. This is the 2nd forward integration pass */ if (ck_mem != ca_mem->ca_ckpntData) { flag = CVAdataStore(cv_mem, ck_mem); if (flag != CV_SUCCESS) break; } /* Loop through all backward problems and, if needed, * propagate their solution towards tBout */ tmp_cvB_mem = cvB_mem; while (tmp_cvB_mem != NULL) { /* Decide if current backward problem is "active" in this check point */ isActive = SUNTRUE; tBn = tmp_cvB_mem->cv_mem->cv_tn; if ( (tBn == ck_mem->ck_t0) && (sign*(tBout-ck_mem->ck_t0) < ZERO ) ) isActive = SUNFALSE; if ( (tBn == ck_mem->ck_t0) && (itaskB==CV_ONE_STEP) ) isActive = SUNFALSE; if ( sign * (tBn - ck_mem->ck_t0) < ZERO ) isActive = SUNFALSE; if ( isActive ) { /* Store the address of current backward problem memory * in ca_mem to be used in the wrapper functions */ ca_mem->ca_bckpbCrt = tmp_cvB_mem; /* Integrate current backward problem */ CVodeSetStopTime(tmp_cvB_mem->cv_mem, ck_mem->ck_t0); flag = CVode(tmp_cvB_mem->cv_mem, tBout, tmp_cvB_mem->cv_y, &tBret, itaskB); /* Set the time at which we will report solution and/or quadratures */ tmp_cvB_mem->cv_tout = tBret; /* If an error occurred, exit while loop */ if (flag < 0) break; } else { flag = CV_SUCCESS; tmp_cvB_mem->cv_tout = tBn; } /* Move to next backward problem */ tmp_cvB_mem = tmp_cvB_mem->cv_next; } /* If an error occurred, return now */ if (flag <0) { cvProcessError(cv_mem, flag, "CVODEA", "CVodeB", MSGCV_BACK_ERROR, tmp_cvB_mem->cv_index); return(flag); } /* If in CV_ONE_STEP mode, return now (flag = CV_SUCCESS) */ if (itaskB == CV_ONE_STEP) break; /* If all backward problems have succesfully reached tBout, return now */ reachedTBout = SUNTRUE; tmp_cvB_mem = cvB_mem; while(tmp_cvB_mem != NULL) { if ( sign*(tmp_cvB_mem->cv_tout - tBout) > ZERO ) { reachedTBout = SUNFALSE; break; } tmp_cvB_mem = tmp_cvB_mem->cv_next; } if ( reachedTBout ) break; /* Move check point in linked list to next one */ ck_mem = ck_mem->ck_next; } return(flag); } int CVodeGetB(void *cvode_mem, int which, realtype *tret, N_Vector yB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeGetB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } N_VScale(ONE, cvB_mem->cv_y, yB); *tret = cvB_mem->cv_tout; return(CV_SUCCESS); } /* * CVodeGetQuadB */ int CVodeGetQuadB(void *cvode_mem, int which, realtype *tret, N_Vector qB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; long int nstB; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetQuadB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetQuadB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeGetQuadB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); /* If the integration for this backward problem has not started yet, * simply return the current value of qB (i.e. the final conditions) */ flag = CVodeGetNumSteps(cvodeB_mem, &nstB); if (nstB == 0) { N_VScale(ONE, cvB_mem->cv_mem->cv_znQ[0], qB); *tret = cvB_mem->cv_tout; } else { flag = CVodeGetQuad(cvodeB_mem, tret, qB); } return(flag); } /* * ================================================================= * PRIVATE FUNCTIONS FOR CHECK POINTS * ================================================================= */ /* * CVAckpntInit * * This routine initializes the check point linked list with * information from the initial time. */ static CkpntMem CVAckpntInit(CVodeMem cv_mem) { CkpntMem ck_mem; int is; /* Allocate space for ckdata */ ck_mem = NULL; ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (ck_mem == NULL) return(NULL); ck_mem->ck_zn[0] = N_VClone(cv_mem->cv_tempv); if (ck_mem->ck_zn[0] == NULL) { free(ck_mem); ck_mem = NULL; return(NULL); } ck_mem->ck_zn[1] = N_VClone(cv_mem->cv_tempv); if (ck_mem->ck_zn[1] == NULL) { N_VDestroy(ck_mem->ck_zn[0]); free(ck_mem); ck_mem = NULL; return(NULL); } /* ck_mem->ck_zn[qmax] was not allocated */ ck_mem->ck_zqm = 0; /* Load ckdata from cv_mem */ N_VScale(ONE, cv_mem->cv_zn[0], ck_mem->ck_zn[0]); ck_mem->ck_t0 = cv_mem->cv_tn; ck_mem->ck_nst = 0; ck_mem->ck_q = 1; ck_mem->ck_h = 0.0; /* Do we need to carry quadratures */ ck_mem->ck_quadr = cv_mem->cv_quadr && cv_mem->cv_errconQ; if (ck_mem->ck_quadr) { ck_mem->ck_znQ[0] = N_VClone(cv_mem->cv_tempvQ); if (ck_mem->ck_znQ[0] == NULL) { N_VDestroy(ck_mem->ck_zn[0]); N_VDestroy(ck_mem->ck_zn[1]); free(ck_mem); ck_mem = NULL; return(NULL); } N_VScale(ONE, cv_mem->cv_znQ[0], ck_mem->ck_znQ[0]); } /* Do we need to carry sensitivities? */ ck_mem->ck_sensi = cv_mem->cv_sensi; if (ck_mem->ck_sensi) { ck_mem->ck_Ns = cv_mem->cv_Ns; ck_mem->ck_znS[0] = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (ck_mem->ck_znS[0] == NULL) { N_VDestroy(ck_mem->ck_zn[0]); N_VDestroy(ck_mem->ck_zn[1]); if (ck_mem->ck_quadr) N_VDestroy(ck_mem->ck_znQ[0]); free(ck_mem); ck_mem = NULL; return(NULL); } for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[0], ck_mem->ck_znS[0]); } /* Do we need to carry quadrature sensitivities? */ ck_mem->ck_quadr_sensi = cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS; if (ck_mem->ck_quadr_sensi) { ck_mem->ck_znQS[0] = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempvQ); if (ck_mem->ck_znQS[0] == NULL) { N_VDestroy(ck_mem->ck_zn[0]); N_VDestroy(ck_mem->ck_zn[1]); if (ck_mem->ck_quadr) N_VDestroy(ck_mem->ck_znQ[0]); N_VDestroyVectorArray(ck_mem->ck_znS[0], cv_mem->cv_Ns); free(ck_mem); ck_mem = NULL; return(NULL); } for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znQS[0], ck_mem->ck_znQS[0]); } /* Next in list */ ck_mem->ck_next = NULL; return(ck_mem); } /* * CVAckpntNew * * This routine allocates space for a new check point and sets * its data from current values in cv_mem. */ static CkpntMem CVAckpntNew(CVodeMem cv_mem) { CkpntMem ck_mem; int j, jj, is, qmax; /* Allocate space for ckdata */ ck_mem = NULL; ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (ck_mem == NULL) return(NULL); /* Set cv_next to NULL */ ck_mem->ck_next = NULL; /* Test if we need to allocate space for the last zn. * NOTE: zn(qmax) may be needed for a hot restart, if an order * increase is deemed necessary at the first step after a check point */ qmax = cv_mem->cv_qmax; ck_mem->ck_zqm = (cv_mem->cv_q < qmax) ? qmax : 0; for (j=0; j<=cv_mem->cv_q; j++) { ck_mem->ck_zn[j] = N_VClone(cv_mem->cv_tempv); if (ck_mem->ck_zn[j] == NULL) { for (jj=0; jjck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } if (cv_mem->cv_q < qmax) { ck_mem->ck_zn[qmax] = N_VClone(cv_mem->cv_tempv); if (ck_mem->ck_zn[qmax] == NULL) { for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } /* Test if we need to carry quadratures */ ck_mem->ck_quadr = cv_mem->cv_quadr && cv_mem->cv_errconQ; if (ck_mem->ck_quadr) { for (j=0; j<=cv_mem->cv_q; j++) { ck_mem->ck_znQ[j] = N_VClone(cv_mem->cv_tempvQ); if(ck_mem->ck_znQ[j] == NULL) { for (jj=0; jjck_znQ[jj]); if (cv_mem->cv_q < qmax) N_VDestroy(ck_mem->ck_zn[qmax]); for (jj=0; jj<=cv_mem->cv_q; j++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } if (cv_mem->cv_q < qmax) { ck_mem->ck_znQ[qmax] = N_VClone(cv_mem->cv_tempvQ); if (ck_mem->ck_znQ[qmax] == NULL) { for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_znQ[jj]); N_VDestroy(ck_mem->ck_zn[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } } /* Test if we need to carry sensitivities */ ck_mem->ck_sensi = cv_mem->cv_sensi; if (ck_mem->ck_sensi) { ck_mem->ck_Ns = cv_mem->cv_Ns; for (j=0; j<=cv_mem->cv_q; j++) { ck_mem->ck_znS[j] = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (ck_mem->ck_znS[j] == NULL) { for (jj=0; jjck_znS[jj], cv_mem->cv_Ns); if (ck_mem->ck_quadr) { if (cv_mem->cv_q < qmax) N_VDestroy(ck_mem->ck_znQ[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_znQ[jj]); } if (cv_mem->cv_q < qmax) N_VDestroy(ck_mem->ck_zn[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } if ( cv_mem->cv_q < qmax) { ck_mem->ck_znS[qmax] = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (ck_mem->ck_znS[qmax] == NULL) { for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroyVectorArray(ck_mem->ck_znS[jj], cv_mem->cv_Ns); if (ck_mem->ck_quadr) { N_VDestroy(ck_mem->ck_znQ[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_znQ[jj]); } N_VDestroy(ck_mem->ck_zn[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } } /* Test if we need to carry quadrature sensitivities */ ck_mem->ck_quadr_sensi = cv_mem->cv_quadr_sensi && cv_mem->cv_errconQS; if (ck_mem->ck_quadr_sensi) { for (j=0; j<=cv_mem->cv_q; j++) { ck_mem->ck_znQS[j] = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempvQ); if (ck_mem->ck_znQS[j] == NULL) { for (jj=0; jjck_znQS[jj], cv_mem->cv_Ns); if (cv_mem->cv_q < qmax) N_VDestroyVectorArray(ck_mem->ck_znS[qmax], cv_mem->cv_Ns); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroyVectorArray(ck_mem->ck_znS[jj], cv_mem->cv_Ns); if (ck_mem->ck_quadr) { if (cv_mem->cv_q < qmax) N_VDestroy(ck_mem->ck_znQ[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_znQ[jj]); } if (cv_mem->cv_q < qmax) N_VDestroy(ck_mem->ck_zn[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } if ( cv_mem->cv_q < qmax) { ck_mem->ck_znQS[qmax] = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempvQ); if (ck_mem->ck_znQS[qmax] == NULL) { for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroyVectorArray(ck_mem->ck_znQS[jj], cv_mem->cv_Ns); N_VDestroyVectorArray(ck_mem->ck_znS[qmax], cv_mem->cv_Ns); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroyVectorArray(ck_mem->ck_znS[jj], cv_mem->cv_Ns); if (ck_mem->ck_quadr) { N_VDestroy(ck_mem->ck_znQ[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); } N_VDestroy(ck_mem->ck_zn[qmax]); for (jj=0; jj<=cv_mem->cv_q; jj++) N_VDestroy(ck_mem->ck_zn[jj]); free(ck_mem); ck_mem = NULL; return(NULL); } } } /* Load check point data from cv_mem */ for (j=0; j<=cv_mem->cv_q; j++) cv_mem->cv_cvals[j] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_q+1, cv_mem->cv_cvals, cv_mem->cv_zn, ck_mem->ck_zn); if ( cv_mem->cv_q < qmax ) N_VScale(ONE, cv_mem->cv_zn[qmax], ck_mem->ck_zn[qmax]); if (ck_mem->ck_quadr) { for (j=0; j<=cv_mem->cv_q; j++) cv_mem->cv_cvals[j] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_q+1, cv_mem->cv_cvals, cv_mem->cv_znQ, ck_mem->ck_znQ); if ( cv_mem->cv_q < qmax ) N_VScale(ONE, cv_mem->cv_znQ[qmax], ck_mem->ck_znQ[qmax]); } if (ck_mem->ck_sensi) { for (j=0; j<=cv_mem->cv_q; j++) { for (is=0; iscv_Ns; is++) { cv_mem->cv_cvals[j*cv_mem->cv_Ns+is] = ONE; cv_mem->cv_Xvecs[j*cv_mem->cv_Ns+is] = cv_mem->cv_znS[j][is]; cv_mem->cv_Zvecs[j*cv_mem->cv_Ns+is] = ck_mem->ck_znS[j][is]; } } (void) N_VScaleVectorArray(cv_mem->cv_Ns*(cv_mem->cv_q+1), cv_mem->cv_cvals, cv_mem->cv_Xvecs, cv_mem->cv_Zvecs); if ( cv_mem->cv_q < qmax ) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[qmax], ck_mem->ck_znS[qmax]); } } if (ck_mem->ck_quadr_sensi) { for (j=0; j<=cv_mem->cv_q; j++) { for (is=0; iscv_Ns; is++) { cv_mem->cv_cvals[j*cv_mem->cv_Ns+is] = ONE; cv_mem->cv_Xvecs[j*cv_mem->cv_Ns+is] = cv_mem->cv_znQS[j][is]; cv_mem->cv_Zvecs[j*cv_mem->cv_Ns+is] = ck_mem->ck_znQS[j][is]; } } (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_Xvecs, cv_mem->cv_Zvecs); if ( cv_mem->cv_q < qmax ) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; (void) N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znQS[qmax], ck_mem->ck_znQS[qmax]); } } for (j=0; j<=L_MAX; j++) ck_mem->ck_tau[j] = cv_mem->cv_tau[j]; for (j=0; j<=NUM_TESTS; j++) ck_mem->ck_tq[j] = cv_mem->cv_tq[j]; for (j=0; j<=cv_mem->cv_q; j++) ck_mem->ck_l[j] = cv_mem->cv_l[j]; ck_mem->ck_nst = cv_mem->cv_nst; ck_mem->ck_tretlast = cv_mem->cv_tretlast; ck_mem->ck_q = cv_mem->cv_q; ck_mem->ck_qprime = cv_mem->cv_qprime; ck_mem->ck_qwait = cv_mem->cv_qwait; ck_mem->ck_L = cv_mem->cv_L; ck_mem->ck_gammap = cv_mem->cv_gammap; ck_mem->ck_h = cv_mem->cv_h; ck_mem->ck_hprime = cv_mem->cv_hprime; ck_mem->ck_hscale = cv_mem->cv_hscale; ck_mem->ck_eta = cv_mem->cv_eta; ck_mem->ck_etamax = cv_mem->cv_etamax; ck_mem->ck_t0 = cv_mem->cv_tn; ck_mem->ck_saved_tq5 = cv_mem->cv_saved_tq5; return(ck_mem); } /* * CVAckpntDelete * * This routine deletes the first check point in list and returns * the new list head */ static void CVAckpntDelete(CkpntMem *ck_memPtr) { CkpntMem tmp; int j; if (*ck_memPtr == NULL) return; /* store head of list */ tmp = *ck_memPtr; /* move head of list */ *ck_memPtr = (*ck_memPtr)->ck_next; /* free N_Vectors in tmp */ for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_zn[j]); if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_zn[tmp->ck_zqm]); /* free N_Vectors for quadratures in tmp * Note that at the check point at t_initial, only znQ_[0] * was allocated */ if (tmp->ck_quadr) { if (tmp->ck_next != NULL) { for (j=0;j<=tmp->ck_q;j++) N_VDestroy(tmp->ck_znQ[j]); if (tmp->ck_zqm != 0) N_VDestroy(tmp->ck_znQ[tmp->ck_zqm]); } else { N_VDestroy(tmp->ck_znQ[0]); } } /* free N_Vectors for sensitivities in tmp * Note that at the check point at t_initial, only znS_[0] * was allocated */ if (tmp->ck_sensi) { if (tmp->ck_next != NULL) { for (j=0;j<=tmp->ck_q;j++) N_VDestroyVectorArray(tmp->ck_znS[j], tmp->ck_Ns); if (tmp->ck_zqm != 0) N_VDestroyVectorArray(tmp->ck_znS[tmp->ck_zqm], tmp->ck_Ns); } else { N_VDestroyVectorArray(tmp->ck_znS[0], tmp->ck_Ns); } } /* free N_Vectors for quadrature sensitivities in tmp * Note that at the check point at t_initial, only znQS_[0] * was allocated */ if (tmp->ck_quadr_sensi) { if (tmp->ck_next != NULL) { for (j=0;j<=tmp->ck_q;j++) N_VDestroyVectorArray(tmp->ck_znQS[j], tmp->ck_Ns); if (tmp->ck_zqm != 0) N_VDestroyVectorArray(tmp->ck_znQS[tmp->ck_zqm], tmp->ck_Ns); } else { N_VDestroyVectorArray(tmp->ck_znQS[0], tmp->ck_Ns); } } free(tmp); tmp = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ static void CVAbckpbDelete(CVodeBMem *cvB_memPtr) { CVodeBMem tmp; void *cvode_mem; if (*cvB_memPtr != NULL) { /* Save head of the list */ tmp = *cvB_memPtr; /* Move head of the list */ *cvB_memPtr = (*cvB_memPtr)->cv_next; /* Free CVODES memory in tmp */ cvode_mem = (void *)(tmp->cv_mem); CVodeFree(&cvode_mem); /* Free linear solver memory */ if (tmp->cv_lfree != NULL) tmp->cv_lfree(tmp); /* Free preconditioner memory */ if (tmp->cv_pfree != NULL) tmp->cv_pfree(tmp); /* Free workspace Nvector */ N_VDestroy(tmp->cv_y); free(tmp); tmp = NULL; } } /* * ================================================================= * PRIVATE FUNCTIONS FOR INTERPOLATION * ================================================================= */ /* * CVAdataStore * * This routine integrates the forward model starting at the check * point ck_mem and stores y and yprime at all intermediate steps. * * Return values: * CV_SUCCESS * CV_REIFWD_FAIL * CV_FWD_FAIL */ static int CVAdataStore(CVodeMem cv_mem, CkpntMem ck_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; realtype t; long int i; int flag, sign; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; /* Initialize cv_mem with data from ck_mem */ flag = CVAckpntGet(cv_mem, ck_mem); if (flag != CV_SUCCESS) return(CV_REIFWD_FAIL); /* Set first structure in dt_mem[0] */ dt_mem[0]->t = ck_mem->ck_t0; ca_mem->ca_IMstore(cv_mem, dt_mem[0]); /* Decide whether TSTOP must be activated */ if (ca_mem->ca_tstopCVodeFcall) { CVodeSetStopTime(cv_mem, ca_mem->ca_tstopCVodeF); } sign = (ca_mem->ca_tfinal - ca_mem->ca_tinitial > ZERO) ? 1 : -1; /* Run CVode to set following structures in dt_mem[i] */ i = 1; do { flag = CVode(cv_mem, ck_mem->ck_t1, ca_mem->ca_ytmp, &t, CV_ONE_STEP); if (flag < 0) return(CV_FWD_FAIL); dt_mem[i]->t = t; ca_mem->ca_IMstore(cv_mem, dt_mem[i]); i++; } while ( sign*(ck_mem->ck_t1 - t) > ZERO ); ca_mem->ca_IMnewData = SUNTRUE; /* New data is now available */ ca_mem->ca_ckpntData = ck_mem; /* starting at this check point */ ca_mem->ca_np = i; /* and we have this many points */ return(CV_SUCCESS); } /* * CVAckpntGet * * This routine prepares CVODES for a hot restart from * the check point ck_mem */ static int CVAckpntGet(CVodeMem cv_mem, CkpntMem ck_mem) { int flag, j, is, qmax, retval; if (ck_mem->ck_next == NULL) { /* In this case, we just call the reinitialization routine, * but make sure we use the same initial stepsize as on * the first run. */ CVodeSetInitStep(cv_mem, cv_mem->cv_h0u); flag = CVodeReInit(cv_mem, ck_mem->ck_t0, ck_mem->ck_zn[0]); if (flag != CV_SUCCESS) return(flag); if (ck_mem->ck_quadr) { flag = CVodeQuadReInit(cv_mem, ck_mem->ck_znQ[0]); if (flag != CV_SUCCESS) return(flag); } if (ck_mem->ck_sensi) { flag = CVodeSensReInit(cv_mem, cv_mem->cv_ism, ck_mem->ck_znS[0]); if (flag != CV_SUCCESS) return(flag); } if (ck_mem->ck_quadr_sensi) { flag = CVodeQuadSensReInit(cv_mem, ck_mem->ck_znQS[0]); if (flag != CV_SUCCESS) return(flag); } } else { qmax = cv_mem->cv_qmax; /* Copy parameters from check point data structure */ cv_mem->cv_nst = ck_mem->ck_nst; cv_mem->cv_tretlast = ck_mem->ck_tretlast; cv_mem->cv_q = ck_mem->ck_q; cv_mem->cv_qprime = ck_mem->ck_qprime; cv_mem->cv_qwait = ck_mem->ck_qwait; cv_mem->cv_L = ck_mem->ck_L; cv_mem->cv_gammap = ck_mem->ck_gammap; cv_mem->cv_h = ck_mem->ck_h; cv_mem->cv_hprime = ck_mem->ck_hprime; cv_mem->cv_hscale = ck_mem->ck_hscale; cv_mem->cv_eta = ck_mem->ck_eta; cv_mem->cv_etamax = ck_mem->ck_etamax; cv_mem->cv_tn = ck_mem->ck_t0; cv_mem->cv_saved_tq5 = ck_mem->ck_saved_tq5; /* Copy the arrays from check point data structure */ for (j=0; j<=cv_mem->cv_q; j++) cv_mem->cv_cvals[j] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_q+1, cv_mem->cv_cvals, ck_mem->ck_zn, cv_mem->cv_zn); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); if ( cv_mem->cv_q < qmax ) N_VScale(ONE, ck_mem->ck_zn[qmax], cv_mem->cv_zn[qmax]); if (ck_mem->ck_quadr) { for (j=0; j<=cv_mem->cv_q; j++) cv_mem->cv_cvals[j] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_q+1, cv_mem->cv_cvals, ck_mem->ck_znQ, cv_mem->cv_znQ); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); if ( cv_mem->cv_q < qmax ) N_VScale(ONE, ck_mem->ck_znQ[qmax], cv_mem->cv_znQ[qmax]); } if (ck_mem->ck_sensi) { for (j=0; j<=cv_mem->cv_q; j++) { for (is=0; iscv_Ns; is++) { cv_mem->cv_cvals[j*cv_mem->cv_Ns+is] = ONE; cv_mem->cv_Xvecs[j*cv_mem->cv_Ns+is] = ck_mem->ck_znS[j][is]; cv_mem->cv_Zvecs[j*cv_mem->cv_Ns+is] = cv_mem->cv_znS[j][is]; } } retval = N_VScaleVectorArray(cv_mem->cv_Ns*(cv_mem->cv_q+1), cv_mem->cv_cvals, cv_mem->cv_Xvecs, cv_mem->cv_Zvecs); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); if ( cv_mem->cv_q < qmax ) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, ck_mem->ck_znS[qmax], cv_mem->cv_znS[qmax]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } if (ck_mem->ck_quadr_sensi) { for (j=0; j<=cv_mem->cv_q; j++) { for (is=0; iscv_Ns; is++) { cv_mem->cv_cvals[j*cv_mem->cv_Ns+is] = ONE; cv_mem->cv_Xvecs[j*cv_mem->cv_Ns+is] = ck_mem->ck_znQS[j][is]; cv_mem->cv_Zvecs[j*cv_mem->cv_Ns+is] = cv_mem->cv_znQS[j][is]; } } retval = N_VScaleVectorArray(cv_mem->cv_Ns*(cv_mem->cv_q+1), cv_mem->cv_cvals, cv_mem->cv_Xvecs, cv_mem->cv_Zvecs); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); if ( cv_mem->cv_q < qmax ) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, ck_mem->ck_znQS[qmax], cv_mem->cv_znQS[qmax]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } for (j=0; j<=L_MAX; j++) cv_mem->cv_tau[j] = ck_mem->ck_tau[j]; for (j=0; j<=NUM_TESTS; j++) cv_mem->cv_tq[j] = ck_mem->ck_tq[j]; for (j=0; j<=cv_mem->cv_q; j++) cv_mem->cv_l[j] = ck_mem->ck_l[j]; /* Force a call to setup */ cv_mem->cv_forceSetup = SUNTRUE; } return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Functions for interpolation * ----------------------------------------------------------------- */ /* * CVAfindIndex * * Finds the index in the array of data point strctures such that * dt_mem[indx-1].t <= t < dt_mem[indx].t * If indx is changed from the previous invocation, then newpoint = SUNTRUE * * If t is beyond the leftmost limit, but close enough, indx=0. * * Returns CV_SUCCESS if successful and CV_GETY_BADT if unable to * find indx (t is too far beyond limits). */ static int CVAfindIndex(CVodeMem cv_mem, realtype t, long int *indx, booleantype *newpoint) { CVadjMem ca_mem; DtpntMem *dt_mem; int sign; booleantype to_left, to_right; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; *newpoint = SUNFALSE; /* Find the direction of integration */ sign = (ca_mem->ca_tfinal - ca_mem->ca_tinitial > ZERO) ? 1 : -1; /* If this is the first time we use new data */ if (ca_mem->ca_IMnewData) { ca_mem->ca_ilast = ca_mem->ca_np-1; *newpoint = SUNTRUE; ca_mem->ca_IMnewData = SUNFALSE; } /* Search for indx starting from ilast */ to_left = ( sign*(t - dt_mem[ca_mem->ca_ilast-1]->t) < ZERO); to_right = ( sign*(t - dt_mem[ca_mem->ca_ilast]->t) > ZERO); if ( to_left ) { /* look for a new indx to the left */ *newpoint = SUNTRUE; *indx = ca_mem->ca_ilast; for(;;) { if ( *indx == 0 ) break; if ( sign*(t - dt_mem[*indx-1]->t) <= ZERO ) (*indx)--; else break; } if ( *indx == 0 ) ca_mem->ca_ilast = 1; else ca_mem->ca_ilast = *indx; if ( *indx == 0 ) { /* t is beyond leftmost limit. Is it too far? */ if ( SUNRabs(t - dt_mem[0]->t) > FUZZ_FACTOR * cv_mem->cv_uround ) { return(CV_GETY_BADT); } } } else if ( to_right ) { /* look for a new indx to the right */ *newpoint = SUNTRUE; *indx = ca_mem->ca_ilast; for(;;) { if ( sign*(t - dt_mem[*indx]->t) > ZERO) (*indx)++; else break; } ca_mem->ca_ilast = *indx; } else { /* ilast is still OK */ *indx = ca_mem->ca_ilast; } return(CV_SUCCESS); } /* * CVodeGetAdjY * * This routine returns the interpolated forward solution at time t. * The user must allocate space for y. */ int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y) { CVodeMem cv_mem; CVadjMem ca_mem; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjY", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; flag = ca_mem->ca_IMget(cv_mem, t, y, NULL); return(flag); } /* * ----------------------------------------------------------------- * Functions specific to cubic Hermite interpolation * ----------------------------------------------------------------- */ /* * CVAhermiteMalloc * * This routine allocates memory for storing information at all * intermediate points between two consecutive check points. * This data is then used to interpolate the forward solution * at any other time. */ static booleantype CVAhermiteMalloc(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i, ii=0; booleantype allocOK; allocOK = SUNTRUE; ca_mem = cv_mem->cv_adj_mem; /* Allocate space for the vectors ytmp and yStmp */ ca_mem->ca_ytmp = N_VClone(cv_mem->cv_tempv); if (ca_mem->ca_ytmp == NULL) { return(SUNFALSE); } if (ca_mem->ca_IMstoreSensi) { ca_mem->ca_yStmp = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (ca_mem->ca_yStmp == NULL) { N_VDestroy(ca_mem->ca_ytmp); return(SUNFALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = ca_mem->dt_mem; for (i=0; i<=ca_mem->ca_nsteps; i++) { content = NULL; content = (HermiteDataMem) malloc(sizeof(struct HermiteDataMemRec)); if (content == NULL) { ii = i; allocOK = SUNFALSE; break; } content->y = N_VClone(cv_mem->cv_tempv); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } content->yd = N_VClone(cv_mem->cv_tempv); if (content->yd == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } if (ca_mem->ca_IMstoreSensi) { content->yS = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (content->yS == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } content->ySd = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (content->ySd == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); N_VDestroyVectorArray(content->yS, cv_mem->cv_Ns); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(ca_mem->ca_ytmp); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(ca_mem->ca_yStmp, cv_mem->cv_Ns); } for (i=0; icontent); N_VDestroy(content->y); N_VDestroy(content->yd); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(content->yS, cv_mem->cv_Ns); N_VDestroyVectorArray(content->ySd, cv_mem->cv_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * CVAhermiteFree * * This routine frees the memory allocated for data storage. */ static void CVAhermiteFree(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i; ca_mem = cv_mem->cv_adj_mem; N_VDestroy(ca_mem->ca_ytmp); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(ca_mem->ca_yStmp, cv_mem->cv_Ns); } dt_mem = ca_mem->dt_mem; for (i=0; i<=ca_mem->ca_nsteps; i++) { content = (HermiteDataMem) (dt_mem[i]->content); N_VDestroy(content->y); N_VDestroy(content->yd); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(content->yS, cv_mem->cv_Ns); N_VDestroyVectorArray(content->ySd, cv_mem->cv_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } /* * CVAhermiteStorePnt ( -> IMstore ) * * This routine stores a new point (y,yd) in the structure d for use * in the cubic Hermite interpolation. * Note that the time is already stored. */ static int CVAhermiteStorePnt(CVodeMem cv_mem, DtpntMem d) { CVadjMem ca_mem; HermiteDataMem content; int is, retval; ca_mem = cv_mem->cv_adj_mem; content = (HermiteDataMem) d->content; /* Load solution */ N_VScale(ONE, cv_mem->cv_zn[0], content->y); if (ca_mem->ca_IMstoreSensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[0], content->yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } /* Load derivative */ if (cv_mem->cv_nst == 0) { /* retval = */ cv_mem->cv_f(cv_mem->cv_tn, content->y, content->yd, cv_mem->cv_user_data); if (ca_mem->ca_IMstoreSensi) { /* retval = */ cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, content->y, content->yd, content->yS, content->ySd, cv_mem->cv_tempv, cv_mem->cv_ftemp); } } else { N_VScale(ONE/cv_mem->cv_h, cv_mem->cv_zn[1], content->yd); if (ca_mem->ca_IMstoreSensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE/cv_mem->cv_h; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[1], content->ySd); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } return(0); } /* * CVAhermiteGetY ( -> IMget ) * * This routine uses cubic piece-wise Hermite interpolation for * the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB) but * can be directly called by the user through CVodeGetAdjY */ static int CVAhermiteGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS) { CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content0, content1; realtype t0, t1, delta; realtype factor1, factor2, factor3; N_Vector y0, yd0, y1, yd1; N_Vector *yS0=NULL, *ySd0=NULL, *yS1, *ySd1; int flag, is, NS; long int indx; booleantype newpoint; /* local variables for fused vector oerations */ int retval; realtype cvals[4]; N_Vector Xvecs[4]; N_Vector* XXvecs[4]; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; /* Local value of Ns */ NS = (ca_mem->ca_IMinterpSensi && (yS != NULL)) ? cv_mem->cv_Ns : 0; /* Get the index in dt_mem */ flag = CVAfindIndex(cv_mem, t, &indx, &newpoint); if (flag != CV_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content0 = (HermiteDataMem) (dt_mem[0]->content); N_VScale(ONE, content0->y, y); if (NS > 0) { for (is=0; iscv_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, cv_mem->cv_cvals, content0->yS, yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } return(CV_SUCCESS); } /* Extract stuff from the appropriate data points */ t0 = dt_mem[indx-1]->t; t1 = dt_mem[indx]->t; delta = t1 - t0; content0 = (HermiteDataMem) (dt_mem[indx-1]->content); y0 = content0->y; yd0 = content0->yd; if (ca_mem->ca_IMinterpSensi) { yS0 = content0->yS; ySd0 = content0->ySd; } if (newpoint) { /* Recompute Y0 and Y1 */ content1 = (HermiteDataMem) (dt_mem[indx]->content); y1 = content1->y; yd1 = content1->yd; /* Y1 = delta (yd1 + yd0) - 2 (y1 - y0) */ cvals[0] = -TWO; Xvecs[0] = y1; cvals[1] = TWO; Xvecs[1] = y0; cvals[2] = delta; Xvecs[2] = yd1; cvals[3] = delta; Xvecs[3] = yd0; retval = N_VLinearCombination(4, cvals, Xvecs, ca_mem->ca_Y[1]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Y0 = y1 - y0 - delta * yd0 */ cvals[0] = ONE; Xvecs[0] = y1; cvals[1] = -ONE; Xvecs[1] = y0; cvals[2] = -delta; Xvecs[2] = yd0; retval = N_VLinearCombination(3, cvals, Xvecs, ca_mem->ca_Y[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* Recompute YS0 and YS1, if needed */ if (NS > 0) { yS1 = content1->yS; ySd1 = content1->ySd; /* YS1 = delta (ySd1 + ySd0) - 2 (yS1 - yS0) */ cvals[0] = -TWO; XXvecs[0] = yS1; cvals[1] = TWO; XXvecs[1] = yS0; cvals[2] = delta; XXvecs[2] = ySd1; cvals[3] = delta; XXvecs[3] = ySd0; retval = N_VLinearCombinationVectorArray(NS, 4, cvals, XXvecs, ca_mem->ca_YS[1]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* YS0 = yS1 - yS0 - delta * ySd0 */ cvals[0] = ONE; XXvecs[0] = yS1; cvals[1] = -ONE; XXvecs[1] = yS0; cvals[2] = -delta; XXvecs[2] = ySd0; retval = N_VLinearCombinationVectorArray(NS, 3, cvals, XXvecs, ca_mem->ca_YS[0]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } /* Perform the actual interpolation. */ factor1 = t - t0; factor2 = factor1/delta; factor2 = factor2*factor2; factor3 = factor2*(t-t1)/delta; cvals[0] = ONE; cvals[1] = factor1; cvals[2] = factor2; cvals[3] = factor3; /* y = y0 + factor1 yd0 + factor2 * Y[0] + factor3 Y[1] */ Xvecs[0] = y0; Xvecs[1] = yd0; Xvecs[2] = ca_mem->ca_Y[0]; Xvecs[3] = ca_mem->ca_Y[1]; retval = N_VLinearCombination(4, cvals, Xvecs, y); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); /* yS = yS0 + factor1 ySd0 + factor2 * YS[0] + factor3 YS[1], if needed */ if (NS > 0) { XXvecs[0] = yS0; XXvecs[1] = ySd0; XXvecs[2] = ca_mem->ca_YS[0]; XXvecs[3] = ca_mem->ca_YS[1]; retval = N_VLinearCombinationVectorArray(NS, 4, cvals, XXvecs, yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Functions specific to Polynomial interpolation * ----------------------------------------------------------------- */ /* * CVApolynomialMalloc * * This routine allocates memory for storing information at all * intermediate points between two consecutive check points. * This data is then used to interpolate the forward solution * at any other time. */ static booleantype CVApolynomialMalloc(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; long int i, ii=0; booleantype allocOK; allocOK = SUNTRUE; ca_mem = cv_mem->cv_adj_mem; /* Allocate space for the vectors ytmp and yStmp */ ca_mem->ca_ytmp = N_VClone(cv_mem->cv_tempv); if (ca_mem->ca_ytmp == NULL) { return(SUNFALSE); } if (ca_mem->ca_IMstoreSensi) { ca_mem->ca_yStmp = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (ca_mem->ca_yStmp == NULL) { N_VDestroy(ca_mem->ca_ytmp); return(SUNFALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = ca_mem->dt_mem; for (i=0; i<=ca_mem->ca_nsteps; i++) { content = NULL; content = (PolynomialDataMem) malloc(sizeof(struct PolynomialDataMemRec)); if (content == NULL) { ii = i; allocOK = SUNFALSE; break; } content->y = N_VClone(cv_mem->cv_tempv); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } if (ca_mem->ca_IMstoreSensi) { content->yS = N_VCloneVectorArray(cv_mem->cv_Ns, cv_mem->cv_tempv); if (content->yS == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(ca_mem->ca_ytmp); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(ca_mem->ca_yStmp, cv_mem->cv_Ns); } for (i=0; icontent); N_VDestroy(content->y); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(content->yS, cv_mem->cv_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * CVApolynomialFree * * This routine frees the memeory allocated for data storage. */ static void CVApolynomialFree(CVodeMem cv_mem) { CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; long int i; ca_mem = cv_mem->cv_adj_mem; N_VDestroy(ca_mem->ca_ytmp); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(ca_mem->ca_yStmp, cv_mem->cv_Ns); } dt_mem = ca_mem->dt_mem; for (i=0; i<=ca_mem->ca_nsteps; i++) { content = (PolynomialDataMem) (dt_mem[i]->content); N_VDestroy(content->y); if (ca_mem->ca_IMstoreSensi) { N_VDestroyVectorArray(content->yS, cv_mem->cv_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } /* * CVApolynomialStorePnt ( -> IMstore ) * * This routine stores a new point y in the structure d for use * in the Polynomial interpolation. * Note that the time is already stored. */ static int CVApolynomialStorePnt(CVodeMem cv_mem, DtpntMem d) { CVadjMem ca_mem; PolynomialDataMem content; int is, retval; ca_mem = cv_mem->cv_adj_mem; content = (PolynomialDataMem) d->content; N_VScale(ONE, cv_mem->cv_zn[0], content->y); if (ca_mem->ca_IMstoreSensi) { for (is=0; iscv_Ns; is++) cv_mem->cv_cvals[is] = ONE; retval = N_VScaleVectorArray(cv_mem->cv_Ns, cv_mem->cv_cvals, cv_mem->cv_znS[0], content->yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } content->order = cv_mem->cv_qu; return(0); } /* * CVApolynomialGetY ( -> IMget ) * * This routine uses polynomial interpolation for the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB)) but * can be directly called by the user through CVodeGetAdjY. */ static int CVApolynomialGetY(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS) { CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; int flag, dir, order, i, j, is, NS, retval; long int indx, base; booleantype newpoint; realtype dt, factor; ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; /* Local value of Ns */ NS = (ca_mem->ca_IMinterpSensi && (yS != NULL)) ? cv_mem->cv_Ns : 0; /* Get the index in dt_mem */ flag = CVAfindIndex(cv_mem, t, &indx, &newpoint); if (flag != CV_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content = (PolynomialDataMem) (dt_mem[0]->content); N_VScale(ONE, content->y, y); if (NS > 0) { for (is=0; iscv_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, cv_mem->cv_cvals, content->yS, yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } return(CV_SUCCESS); } /* Scaling factor */ dt = SUNRabs(dt_mem[indx]->t - dt_mem[indx-1]->t); /* Find the direction of the forward integration */ dir = (ca_mem->ca_tfinal - ca_mem->ca_tinitial > ZERO) ? 1 : -1; /* Establish the base point depending on the integration direction. Modify the base if there are not enough points for the current order */ if (dir == 1) { base = indx; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if(indx < order) base += order-indx; } else { base = indx-1; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if (ca_mem->ca_np-indx > order) base -= indx+order-ca_mem->ca_np; } /* Recompute Y (divided differences for Newton polynomial) if needed */ if (newpoint) { /* Store 0-th order DD */ if (dir == 1) { for(j=0;j<=order;j++) { ca_mem->ca_T[j] = dt_mem[base-j]->t; content = (PolynomialDataMem) (dt_mem[base-j]->content); N_VScale(ONE, content->y, ca_mem->ca_Y[j]); if (NS > 0) { for (is=0; iscv_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, cv_mem->cv_cvals, content->yS, ca_mem->ca_YS[j]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } } else { for(j=0;j<=order;j++) { ca_mem->ca_T[j] = dt_mem[base-1+j]->t; content = (PolynomialDataMem) (dt_mem[base-1+j]->content); N_VScale(ONE, content->y, ca_mem->ca_Y[j]); if (NS > 0) { for (is=0; iscv_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, cv_mem->cv_cvals, content->yS, ca_mem->ca_YS[j]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } } /* Compute higher-order DD */ for(i=1;i<=order;i++) { for(j=order;j>=i;j--) { factor = dt/(ca_mem->ca_T[j]-ca_mem->ca_T[j-i]); N_VLinearSum(factor, ca_mem->ca_Y[j], -factor, ca_mem->ca_Y[j-1], ca_mem->ca_Y[j]); if (NS > 0) { retval = N_VLinearSumVectorArray(NS, factor, ca_mem->ca_YS[j], -factor, ca_mem->ca_YS[j-1], ca_mem->ca_YS[j]); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } } } } /* Perform the actual interpolation using nested multiplications */ cv_mem->cv_cvals[0] = ONE; for (i=0; icv_cvals[i+1] = cv_mem->cv_cvals[i] * (t-ca_mem->ca_T[i]) / dt; retval = N_VLinearCombination(order+1, cv_mem->cv_cvals, ca_mem->ca_Y, y); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); if (NS > 0) { retval = N_VLinearCombinationVectorArray(NS, order+1, cv_mem->cv_cvals, ca_mem->ca_YS, yS); if (retval != CV_SUCCESS) return (CV_VECTOROP_ERR); } return(CV_SUCCESS); } /* * ================================================================= * WRAPPERS FOR ADJOINT SYSTEM * ================================================================= */ /* * CVArhs * * This routine interfaces to the CVRhsFnB (or CVRhsFnBS) routine * provided by the user. */ static int CVArhs(realtype t, N_Vector yB, N_Vector yBdot, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; int flag, retval; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; /* Get forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) flag = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else flag = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (flag != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVODEA", "CVArhs", MSGCV_BAD_TINTERP, t); return(-1); } /* Call the user's RHS function */ if (cvB_mem->cv_f_withSensi) retval = (cvB_mem->cv_fs)(t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, yBdot, cvB_mem->cv_user_data); else retval = (cvB_mem->cv_f)(t, ca_mem->ca_ytmp, yB, yBdot, cvB_mem->cv_user_data); return(retval); } /* * CVArhsQ * * This routine interfaces to the CVQuadRhsFnB (or CVQuadRhsFnBS) routine * provided by the user. */ static int CVArhsQ(realtype t, N_Vector yB, N_Vector qBdot, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; /* int flag; */ int retval; cv_mem = (CVodeMem) cvode_mem; ca_mem = cv_mem->cv_adj_mem; cvB_mem = ca_mem->ca_bckpbCrt; /* Get forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) /* flag = */ ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else /* flag = */ ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); /* Call the user's RHS function */ if (cvB_mem->cv_fQ_withSensi) retval = (cvB_mem->cv_fQs)(t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, qBdot, cvB_mem->cv_user_data); else retval = (cvB_mem->cv_fQ)(t, ca_mem->ca_ytmp, yB, qBdot, cvB_mem->cv_user_data); return(retval); } StanHeaders/src/cvodes/cvodes_ls.c0000644000176200001440000023012613766554457016704 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation file for CVODES' linear solver interface. * * Part I contains routines for using CVSLS on forward problems. * * Part II contains wrappers for using CVSLS on adjoint * (backward) problems. *-----------------------------------------------------------------*/ #include #include #include #include "cvodes_impl.h" #include "cvodes_ls_impl.h" #include #include #include #include /* Private constants */ #define MIN_INC_MULT RCONST(1000.0) #define MAX_DQITERS 3 /* max. number of attempts to recover in DQ J*v */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /*================================================================= PRIVATE FUNCTION PROTOTYPES =================================================================*/ /* cvLsJacBWrapper and cvLsJacBSWrapper have type CVLsJacFn, and wrap around user-provided functions of type CVLsJacFnB and CVLsJacFnBS, respectively */ static int cvLsJacBWrapper(realtype t, N_Vector yB, N_Vector fyB, SUNMatrix JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int cvLsJacBSWrapper(realtype t, N_Vector yB, N_Vector fyB, SUNMatrix JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); /* cvLsPrecSetupBWrapper and cvLsPrecSetupBSWrapper have type CVLsPrecSetupFn, and wrap around user-provided functions of type CVLsPrecSetupFnB and CVLsPrecSetupFnBS, respectively */ static int cvLsPrecSetupBWrapper(realtype t, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *cvode_mem); static int cvLsPrecSetupBSWrapper(realtype t, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *cvode_mem); /* cvLsPrecSolveBWrapper and cvLsPrecSolveBSWrapper have type CVLsPrecSolveFn, and wrap around user-provided functions of type CVLsPrecSolveFnB and CVLsPrecSolveFnBS, respectively */ static int cvLsPrecSolveBWrapper(realtype t, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *cvode_mem); static int cvLsPrecSolveBSWrapper(realtype t, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *cvode_mem); /* cvLsJacTimesSetupBWrapper and cvLsJacTimesSetupBSWrapper have type CVLsJacTimesSetupFn, and wrap around user-provided functions of type CVLsJacTimesSetupFnB and CVLsJacTimesSetupFnBS, respectively */ static int cvLsJacTimesSetupBWrapper(realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem); static int cvLsJacTimesSetupBSWrapper(realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem); /* cvLsJacTimesVecBWrapper and cvLsJacTimesVecBSWrapper have type CVLsJacTimesVecFn, and wrap around user-provided functions of type CVLsJacTimesVecFnB and CVLsJacTimesVecFnBS, respectively */ static int cvLsJacTimesVecBWrapper(N_Vector vB, N_Vector JvB, realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem, N_Vector tmpB); static int cvLsJacTimesVecBSWrapper(N_Vector vB, N_Vector JvB, realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem, N_Vector tmpB); /*================================================================ PART I - forward problems ================================================================*/ /*----------------------------------------------------------------- CVSLS Exported functions -- Required -----------------------------------------------------------------*/ /*--------------------------------------------------------------- CVodeSetLinearSolver specifies the linear solver ---------------------------------------------------------------*/ int CVodeSetLinearSolver(void *cvode_mem, SUNLinearSolver LS, SUNMatrix A) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval, LSType; /* Return immediately if either cvode_mem or LS inputs are NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSLS", "CVodeSetLinearSolver", MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } if (LS == NULL) { cvProcessError(NULL, CVLS_ILL_INPUT, "CVSLS", "CVodeSetLinearSolver", "LS must be non-NULL"); return(CVLS_ILL_INPUT); } cv_mem = (CVodeMem) cvode_mem; /* Test if solver is compatible with LS interface */ if ( (LS->ops->gettype == NULL) || (LS->ops->initialize == NULL) || (LS->ops->setup == NULL) || (LS->ops->solve == NULL) ) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetLinearSolver", "LS object is missing a required operation"); return(CVLS_ILL_INPUT); } /* Test if vector is compatible with LS interface */ if ( (cv_mem->cv_tempv->ops->nvconst == NULL) || (cv_mem->cv_tempv->ops->nvdotprod == NULL) ) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetLinearSolver", MSG_LS_BAD_NVECTOR); return(CVLS_ILL_INPUT); } /* Retrieve the LS type */ LSType = SUNLinSolGetType(LS); /* Check for compatible LS type, matrix and "atimes" support */ if ((LSType == SUNLINEARSOLVER_ITERATIVE) && (LS->ops->setatimes == NULL)) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "CVodeSetLinearSolver", "Incompatible inputs: iterative LS must support ATimes routine"); return(CVLS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_DIRECT) && (A == NULL)) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "CVodeSetLinearSolver", "Incompatible inputs: direct LS requires non-NULL matrix"); return(CVLS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) && (A == NULL)) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVLS", "CVodeSetLinearSolver", "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); return(CVLS_ILL_INPUT); } /* free any existing system solver attached to CVode */ if (cv_mem->cv_lfree) cv_mem->cv_lfree(cv_mem); /* Set four main system linear solver function fields in cv_mem */ cv_mem->cv_linit = cvLsInitialize; cv_mem->cv_lsetup = cvLsSetup; cv_mem->cv_lsolve = cvLsSolve; cv_mem->cv_lfree = cvLsFree; /* Allocate memory for CVLsMemRec */ cvls_mem = NULL; cvls_mem = (CVLsMem) malloc(sizeof(struct CVLsMemRec)); if (cvls_mem == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSLS", "CVodeSetLinearSolver", MSG_LS_MEM_FAIL); return(CVLS_MEM_FAIL); } memset(cvls_mem, 0, sizeof(struct CVLsMemRec)); /* set SUNLinearSolver pointer */ cvls_mem->LS = LS; /* Set defaults for Jacobian-related fields */ if (A != NULL) { cvls_mem->jacDQ = SUNTRUE; cvls_mem->jac = cvLsDQJac; cvls_mem->J_data = cv_mem; } else { cvls_mem->jacDQ = SUNFALSE; cvls_mem->jac = NULL; cvls_mem->J_data = NULL; } cvls_mem->jtimesDQ = SUNTRUE; cvls_mem->jtsetup = NULL; cvls_mem->jtimes = cvLsDQJtimes; cvls_mem->jt_data = cv_mem; /* Set defaults for preconditioner-related fields */ cvls_mem->pset = NULL; cvls_mem->psolve = NULL; cvls_mem->pfree = NULL; cvls_mem->P_data = cv_mem->cv_user_data; /* Initialize counters */ cvLsInitializeCounters(cvls_mem); /* Set default values for the rest of the LS parameters */ cvls_mem->msbj = CVLS_MSBJ; cvls_mem->jbad = SUNTRUE; cvls_mem->eplifac = CVLS_EPLIN; cvls_mem->last_flag = CVLS_SUCCESS; /* If LS supports ATimes, attach CVLs routine */ if (LS->ops->setatimes) { retval = SUNLinSolSetATimes(LS, cv_mem, cvLsATimes); if (retval != SUNLS_SUCCESS) { cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVSLS", "CVodeSetLinearSolver", "Error in calling SUNLinSolSetATimes"); free(cvls_mem); cvls_mem = NULL; return(CVLS_SUNLS_FAIL); } } /* If LS supports preconditioning, initialize pset/psol to NULL */ if (LS->ops->setpreconditioner) { retval = SUNLinSolSetPreconditioner(LS, cv_mem, NULL, NULL); if (retval != SUNLS_SUCCESS) { cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVSLS", "CVodeSetLinearSolver", "Error in calling SUNLinSolSetPreconditioner"); free(cvls_mem); cvls_mem = NULL; return(CVLS_SUNLS_FAIL); } } /* When using a non-NULL SUNMatrix object, store pointer to A and create saved_J */ if (A != NULL) { cvls_mem->A = A; cvls_mem->savedJ = SUNMatClone(A); if (cvls_mem->savedJ == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSLS", "CVodeSetLinearSolver", MSG_LS_MEM_FAIL); free(cvls_mem); cvls_mem = NULL; return(CVLS_MEM_FAIL); } } /* Allocate memory for ytemp and x */ cvls_mem->ytemp = N_VClone(cv_mem->cv_tempv); if (cvls_mem->ytemp == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSLS", "CVodeSetLinearSolver", MSG_LS_MEM_FAIL); SUNMatDestroy(cvls_mem->savedJ); free(cvls_mem); cvls_mem = NULL; return(CVLS_MEM_FAIL); } cvls_mem->x = N_VClone(cv_mem->cv_tempv); if (cvls_mem->x == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSLS", "CVodeSetLinearSolver", MSG_LS_MEM_FAIL); SUNMatDestroy(cvls_mem->savedJ); N_VDestroy(cvls_mem->ytemp); free(cvls_mem); cvls_mem = NULL; return(CVLS_MEM_FAIL); } /* For iterative LS, compute sqrtN from a dot product */ if ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) { N_VConst(ONE, cvls_mem->ytemp); cvls_mem->sqrtN = SUNRsqrt( N_VDotProd(cvls_mem->ytemp, cvls_mem->ytemp) ); } /* Attach linear solver memory to integrator memory */ cv_mem->cv_lmem = cvls_mem; return(CVLS_SUCCESS); } /*----------------------------------------------------------------- CVSLS Exported functions -- Optional input/output -----------------------------------------------------------------*/ /* CVodeSetJacFn specifies the Jacobian function. */ int CVodeSetJacFn(void *cvode_mem, CVLsJacFn jac) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "CVodeSetJacFn", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* return with failure if jac cannot be used */ if ((jac != NULL) && (cvls_mem->A == NULL)) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetJacFn", "Jacobian routine cannot be supplied for NULL SUNMatrix"); return(CVLS_ILL_INPUT); } /* set Jacobian routine pointer, and update relevant flags */ if (jac != NULL) { cvls_mem->jacDQ = SUNFALSE; cvls_mem->jac = jac; cvls_mem->J_data = cv_mem->cv_user_data; } else { cvls_mem->jacDQ = SUNTRUE; cvls_mem->jac = cvLsDQJac; cvls_mem->J_data = cv_mem; } return(CVLS_SUCCESS); } /* CVodeSetEpsLin specifies the nonlinear -> linear tolerance scale factor */ int CVodeSetEpsLin(void *cvode_mem, realtype eplifac) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "CVodeSetEpsLin", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* Check for legal eplifac */ if(eplifac < ZERO) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetEpsLin", MSG_LS_BAD_EPLIN); return(CVLS_ILL_INPUT); } cvls_mem->eplifac = (eplifac == ZERO) ? CVLS_EPLIN : eplifac; return(CVLS_SUCCESS); } /* CVodeSetMaxStepsBetweenJac specifies the maximum number of time steps to wait before recomputing the Jacobian matrix and/or preconditioner */ int CVodeSetMaxStepsBetweenJac(void *cvode_mem, long int msbj) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; store input and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeSetMaxStepsBetweenJac", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); cvls_mem->msbj = (msbj <= ZERO) ? CVLS_MSBJ : msbj; return(CVLS_SUCCESS); } /* CVodeSetPreconditioner specifies the user-supplied preconditioner setup and solve routines */ int CVodeSetPreconditioner(void *cvode_mem, CVLsPrecSetupFn psetup, CVLsPrecSolveFn psolve) { CVodeMem cv_mem; CVLsMem cvls_mem; PSetupFn cvls_psetup; PSolveFn cvls_psolve; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "CVodeSetPreconditioner", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* store function pointers for user-supplied routines in CVLs interface */ cvls_mem->pset = psetup; cvls_mem->psolve = psolve; /* issue error if LS object does not allow user-supplied preconditioning */ if (cvls_mem->LS->ops->setpreconditioner == NULL) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetPreconditioner", "SUNLinearSolver object does not support user-supplied preconditioning"); return(CVLS_ILL_INPUT); } /* notify iterative linear solver to call CVLs interface routines */ cvls_psetup = (psetup == NULL) ? NULL : cvLsPSetup; cvls_psolve = (psolve == NULL) ? NULL : cvLsPSolve; retval = SUNLinSolSetPreconditioner(cvls_mem->LS, cv_mem, cvls_psetup, cvls_psolve); if (retval != SUNLS_SUCCESS) { cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVSLS", "CVLsSetPreconditioner", "Error in calling SUNLinSolSetPreconditioner"); return(CVLS_SUNLS_FAIL); } return(CVLS_SUCCESS); } /* CVodeSetJacTimes specifies the user-supplied Jacobian-vector product setup and multiply routines */ int CVodeSetJacTimes(void *cvode_mem, CVLsJacTimesSetupFn jtsetup, CVLsJacTimesVecFn jtimes) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "CVodeSetJacTimes", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* issue error if LS object does not allow user-supplied ATimes */ if (cvls_mem->LS->ops->setatimes == NULL) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetJacTimes", "SUNLinearSolver object does not support user-supplied ATimes routine"); return(CVLS_ILL_INPUT); } /* store function pointers for user-supplied routines in CVLs interface (NULL jtimes implies use of DQ default) */ if (jtimes != NULL) { cvls_mem->jtimesDQ = SUNFALSE; cvls_mem->jtsetup = jtsetup; cvls_mem->jtimes = jtimes; cvls_mem->jt_data = cv_mem->cv_user_data; } else { cvls_mem->jtimesDQ = SUNTRUE; cvls_mem->jtsetup = NULL; cvls_mem->jtimes = cvLsDQJtimes; cvls_mem->jt_data = cv_mem; } return(CVLS_SUCCESS); } /* CVodeGetLinWorkSpace returns the length of workspace allocated for the CVLS linear solver interface */ int CVodeGetLinWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { CVodeMem cv_mem; CVLsMem cvls_mem; sunindextype lrw1, liw1; long int lrw, liw; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetLinWorkSpace", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* start with fixed sizes plus vector/matrix pointers */ *lenrwLS = 2; *leniwLS = 30; /* add NVector sizes */ if (cv_mem->cv_tempv->ops->nvspace) { N_VSpace(cv_mem->cv_tempv, &lrw1, &liw1); *lenrwLS += 2*lrw1; *leniwLS += 2*liw1; } /* add SUNMatrix size (only account for the one owned by Ls interface) */ if (cvls_mem->savedJ) if (cvls_mem->savedJ->ops->space) { retval = SUNMatSpace(cvls_mem->savedJ, &lrw, &liw); if (retval == 0) { *lenrwLS += lrw; *leniwLS += liw; } } /* add LS sizes */ if (cvls_mem->LS->ops->space) { retval = SUNLinSolSpace(cvls_mem->LS, &lrw, &liw); if (retval == 0) { *lenrwLS += lrw; *leniwLS += liw; } } return(CVLS_SUCCESS); } /* CVodeGetNumJacEvals returns the number of Jacobian evaluations */ int CVodeGetNumJacEvals(void *cvode_mem, long int *njevals) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumJacEvals", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *njevals = cvls_mem->nje; return(CVLS_SUCCESS); } /* CVodeGetNumLinRhsEvals returns the number of calls to the ODE function needed for the DQ Jacobian approximation or J*v product approximation */ int CVodeGetNumLinRhsEvals(void *cvode_mem, long int *nfevalsLS) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumLinRhsEvals", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *nfevalsLS = cvls_mem->nfeDQ; return(CVLS_SUCCESS); } /* CVodeGetNumPrecEvals returns the number of calls to the user- or CVode-supplied preconditioner setup routine */ int CVodeGetNumPrecEvals(void *cvode_mem, long int *npevals) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumPrecEvals", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *npevals = cvls_mem->npe; return(CVLS_SUCCESS); } /* CVodeGetNumPrecSolves returns the number of calls to the user- or CVode-supplied preconditioner solve routine */ int CVodeGetNumPrecSolves(void *cvode_mem, long int *npsolves) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumPrecSolves", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *npsolves = cvls_mem->nps; return(CVLS_SUCCESS); } /* CVodeGetNumLinIters returns the number of linear iterations (if accessible from the LS object) */ int CVodeGetNumLinIters(void *cvode_mem, long int *nliters) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumLinIters", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *nliters = cvls_mem->nli; return(CVLS_SUCCESS); } /* CVodeGetNumLinConvFails returns the number of linear solver convergence failures (as reported by the LS object) */ int CVodeGetNumLinConvFails(void *cvode_mem, long int *nlcfails) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumLinConvFails", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *nlcfails = cvls_mem->ncfl; return(CVLS_SUCCESS); } /* CVodeGetNumJTSetupEvals returns the number of calls to the user-supplied Jacobian-vector product setup routine */ int CVodeGetNumJTSetupEvals(void *cvode_mem, long int *njtsetups) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumJTSetupEvals", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *njtsetups = cvls_mem->njtsetup; return(CVLS_SUCCESS); } /* CVodeGetNumJtimesEvals returns the number of calls to the Jacobian-vector product multiply routine */ int CVodeGetNumJtimesEvals(void *cvode_mem, long int *njvevals) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetNumJtimesEvals", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *njvevals = cvls_mem->njtimes; return(CVLS_SUCCESS); } /* CVodeGetLastLinFlag returns the last flag set in a CVLS function */ int CVodeGetLastLinFlag(void *cvode_mem, long int *flag) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure; set output value and return */ retval = cvLs_AccessLMem(cvode_mem, "CVodeGetLastLinFlag", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); *flag = cvls_mem->last_flag; return(CVLS_SUCCESS); } /* CVodeGetLinReturnFlagName translates from the integer error code returned by an CVLs routine to the corresponding string equivalent for that flag */ char *CVodeGetLinReturnFlagName(long int flag) { char *name = (char *)malloc(30*sizeof(char)); switch(flag) { case CVLS_SUCCESS: sprintf(name,"CVLS_SUCCESS"); break; case CVLS_MEM_NULL: sprintf(name,"CVLS_MEM_NULL"); break; case CVLS_LMEM_NULL: sprintf(name,"CVLS_LMEM_NULL"); break; case CVLS_ILL_INPUT: sprintf(name,"CVLS_ILL_INPUT"); break; case CVLS_MEM_FAIL: sprintf(name,"CVLS_MEM_FAIL"); break; case CVLS_PMEM_NULL: sprintf(name,"CVLS_PMEM_NULL"); break; case CVLS_JACFUNC_UNRECVR: sprintf(name,"CVLS_JACFUNC_UNRECVR"); break; case CVLS_JACFUNC_RECVR: sprintf(name,"CVLS_JACFUNC_RECVR"); break; case CVLS_SUNMAT_FAIL: sprintf(name,"CVLS_SUNMAT_FAIL"); break; case CVLS_SUNLS_FAIL: sprintf(name,"CVLS_SUNLS_FAIL"); break; case CVLS_NO_ADJ: sprintf(name,"CVLS_NO_ADJ"); break; case CVLS_LMEMB_NULL: sprintf(name,"CVLS_LMEMB_NULL"); break; default: sprintf(name,"NONE"); } return(name); } /*----------------------------------------------------------------- CVSLS private functions -----------------------------------------------------------------*/ /*----------------------------------------------------------------- cvLsATimes This routine generates the matrix-vector product z = Mv, where M = I - gamma*J. The product J*v is obtained by calling the jtimes routine. It is then scaled by -gamma and added to v to obtain M*v. The return value is the same as the value returned by jtimes -- 0 if successful, nonzero otherwise. -----------------------------------------------------------------*/ int cvLsATimes(void *cvode_mem, N_Vector v, N_Vector z) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "cvLsATimes", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* call Jacobian-times-vector product routine (either user-supplied or internal DQ) */ retval = cvls_mem->jtimes(v, z, cv_mem->cv_tn, cvls_mem->ycur, cvls_mem->fcur, cvls_mem->jt_data, cvls_mem->ytemp); cvls_mem->njtimes++; if (retval != 0) return(retval); /* add contribution from identity matrix */ N_VLinearSum(ONE, v, -cv_mem->cv_gamma, z, z); return(0); } /*--------------------------------------------------------------- cvLsPSetup: This routine interfaces between the generic iterative linear solvers and the user's psetup routine. It passes to psetup all required state information from cvode_mem. Its return value is the same as that returned by psetup. Note that the generic iterative linear solvers guarantee that cvLsPSetup will only be called in the case that the user's psetup routine is non-NULL. ---------------------------------------------------------------*/ int cvLsPSetup(void *cvode_mem) { int retval; CVodeMem cv_mem; CVLsMem cvls_mem; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "cvLsPSetup", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* Call user pset routine to update preconditioner and possibly reset jcur (pass !jbad as update suggestion) */ retval = cvls_mem->pset(cv_mem->cv_tn, cvls_mem->ycur, cvls_mem->fcur, !(cvls_mem->jbad), &cv_mem->cv_jcur, cv_mem->cv_gamma, cvls_mem->P_data); return(retval); } /*----------------------------------------------------------------- cvLsPSolve This routine interfaces between the generic SUNLinSolSolve routine and the user's psolve routine. It passes to psolve all required state information from cvode_mem. Its return value is the same as that returned by psolve. Note that the generic SUNLinSol solver guarantees that cvLsPSolve will not be called in the case in which preconditioning is not done. This is the only case in which the user's psolve routine is allowed to be NULL. -----------------------------------------------------------------*/ int cvLsPSolve(void *cvode_mem, N_Vector r, N_Vector z, realtype tol, int lr) { CVodeMem cv_mem; CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "cvLsPSolve", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* call the user-supplied psolve routine, and accumulate count */ retval = cvls_mem->psolve(cv_mem->cv_tn, cvls_mem->ycur, cvls_mem->fcur, r, z, cv_mem->cv_gamma, tol, lr, cvls_mem->P_data); cvls_mem->nps++; return(retval); } /*----------------------------------------------------------------- cvLsDQJac This routine is a wrapper for the Dense and Band implementations of the difference quotient Jacobian approximation routines. ---------------------------------------------------------------*/ int cvLsDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, void *cvode_mem, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { CVodeMem cv_mem; int retval; /* access CVodeMem structure */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSLS", "cvLsDQJac", MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* verify that Jac is non-NULL */ if (Jac == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSLS", "cvLsDQJac", MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } /* Verify that N_Vector supports required operations */ if (cv_mem->cv_tempv->ops->nvcloneempty == NULL || cv_mem->cv_tempv->ops->nvwrmsnorm == NULL || cv_mem->cv_tempv->ops->nvlinearsum == NULL || cv_mem->cv_tempv->ops->nvdestroy == NULL || cv_mem->cv_tempv->ops->nvscale == NULL || cv_mem->cv_tempv->ops->nvgetarraypointer == NULL || cv_mem->cv_tempv->ops->nvsetarraypointer == NULL) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "cvLsDQJac", MSG_LS_BAD_NVECTOR); return(CVLS_ILL_INPUT); } /* Call the matrix-structure-specific DQ approximation routine */ if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { retval = cvLsDenseDQJac(t, y, fy, Jac, cv_mem, tmp1); } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { retval = cvLsBandDQJac(t, y, fy, Jac, cv_mem, tmp1, tmp2); } else { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "cvLsDQJac", "unrecognized matrix type for cvLsDQJac"); retval = CVLS_ILL_INPUT; } return(retval); } /*----------------------------------------------------------------- cvLsDenseDQJac This routine generates a dense difference quotient approximation to the Jacobian of f(t,y). It assumes that a dense SUNMatrix is stored column-wise, and that elements within each column are contiguous. The address of the jth column of J is obtained via the accessor function SUNDenseMatrix_Column, and this pointer is associated with an N_Vector using the N_VSetArrayPointer function. Finally, the actual computation of the jth column of the Jacobian is done with a call to N_VLinearSum. -----------------------------------------------------------------*/ int cvLsDenseDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, CVodeMem cv_mem, N_Vector tmp1) { realtype fnorm, minInc, inc, inc_inv, yjsaved, srur, conj; realtype *y_data, *ewt_data, *cns_data; N_Vector ftemp, jthCol; sunindextype j, N; CVLsMem cvls_mem; int retval = 0; /* access LsMem interface structure */ cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* access matrix dimension */ N = SUNDenseMatrix_Rows(Jac); /* Rename work vector for readibility */ ftemp = tmp1; /* Create an empty vector for matrix column calculations */ jthCol = N_VCloneEmpty(tmp1); /* Obtain pointers to the data for ewt, y */ ewt_data = N_VGetArrayPointer(cv_mem->cv_ewt); y_data = N_VGetArrayPointer(y); if (cv_mem->cv_constraints != NULL) cns_data = N_VGetArrayPointer(cv_mem->cv_constraints); /* Set minimum increment based on uround and norm of f */ srur = SUNRsqrt(cv_mem->cv_uround); fnorm = N_VWrmsNorm(fy, cv_mem->cv_ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * SUNRabs(cv_mem->cv_h) * cv_mem->cv_uround * N * fnorm) : ONE; for (j = 0; j < N; j++) { /* Generate the jth col of J(tn,y) */ N_VSetArrayPointer(SUNDenseMatrix_Column(Jac,j), jthCol); yjsaved = y_data[j]; inc = SUNMAX(srur*SUNRabs(yjsaved), minInc/ewt_data[j]); /* Adjust sign(inc) if y_j has an inequality constraint. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((yjsaved+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yjsaved+inc)*conj <= ZERO) inc = -inc;} } y_data[j] += inc; retval = cv_mem->cv_f(t, y, ftemp, cv_mem->cv_user_data); cvls_mem->nfeDQ++; if (retval != 0) break; y_data[j] = yjsaved; inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fy, jthCol); } /* Destroy jthCol vector */ N_VSetArrayPointer(NULL, jthCol); /* SHOULDN'T BE NEEDED */ N_VDestroy(jthCol); return(retval); } /*----------------------------------------------------------------- cvLsBandDQJac This routine generates a banded difference quotient approximation to the Jacobian of f(t,y). It assumes that a band SUNMatrix is stored column-wise, and that elements within each column are contiguous. This makes it possible to get the address of a column of J via the accessor function SUNBandMatrix_Column, and to write a simple for loop to set each of the elements of a column in succession. -----------------------------------------------------------------*/ int cvLsBandDQJac(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, CVodeMem cv_mem, N_Vector tmp1, N_Vector tmp2) { N_Vector ftemp, ytemp; realtype fnorm, minInc, inc, inc_inv, srur, conj; realtype *col_j, *ewt_data, *fy_data, *ftemp_data; realtype *y_data, *ytemp_data, *cns_data; sunindextype group, i, j, width, ngroups, i1, i2; sunindextype N, mupper, mlower; CVLsMem cvls_mem; int retval = 0; /* access LsMem interface structure */ cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* access matrix dimensions */ N = SUNBandMatrix_Columns(Jac); mupper = SUNBandMatrix_UpperBandwidth(Jac); mlower = SUNBandMatrix_LowerBandwidth(Jac); /* Rename work vectors for use as temporary values of y and f */ ftemp = tmp1; ytemp = tmp2; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp */ ewt_data = N_VGetArrayPointer(cv_mem->cv_ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); if (cv_mem->cv_constraints != NULL) cns_data = N_VGetArrayPointer(cv_mem->cv_constraints); /* Load ytemp with y = predicted y vector */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f */ srur = SUNRsqrt(cv_mem->cv_uround); fnorm = N_VWrmsNorm(fy, cv_mem->cv_ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * SUNRabs(cv_mem->cv_h) * cv_mem->cv_uround * N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = SUNMIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all y_j in group */ for(j=group-1; j < N; j+=width) { inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); /* Adjust sign(inc) if yj has an inequality constraint. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((ytemp_data[j]+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((ytemp_data[j]+inc)*conj <= ZERO) inc = -inc;} } ytemp_data[j] += inc; } /* Evaluate f with incremented y */ retval = cv_mem->cv_f(cv_mem->cv_tn, ytemp, ftemp, cv_mem->cv_user_data); cvls_mem->nfeDQ++; if (retval != 0) break; /* Restore ytemp, then form and load difference quotients */ for (j=group-1; j < N; j+=width) { ytemp_data[j] = y_data[j]; col_j = SUNBandMatrix_Column(Jac, j); inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); /* Adjust sign(inc) as before. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((ytemp_data[j]+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((ytemp_data[j]+inc)*conj <= ZERO) inc = -inc;} } inc_inv = ONE/inc; i1 = SUNMAX(0, j-mupper); i2 = SUNMIN(j+mlower, N-1); for (i=i1; i <= i2; i++) SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(retval); } /*----------------------------------------------------------------- cvLsDQJtimes This routine generates a difference quotient approximation to the Jacobian times vector f_y(t,y) * v. The approximation is Jv = [f(y + v*sig) - f(y)]/sig, where sig = 1 / ||v||_WRMS, i.e. the WRMS norm of v*sig is 1. -----------------------------------------------------------------*/ int cvLsDQJtimes(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *cvode_mem, N_Vector work) { CVodeMem cv_mem; CVLsMem cvls_mem; realtype sig, siginv; int iter, retval; /* access CVLsMem structure */ retval = cvLs_AccessLMem(cvode_mem, "cvLsDQJtimes", &cv_mem, &cvls_mem); if (retval != CVLS_SUCCESS) return(retval); /* Initialize perturbation to 1/||v|| */ sig = ONE/N_VWrmsNorm(v, cv_mem->cv_ewt); for (iter=0; itercv_f(t, work, Jv, cv_mem->cv_user_data); cvls_mem->nfeDQ++; if (retval == 0) break; if (retval < 0) return(-1); /* If f failed recoverably, shrink sig and retry */ sig *= PT25; } /* If retval still isn't 0, return with a recoverable failure */ if (retval > 0) return(+1); /* Replace Jv by (Jv - fy)/sig */ siginv = ONE/sig; N_VLinearSum(siginv, Jv, -siginv, fy, Jv); return(0); } /*----------------------------------------------------------------- cvLsInitialize This routine performs remaining initializations specific to the iterative linear solver interface (and solver itself) -----------------------------------------------------------------*/ int cvLsInitialize(CVodeMem cv_mem) { CVLsMem cvls_mem; int retval; /* access CVLsMem structure */ if (cv_mem->cv_lmem==NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSLS", "cvLsInitialize", MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Test for valid combinations of matrix & Jacobian routines: */ if (cvls_mem->A == NULL) { /* If SUNMatrix A is NULL: ensure 'jac' function pointer is NULL */ cvls_mem->jacDQ = SUNFALSE; cvls_mem->jac = NULL; cvls_mem->J_data = NULL; } else if (cvls_mem->jacDQ) { /* If A is non-NULL, and 'jac' is not user-supplied: - if A is dense or band, ensure that our DQ approx. is used - otherwise => error */ retval = 0; if (cvls_mem->A->ops->getid) { if ( (SUNMatGetID(cvls_mem->A) == SUNMATRIX_DENSE) || (SUNMatGetID(cvls_mem->A) == SUNMATRIX_BAND) ) { cvls_mem->jac = cvLsDQJac; cvls_mem->J_data = cv_mem; } else { retval++; } } else { retval++; } if (retval) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "cvLsInitialize", "No Jacobian constructor available for SUNMatrix type"); cvls_mem->last_flag = CVLS_ILL_INPUT; return(CVLS_ILL_INPUT); } } else { /* If A is non-NULL, and 'jac' is user-supplied, reset J_data pointer (just in case) */ cvls_mem->J_data = cv_mem->cv_user_data; } /* reset counters */ cvLsInitializeCounters(cvls_mem); /* Set Jacobian-related fields, based on jtimesDQ */ if (cvls_mem->jtimesDQ) { cvls_mem->jtsetup = NULL; cvls_mem->jtimes = cvLsDQJtimes; cvls_mem->jt_data = cv_mem; } else { cvls_mem->jt_data = cv_mem->cv_user_data; } /* if A is NULL and psetup is not present, then cvLsSetup does not need to be called, so set the lsetup function to NULL */ if ( (cvls_mem->A == NULL) && (cvls_mem->pset == NULL) ) cv_mem->cv_lsetup = NULL; /* Call LS initialize routine, and return result */ cvls_mem->last_flag = SUNLinSolInitialize(cvls_mem->LS); return(cvls_mem->last_flag); } /*----------------------------------------------------------------- cvLsSetup This conditionally calls the LS 'setup' routine. When using a SUNMatrix object, this determines whether to update a Jacobian matrix (or use a stored version), based on heuristics regarding previous convergence issues, the number of time steps since it was last updated, etc.; it then creates the system matrix from this, the 'gamma' factor and the identity matrix, A = I-gamma*J. This routine then calls the LS 'setup' routine with A. -----------------------------------------------------------------*/ int cvLsSetup(CVodeMem cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3) { CVLsMem cvls_mem; realtype dgamma; int retval; /* access CVLsMem structure */ if (cv_mem->cv_lmem==NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSLS", "cvLsSetup", MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Set CVLs N_Vector pointers to current solution and rhs */ cvls_mem->ycur = ypred; cvls_mem->fcur = fpred; /* Use nst, gamma/gammap, and convfail to set J/P eval. flag jok */ dgamma = SUNRabs((cv_mem->cv_gamma/cv_mem->cv_gammap) - ONE); cvls_mem->jbad = (cv_mem->cv_nst == 0) || (cv_mem->cv_nst > cvls_mem->nstlj + cvls_mem->msbj) || ((convfail == CV_FAIL_BAD_J) && (dgamma < CVLS_DGMAX)) || (convfail == CV_FAIL_OTHER); /* If using a NULL SUNMatrix, set jcur to jbad; otherwise update J as appropriate */ if (cvls_mem->A == NULL) { *jcurPtr = cvls_mem->jbad; } else { /* If jbad = SUNFALSE, use saved copy of J */ if (!cvls_mem->jbad) { *jcurPtr = SUNFALSE; retval = SUNMatCopy(cvls_mem->savedJ, cvls_mem->A); if (retval) { cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVSLS", "cvLsSetup", MSG_LS_SUNMAT_FAILED); cvls_mem->last_flag = CVLS_SUNMAT_FAIL; return(cvls_mem->last_flag); } /* If jbad = SUNTRUE, call jac routine for new J value */ } else { cvls_mem->nje++; cvls_mem->nstlj = cv_mem->cv_nst; *jcurPtr = SUNTRUE; retval = SUNMatZero(cvls_mem->A); if (retval) { cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVSLS", "cvLsSetup", MSG_LS_SUNMAT_FAILED); cvls_mem->last_flag = CVLS_SUNMAT_FAIL; return(cvls_mem->last_flag); } retval = cvls_mem->jac(cv_mem->cv_tn, ypred, fpred, cvls_mem->A, cvls_mem->J_data, vtemp1, vtemp2, vtemp3); if (retval < 0) { cvProcessError(cv_mem, CVLS_JACFUNC_UNRECVR, "CVSLS", "cvLsSetup", MSG_LS_JACFUNC_FAILED); cvls_mem->last_flag = CVLS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { cvls_mem->last_flag = CVLS_JACFUNC_RECVR; return(1); } retval = SUNMatCopy(cvls_mem->A, cvls_mem->savedJ); if (retval) { cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVSLS", "cvLsSetup", MSG_LS_SUNMAT_FAILED); cvls_mem->last_flag = CVLS_SUNMAT_FAIL; return(cvls_mem->last_flag); } } /* Scale and add I to get A = I - gamma*J */ retval = SUNMatScaleAddI(-cv_mem->cv_gamma, cvls_mem->A); if (retval) { cvProcessError(cv_mem, CVLS_SUNMAT_FAIL, "CVSLS", "cvLsSetup", MSG_LS_SUNMAT_FAILED); cvls_mem->last_flag = CVLS_SUNMAT_FAIL; return(cvls_mem->last_flag); } } /* Call LS setup routine -- the LS may call cvLsPSetup, who will pass the heuristic suggestions above to the user code(s) */ cvls_mem->last_flag = SUNLinSolSetup(cvls_mem->LS, cvls_mem->A); /* If the SUNMatrix was NULL, update heuristics flags */ if (cvls_mem->A == NULL) { /* If user set jcur to SUNTRUE, increment npe and save nst value */ if (*jcurPtr) { cvls_mem->npe++; cvls_mem->nstlj = cv_mem->cv_nst; } /* Update jcur flag if we suggested an update */ if (cvls_mem->jbad) *jcurPtr = SUNTRUE; } return(cvls_mem->last_flag); } /*----------------------------------------------------------------- cvLsSolve This routine interfaces between CVode and the generic SUNLinearSolver object LS, by setting the appropriate tolerance and scaling vectors, calling the solver, and accumulating statistics from the solve for use/reporting by CVode. -----------------------------------------------------------------*/ int cvLsSolve(CVodeMem cv_mem, N_Vector b, N_Vector weight, N_Vector ynow, N_Vector fnow) { CVLsMem cvls_mem; realtype bnorm, deltar, delta, w_mean; int curiter, nli_inc, retval, LSType; booleantype do_sensi_sim, do_sensi_stg, do_sensi_stg1; /* access CVLsMem structure */ if (cv_mem->cv_lmem==NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSLS", "cvLsSolve", MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Retrieve the LS type */ LSType = SUNLinSolGetType(cvls_mem->LS); /* are we computing sensitivities and with which approach? */ do_sensi_sim = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_SIMULTANEOUS)); do_sensi_stg = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED)); do_sensi_stg1 = (cv_mem->cv_sensi && (cv_mem->cv_ism==CV_STAGGERED1)); /* get current nonlinear solver iteration */ if (do_sensi_sim) retval = SUNNonlinSolGetCurIter(cv_mem->NLSsim, &curiter); else if (do_sensi_stg && cv_mem->sens_solve) retval = SUNNonlinSolGetCurIter(cv_mem->NLSstg, &curiter); else if (do_sensi_stg1 && cv_mem->sens_solve) retval = SUNNonlinSolGetCurIter(cv_mem->NLSstg1, &curiter); else retval = SUNNonlinSolGetCurIter(cv_mem->NLS, &curiter); /* If the linear solver is iterative: test norm(b), if small, return x = 0 or x = b; set linear solver tolerance (in left/right scaled 2-norm) */ if ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) { deltar = cvls_mem->eplifac * cv_mem->cv_tq[4]; bnorm = N_VWrmsNorm(b, weight); if (bnorm <= deltar) { if (curiter > 0) N_VConst(ZERO, b); cvls_mem->last_flag = CVLS_SUCCESS; return(cvls_mem->last_flag); } delta = deltar * cvls_mem->sqrtN; } else { delta = ZERO; } /* Set vectors ycur and fcur for use by the Atimes and Psolve interface routines */ cvls_mem->ycur = ynow; cvls_mem->fcur = fnow; /* Set initial guess x = 0 to LS */ N_VConst(ZERO, cvls_mem->x); /* Set scaling vectors for LS to use (if applicable) */ if (cvls_mem->LS->ops->setscalingvectors) { retval = SUNLinSolSetScalingVectors(cvls_mem->LS, weight, weight); if (retval != SUNLS_SUCCESS) { cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVSLS", "cvLsSolve", "Error in calling SUNLinSolSetScalingVectors"); cvls_mem->last_flag = CVLS_SUNLS_FAIL; return(cvls_mem->last_flag); } /* If solver is iterative and does not support scaling vectors, update the tolerance in an attempt to account for weight vector. We make the following assumptions: 1. w_i = w_mean, for i=0,...,n-1 (i.e. the weights are homogeneous) 2. the linear solver uses a basic 2-norm to measure convergence Hence (using the notation from sunlinsol_spgmr.h, with S = diag(w)), || bbar - Abar xbar ||_2 < tol <=> || S b - S A x ||_2 < tol <=> || S (b - A x) ||_2 < tol <=> \sum_{i=0}^{n-1} (w_i (b - A x)_i)^2 < tol^2 <=> w_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / w_mean^2 <=> || b - A x ||_2 < tol / w_mean So we compute w_mean = ||w||_RMS = ||w||_2 / sqrt(n), and scale the desired tolerance accordingly. */ } else if ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) { w_mean = SUNRsqrt( N_VDotProd(weight, weight) ) / cvls_mem->sqrtN; delta /= w_mean; } /* If a user-provided jtsetup routine is supplied, call that here */ if (cvls_mem->jtsetup) { cvls_mem->last_flag = cvls_mem->jtsetup(cv_mem->cv_tn, ynow, fnow, cvls_mem->jt_data); cvls_mem->njtsetup++; if (cvls_mem->last_flag != 0) { cvProcessError(cv_mem, retval, "CVSLS", "cvLsSolve", MSG_LS_JTSETUP_FAILED); return(cvls_mem->last_flag); } } /* Call solver, and copy x to b */ retval = SUNLinSolSolve(cvls_mem->LS, cvls_mem->A, cvls_mem->x, b, delta); N_VScale(ONE, cvls_mem->x, b); /* If using a direct or matrix-iterative solver, BDF method, and gamma has changed, scale the correction to account for change in gamma */ if ( ((LSType == SUNLINEARSOLVER_DIRECT) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) && (cv_mem->cv_lmm == CV_BDF) && (cv_mem->cv_gamrat != ONE) ) N_VScale(TWO/(ONE + cv_mem->cv_gamrat), b, b); /* Retrieve statistics from iterative linear solvers */ nli_inc = 0; if ( ((LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) && (cvls_mem->LS->ops->numiters) ) nli_inc = SUNLinSolNumIters(cvls_mem->LS); /* Increment counters nli and ncfl */ cvls_mem->nli += nli_inc; if (retval != SUNLS_SUCCESS) cvls_mem->ncfl++; /* Interpret solver return value */ cvls_mem->last_flag = retval; switch(retval) { case SUNLS_SUCCESS: return(0); break; case SUNLS_RES_REDUCED: /* allow reduction but not solution on first Newton iteration, otherwise return with a recoverable failure */ if (curiter == 0) return(0); else return(1); break; case SUNLS_CONV_FAIL: case SUNLS_ATIMES_FAIL_REC: case SUNLS_PSOLVE_FAIL_REC: case SUNLS_PACKAGE_FAIL_REC: case SUNLS_QRFACT_FAIL: case SUNLS_LUFACT_FAIL: return(1); break; case SUNLS_MEM_NULL: case SUNLS_ILL_INPUT: case SUNLS_MEM_FAIL: case SUNLS_GS_FAIL: case SUNLS_QRSOL_FAIL: return(-1); break; case SUNLS_PACKAGE_FAIL_UNREC: cvProcessError(cv_mem, SUNLS_PACKAGE_FAIL_UNREC, "CVSLS", "cvLsSolve", "Failure in SUNLinSol external package"); return(-1); break; case SUNLS_ATIMES_FAIL_UNREC: cvProcessError(cv_mem, SUNLS_ATIMES_FAIL_UNREC, "CVSLS", "cvLsSolve", MSG_LS_JTIMES_FAILED); return(-1); break; case SUNLS_PSOLVE_FAIL_UNREC: cvProcessError(cv_mem, SUNLS_PSOLVE_FAIL_UNREC, "CVSLS", "cvLsSolve", MSG_LS_PSOLVE_FAILED); return(-1); break; } return(0); } /*----------------------------------------------------------------- cvLsFree This routine frees memory associates with the CVLs system solver interface. -----------------------------------------------------------------*/ int cvLsFree(CVodeMem cv_mem) { CVLsMem cvls_mem; /* Return immediately if CVodeMem or CVLsMem are NULL */ if (cv_mem == NULL) return (CVLS_SUCCESS); if (cv_mem->cv_lmem == NULL) return(CVLS_SUCCESS); cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Free N_Vector memory */ if (cvls_mem->ytemp) { N_VDestroy(cvls_mem->ytemp); cvls_mem->ytemp = NULL; } if (cvls_mem->x) { N_VDestroy(cvls_mem->x); cvls_mem->x = NULL; } /* Free savedJ memory */ if (cvls_mem->savedJ) { SUNMatDestroy(cvls_mem->savedJ); cvls_mem->savedJ = NULL; } /* Nullify other N_Vector pointers */ cvls_mem->ycur = NULL; cvls_mem->fcur = NULL; /* Nullify other SUNMatrix pointer */ cvls_mem->A = NULL; /* Free preconditioner memory (if applicable) */ if (cvls_mem->pfree) cvls_mem->pfree(cv_mem); /* free CVLs interface structure */ free(cv_mem->cv_lmem); return(CVLS_SUCCESS); } /*----------------------------------------------------------------- cvLsInitializeCounters This routine resets all counters from an CVLsMem structure. -----------------------------------------------------------------*/ int cvLsInitializeCounters(CVLsMem cvls_mem) { cvls_mem->nje = 0; cvls_mem->nfeDQ = 0; cvls_mem->nstlj = 0; cvls_mem->npe = 0; cvls_mem->nli = 0; cvls_mem->nps = 0; cvls_mem->ncfl = 0; cvls_mem->njtsetup = 0; cvls_mem->njtimes = 0; return(0); } /*--------------------------------------------------------------- cvLs_AccessLMem This routine unpacks the cv_mem and ls_mem structures from void* pointer. If either is missing it returns CVLS_MEM_NULL or CVLS_LMEM_NULL. ---------------------------------------------------------------*/ int cvLs_AccessLMem(void* cvode_mem, const char *fname, CVodeMem *cv_mem, CVLsMem *cvls_mem) { if (cvode_mem==NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSLS", fname, MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } *cv_mem = (CVodeMem) cvode_mem; if ((*cv_mem)->cv_lmem==NULL) { cvProcessError(*cv_mem, CVLS_LMEM_NULL, "CVSLS", fname, MSG_LS_LMEM_NULL); return(CVLS_LMEM_NULL); } *cvls_mem = (CVLsMem) (*cv_mem)->cv_lmem; return(CVLS_SUCCESS); } /*================================================================ PART II - backward problems ================================================================*/ /*--------------------------------------------------------------- CVSLS Exported functions -- Required ---------------------------------------------------------------*/ /* CVodeSetLinearSolverB specifies the iterative linear solver for backward integration */ int CVodeSetLinearSolverB(void *cvode_mem, int which, SUNLinearSolver LS, SUNMatrix A) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVLsMemB cvlsB_mem; int retval; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSLS", "CVodeSetLinearSolverB", MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CVLS_NO_ADJ, "CVSLS", "CVodeSetLinearSolverB", MSG_LS_NO_ADJ); return(CVLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSLS", "CVodeSetLinearSolverB", MSG_LS_BAD_WHICH); return(CVLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } /* Get memory for CVLsMemRecB */ cvlsB_mem = NULL; cvlsB_mem = (CVLsMemB) malloc(sizeof(struct CVLsMemRecB)); if (cvlsB_mem == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSLS", "CVodeSetLinearSolverB", MSG_LS_MEM_FAIL); return(CVLS_MEM_FAIL); } /* initialize Jacobian and preconditioner functions */ cvlsB_mem->jacB = NULL; cvlsB_mem->jacBS = NULL; cvlsB_mem->jtsetupB = NULL; cvlsB_mem->jtsetupBS = NULL; cvlsB_mem->jtimesB = NULL; cvlsB_mem->jtimesBS = NULL; cvlsB_mem->psetB = NULL; cvlsB_mem->psetBS = NULL; cvlsB_mem->psolveB = NULL; cvlsB_mem->psolveBS = NULL; cvlsB_mem->P_dataB = NULL; /* free any existing system solver attached to cvB */ if (cvB_mem->cv_lfree) cvB_mem->cv_lfree(cvB_mem); /* Attach lmemB data and lfreeB function. */ cvB_mem->cv_lmem = cvlsB_mem; cvB_mem->cv_lfree = cvLsFreeB; /* set the linear solver for this backward problem */ cvodeB_mem = (void *) (cvB_mem->cv_mem); retval = CVodeSetLinearSolver(cvodeB_mem, LS, A); if (retval != CVLS_SUCCESS) { free(cvlsB_mem); cvlsB_mem = NULL; } return(retval); } /*--------------------------------------------------------------- CVSLS Exported functions -- Optional input/output ---------------------------------------------------------------*/ int CVodeSetJacFnB(void *cvode_mem, int which, CVLsJacFnB jacB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; void *cvodeB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetJacFnB", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* set jacB function pointer */ cvlsB_mem->jacB = jacB; /* call corresponding routine for cvodeB_mem structure */ cvodeB_mem = (void *) (cvB_mem->cv_mem); if (jacB != NULL) { retval = CVodeSetJacFn(cvodeB_mem, cvLsJacBWrapper); } else { retval = CVodeSetJacFn(cvodeB_mem, NULL); } return(retval); } int CVodeSetJacFnBS(void *cvode_mem, int which, CVLsJacFnBS jacBS) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; void *cvodeB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetJacFnBS", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* set jacBS function pointer */ cvlsB_mem->jacBS = jacBS; /* call corresponding routine for cvodeB_mem structure */ cvodeB_mem = (void *) (cvB_mem->cv_mem); if (jacBS != NULL) { retval = CVodeSetJacFn(cvodeB_mem, cvLsJacBSWrapper); } else { retval = CVodeSetJacFn(cvodeB_mem, NULL); } return(retval); } int CVodeSetEpsLinB(void *cvode_mem, int which, realtype eplifacB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; void *cvodeB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetEpsLinB", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* call corresponding routine for cvodeB_mem structure */ cvodeB_mem = (void *) (cvB_mem->cv_mem); return(CVodeSetEpsLin(cvodeB_mem, eplifacB)); } int CVodeSetPreconditionerB(void *cvode_mem, int which, CVLsPrecSetupFnB psetupB, CVLsPrecSolveFnB psolveB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVLsMemB cvlsB_mem; CVLsPrecSetupFn cvls_psetup; CVLsPrecSolveFn cvls_psolve; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetPreconditionerB", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Set preconditioners for the backward problem. */ cvlsB_mem->psetB = psetupB; cvlsB_mem->psolveB = psolveB; /* Call the corresponding "set" routine for the backward problem */ cvodeB_mem = (void *) (cvB_mem->cv_mem); cvls_psetup = (psetupB == NULL) ? NULL : cvLsPrecSetupBWrapper; cvls_psolve = (psolveB == NULL) ? NULL : cvLsPrecSolveBWrapper; return(CVodeSetPreconditioner(cvodeB_mem, cvls_psetup, cvls_psolve)); } int CVodeSetPreconditionerBS(void *cvode_mem, int which, CVLsPrecSetupFnBS psetupBS, CVLsPrecSolveFnBS psolveBS) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVLsMemB cvlsB_mem; CVLsPrecSetupFn cvls_psetup; CVLsPrecSolveFn cvls_psolve; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetPreconditionerBS", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Set preconditioners for the backward problem. */ cvlsB_mem->psetBS = psetupBS; cvlsB_mem->psolveBS = psolveBS; /* Call the corresponding "set" routine for the backward problem */ cvodeB_mem = (void *) (cvB_mem->cv_mem); cvls_psetup = (psetupBS == NULL) ? NULL : cvLsPrecSetupBSWrapper; cvls_psolve = (psolveBS == NULL) ? NULL : cvLsPrecSolveBSWrapper; return(CVodeSetPreconditioner(cvodeB_mem, cvls_psetup, cvls_psolve)); } int CVodeSetJacTimesB(void *cvode_mem, int which, CVLsJacTimesSetupFnB jtsetupB, CVLsJacTimesVecFnB jtimesB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVLsMemB cvlsB_mem; CVLsJacTimesSetupFn cvls_jtsetup; CVLsJacTimesVecFn cvls_jtimes; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetJacTimesB", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Set jacobian routines for the backward problem. */ cvlsB_mem->jtsetupB = jtsetupB; cvlsB_mem->jtimesB = jtimesB; /* Call the corresponding "set" routine for the backward problem */ cvodeB_mem = (void *) (cvB_mem->cv_mem); cvls_jtsetup = (jtsetupB == NULL) ? NULL : cvLsJacTimesSetupBWrapper; cvls_jtimes = (jtimesB == NULL) ? NULL : cvLsJacTimesVecBWrapper; return(CVodeSetJacTimes(cvodeB_mem, cvls_jtsetup, cvls_jtimes)); } int CVodeSetJacTimesBS(void *cvode_mem, int which, CVLsJacTimesSetupFnBS jtsetupBS, CVLsJacTimesVecFnBS jtimesBS) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; CVLsMemB cvlsB_mem; CVLsJacTimesSetupFn cvls_jtsetup; CVLsJacTimesVecFn cvls_jtimes; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemB(cvode_mem, which, "CVodeSetJacTimesBS", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Set jacobian routines for the backward problem. */ cvlsB_mem->jtsetupBS = jtsetupBS; cvlsB_mem->jtimesBS = jtimesBS; /* Call the corresponding "set" routine for the backward problem */ cvodeB_mem = (void *) (cvB_mem->cv_mem); cvls_jtsetup = (jtsetupBS == NULL) ? NULL : cvLsJacTimesSetupBSWrapper; cvls_jtimes = (jtimesBS == NULL) ? NULL : cvLsJacTimesVecBSWrapper; return(CVodeSetJacTimes(cvodeB_mem, cvls_jtsetup, cvls_jtimes)); } /*----------------------------------------------------------------- CVSLS private functions for backwards problems -----------------------------------------------------------------*/ /* cvLsJacBWrapper interfaces to the CVLsJacFnB routine provided by the user. cvLsJacBWrapper is of type CVLsJacFn. */ static int cvLsJacBWrapper(realtype t, N_Vector yB, N_Vector fyB, SUNMatrix JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsJacBWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsJacBWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint jacB routine (of type CVLsJacFnB) */ return(cvlsB_mem->jacB(t, ca_mem->ca_ytmp, yB, fyB, JB, cvB_mem->cv_user_data, tmp1B, tmp2B, tmp3B)); } /* cvLsJacBSWrapper interfaces to the CVLsJacFnBS routine provided by the user. cvLsJacBSWrapper is of type CVLsJacFn. */ static int cvLsJacBSWrapper(realtype t, N_Vector yB, N_Vector fyB, SUNMatrix JB, void *cvode_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsJacBSWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsJacBSWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint dense djacBS routine (of type CVLsDenseJacFnBS) */ return(cvlsB_mem->jacBS(t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, fyB, JB, cvB_mem->cv_user_data, tmp1B, tmp2B, tmp3B)); } /* cvLsPrecSetupBWrapper interfaces to the CVLsPrecSetupFnB routine provided by the user */ static int cvLsPrecSetupBWrapper(realtype t, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsPrecSetupBWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Get forward solution from interpolation */ retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsPrecSetupBWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint precondB routine */ return(cvlsB_mem->psetB(t, ca_mem->ca_ytmp, yB, fyB, jokB, jcurPtrB, gammaB, cvB_mem->cv_user_data)); } /* cvLsPrecSetupBSWrapper interfaces to the CVLsPrecSetupFnBS routine provided by the user */ static int cvLsPrecSetupBSWrapper(realtype t, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsPrecSetupBSWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsPrecSetupBSWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint precondB routine */ return(cvlsB_mem->psetBS(t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, fyB, jokB, jcurPtrB, gammaB, cvB_mem->cv_user_data)); } /* cvLsPrecSolveBWrapper interfaces to the CVLsPrecSolveFnB routine provided by the user */ static int cvLsPrecSolveBWrapper(realtype t, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsPrecSolveBWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsPrecSolveBWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint psolveB routine */ return(cvlsB_mem->psolveB(t, ca_mem->ca_ytmp, yB, fyB, rB, zB, gammaB, deltaB, lrB, cvB_mem->cv_user_data)); } /* cvLsPrecSolveBSWrapper interfaces to the CVLsPrecSolveFnBS routine provided by the user */ static int cvLsPrecSolveBSWrapper(realtype t, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsPrecSolveBSWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsPrecSolveBSWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint psolveBS routine */ return(cvlsB_mem->psolveBS(t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, fyB, rB, zB, gammaB, deltaB, lrB, cvB_mem->cv_user_data)); } /* cvLsJacTimesSetupBWrapper interfaces to the CVLsJacTimesSetupFnB routine provided by the user */ static int cvLsJacTimesSetupBWrapper(realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsJacTimesSetupBWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsJacTimesVecBWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint jtsetupB routine */ return(cvlsB_mem->jtsetupB(t, ca_mem->ca_ytmp, yB, fyB, cvB_mem->cv_user_data)); } /* cvLsJacTimesSetupBSWrapper interfaces to the CVLsJacTimesSetupFnBS routine provided by the user */ static int cvLsJacTimesSetupBSWrapper(realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsJacTimesSetupBSWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsJacTimesVecBSWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint jtsetupBS routine */ return(cvlsB_mem->jtsetupBS(t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, fyB, cvB_mem->cv_user_data)); } /* cvLsJacTimesVecBWrapper interfaces to the CVLsJacTimesVecFnB routine provided by the user */ static int cvLsJacTimesVecBWrapper(N_Vector vB, N_Vector JvB, realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem, N_Vector tmpB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsJacTimesVecBWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsJacTimesVecBWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint jtimesB routine */ return(cvlsB_mem->jtimesB(vB, JvB, t, ca_mem->ca_ytmp, yB, fyB, cvB_mem->cv_user_data, tmpB)); } /* cvLsJacTimesVecBSWrapper interfaces to the CVLsJacTimesVecFnBS routine provided by the user */ static int cvLsJacTimesVecBSWrapper(N_Vector vB, N_Vector JvB, realtype t, N_Vector yB, N_Vector fyB, void *cvode_mem, N_Vector tmpB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; CVLsMemB cvlsB_mem; int retval; /* access relevant memory structures */ retval = cvLs_AccessLMemBCur(cvode_mem, "cvLsJacTimesVecBSWrapper", &cv_mem, &ca_mem, &cvB_mem, &cvlsB_mem); if (retval != CVLS_SUCCESS) return(retval); /* Forward solution from interpolation */ if (ca_mem->ca_IMinterpSensi) retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp); else retval = ca_mem->ca_IMget(cv_mem, t, ca_mem->ca_ytmp, NULL); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, -1, "CVSLS", "cvLsJacTimesVecBSWrapper", MSG_LS_BAD_TINTERP); return(-1); } /* Call user's adjoint jtimesBS routine */ return(cvlsB_mem->jtimesBS(vB, JvB, t, ca_mem->ca_ytmp, ca_mem->ca_yStmp, yB, fyB, cvB_mem->cv_user_data, tmpB)); } /* cvLsFreeB frees memory associated with the CVSLS wrapper */ int cvLsFreeB(CVodeBMem cvB_mem) { CVLsMemB cvlsB_mem; /* Return immediately if cvB_mem or cvB_mem->cv_lmem are NULL */ if (cvB_mem == NULL) return(CVLS_SUCCESS); if (cvB_mem->cv_lmem == NULL) return(CVLS_SUCCESS); cvlsB_mem = (CVLsMemB) (cvB_mem->cv_lmem); /* free CVLsMemB interface structure */ free(cvlsB_mem); return(CVLS_SUCCESS); } /* cvLs_AccessLMemB unpacks the cv_mem, ca_mem, cvB_mem and cvlsB_mem structures from the void* cvode_mem pointer. If any are missing it returns CVLS_MEM_NULL, CVLS_NO_ADJ, CVS_ILL_INPUT, or CVLS_LMEMB_NULL. */ int cvLs_AccessLMemB(void *cvode_mem, int which, const char *fname, CVodeMem *cv_mem, CVadjMem *ca_mem, CVodeBMem *cvB_mem, CVLsMemB *cvlsB_mem) { /* access CVodeMem structure */ if (cvode_mem==NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSLS", fname, MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } *cv_mem = (CVodeMem) cvode_mem; /* access CVadjMem structure */ if ((*cv_mem)->cv_adjMallocDone == SUNFALSE) { cvProcessError(*cv_mem, CVLS_NO_ADJ, "CVSLS", fname, MSG_LS_NO_ADJ); return(CVLS_NO_ADJ); } *ca_mem = (*cv_mem)->cv_adj_mem; /* Check which */ if ( which >= (*ca_mem)->ca_nbckpbs ) { cvProcessError(*cv_mem, CVLS_ILL_INPUT, "CVSLS", fname, MSG_LS_BAD_WHICH); return(CVLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ *cvB_mem = (*ca_mem)->cvB_mem; while ((*cvB_mem) != NULL) { if ( which == (*cvB_mem)->cv_index ) break; *cvB_mem = (*cvB_mem)->cv_next; } /* access CVLsMemB structure */ if ((*cvB_mem)->cv_lmem == NULL) { cvProcessError(*cv_mem, CVLS_LMEMB_NULL, "CVSLS", fname, MSG_LS_LMEMB_NULL); return(CVLS_LMEMB_NULL); } *cvlsB_mem = (CVLsMemB) ((*cvB_mem)->cv_lmem); return(CVLS_SUCCESS); } /* cvLs_AccessLMemBCur unpacks the cv_mem, ca_mem, cvB_mem and cvlsB_mem structures from the void* cvode_mem pointer. If any are missing it returns CVLS_MEM_NULL, CVLS_NO_ADJ, or CVLS_LMEMB_NULL. */ int cvLs_AccessLMemBCur(void *cvode_mem, const char *fname, CVodeMem *cv_mem, CVadjMem *ca_mem, CVodeBMem *cvB_mem, CVLsMemB *cvlsB_mem) { /* access CVodeMem structure */ if (cvode_mem==NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSLS", fname, MSG_LS_CVMEM_NULL); return(CVLS_MEM_NULL); } *cv_mem = (CVodeMem) cvode_mem; /* access CVadjMem structure */ if ((*cv_mem)->cv_adjMallocDone == SUNFALSE) { cvProcessError(*cv_mem, CVLS_NO_ADJ, "CVSLS", fname, MSG_LS_NO_ADJ); return(CVLS_NO_ADJ); } *ca_mem = (*cv_mem)->cv_adj_mem; /* get current backward problem */ if ((*ca_mem)->ca_bckpbCrt == NULL) { cvProcessError(*cv_mem, CVLS_LMEMB_NULL, "CVSLS", fname, MSG_LS_LMEMB_NULL); return(CVLS_LMEMB_NULL); } *cvB_mem = (*ca_mem)->ca_bckpbCrt; /* access CVLsMemB structure */ if ((*cvB_mem)->cv_lmem == NULL) { cvProcessError(*cv_mem, CVLS_LMEMB_NULL, "CVSLS", fname, MSG_LS_LMEMB_NULL); return(CVLS_LMEMB_NULL); } *cvlsB_mem = (CVLsMemB) ((*cvB_mem)->cv_lmem); return(CVLS_SUCCESS); } /*--------------------------------------------------------------- EOF ---------------------------------------------------------------*/ StanHeaders/src/cvodes/cvodes_bbdpre_impl.h0000644000176200001440000000622113766554456020546 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Implementation header file for the CVBBDPRE module. * ----------------------------------------------------------------- */ #ifndef _CVSBBDPRE_IMPL_H #define _CVSBBDPRE_IMPL_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------------------------------------------------------- Type: CVBBDPrecData -----------------------------------------------------------------*/ typedef struct CVBBDPrecDataRec { /* passed by user to CVBBDPrecInit and used by PrecSetup/PrecSolve */ sunindextype mudq, mldq, mukeep, mlkeep; realtype dqrely; CVLocalFn gloc; CVCommFn cfn; /* set by CVBBDPrecSetup and used by CVBBDPrecSolve */ SUNMatrix savedJ; SUNMatrix savedP; SUNLinearSolver LS; N_Vector tmp1; N_Vector tmp2; N_Vector tmp3; N_Vector zlocal; N_Vector rlocal; /* set by CVBBDPrecInit and used by CVBBDPrecSetup */ sunindextype n_local; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to cvode_mem */ void *cvode_mem; } *CVBBDPrecData; /*----------------------------------------------------------------- Type: CVBBDPrecDataB -----------------------------------------------------------------*/ typedef struct CVBBDPrecDataRecB { /* BBD user functions (glocB and cfnB) for backward run */ CVLocalFnB glocB; CVCommFnB cfnB; } *CVBBDPrecDataB; /*----------------------------------------------------------------- CVBBDPRE error messages -----------------------------------------------------------------*/ #define MSGBBD_MEM_NULL "Integrator memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." #define MSGBBD_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. CVBBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The gloc or cfn routine failed in an unrecoverable manner." #define MSGBBD_NO_ADJ "Illegal attempt to call before calling CVodeAdjInit." #define MSGBBD_BAD_WHICH "Illegal value for the which parameter." #define MSGBBD_PDATAB_NULL "BBD preconditioner memory is NULL for the backward integration." #define MSGBBD_BAD_TINTERP "Bad t for interpolation." #ifdef __cplusplus } #endif #endif StanHeaders/src/cvodes/cvodea_io.c0000644000176200001440000004621113766554456016652 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the adjoint module in the CVODES solver. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "cvodes_impl.h" #include /* * ================================================================= * CVODEA PRIVATE CONSTANTS * ================================================================= */ #define ONE RCONST(1.0) /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Optional input functions for ASA * ----------------------------------------------------------------- */ int CVodeSetAdjNoSensi(void *cvode_mem) { CVodeMem cv_mem; CVadjMem ca_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetAdjNoSensi", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetAdjNoSensi", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; ca_mem->ca_IMstoreSensi = SUNFALSE; return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Optional input functions for backward integration * ----------------------------------------------------------------- */ int CVodeSetNonlinearSolverB(void *cvode_mem, int which, SUNNonlinearSolver NLS) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetNonlinearSolverB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetNonlinearSolverB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetNonlinearSolverB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); return(CVodeSetNonlinearSolver(cvodeB_mem, NLS)); } int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetUserDataB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetUserDataB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetUserDataB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvB_mem->cv_user_data = user_dataB; return(CV_SUCCESS); } int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxOrdB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxOrdB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxOrdB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMaxOrd(cvodeB_mem, maxordB); return(flag); } int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxNumStepsB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMaxNumSteps(cvodeB_mem, mxstepsB); return(flag); } int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetStabLimDetB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetStabLimDetB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetStabLimDetB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetStabLimDet(cvodeB_mem, stldetB); return(flag); } int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetInitStepB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetInitStepB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetInitStepB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetInitStep(cvodeB_mem, hinB); return(flag); } int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMinStepB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMinStepB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMinStepB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMinStep(cvodeB_mem, hminB); return(flag); } int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetMaxStepB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetMaxStepB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetMaxStepB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetMaxStep(cvodeB_mem, hmaxB); return(flag); } int CVodeSetConstraintsB(void *cvode_mem, int which, N_Vector constraintsB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Is cvode_mem valid? */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetConstraintsB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Is ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetConstraintsB", MSGCV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check the value of which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetConstraintsB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to 'which'. */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index) break; /* advance */ cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) cvB_mem->cv_mem; flag = CVodeSetConstraints(cvodeB_mem, constraintsB); return(flag); } /* * CVodeSetQuad*B * * Wrappers for the backward phase around the corresponding * CVODES quadrature optional input functions */ int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeSetQuadErrConB", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeSetQuadErrConB", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVodeSetQuadErrConB", MSGCV_BAD_WHICH); return(CV_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); flag = CVodeSetQuadErrCon(cvodeB_mem, errconQB); return(flag); } /* * ----------------------------------------------------------------- * Optional output functions for backward integration * ----------------------------------------------------------------- */ /* * CVodeGetAdjCVodeBmem * * This function returns a (void *) pointer to the CVODES * memory allocated for the backward problem. This pointer can * then be used to call any of the CVodeGet* CVODES routines to * extract optional output for the backward integration phase. */ void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_NO_MEM); return(NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_NO_ADJ); return(NULL); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, 0, "CVODEA", "CVodeGetAdjCVodeBmem", MSGCV_BAD_WHICH); return(NULL); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; cvB_mem = cvB_mem->cv_next; } cvodeB_mem = (void *) (cvB_mem->cv_mem); return(cvodeB_mem); } /* * CVodeGetAdjCheckPointsInfo * * This routine loads an array of nckpnts structures of type CVadjCheckPointRec. * The user must allocate space for ckpnt. */ int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt) { CVodeMem cv_mem; CVadjMem ca_mem; CkpntMem ck_mem; int i; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjCheckPointsInfo", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjCheckPointsInfo", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; ck_mem = ca_mem->ck_mem; i = 0; while (ck_mem != NULL) { ckpnt[i].my_addr = (void *) ck_mem; ckpnt[i].next_addr = (void *) ck_mem->ck_next; ckpnt[i].t0 = ck_mem->ck_t0; ckpnt[i].t1 = ck_mem->ck_t1; ckpnt[i].nstep = ck_mem->ck_nst; ckpnt[i].order = ck_mem->ck_q; ckpnt[i].step = ck_mem->ck_h; ck_mem = ck_mem->ck_next; i++; } return(CV_SUCCESS); } /* * ----------------------------------------------------------------- * Undocumented Development User-Callable Functions * ----------------------------------------------------------------- */ /* * CVodeGetAdjDataPointHermite * * This routine returns the solution stored in the data structure * at the 'which' data point. Cubic Hermite interpolation. */ int CVodeGetAdjDataPointHermite(void *cvode_mem, int which, realtype *t, N_Vector y, N_Vector yd) { CVodeMem cv_mem; CVadjMem ca_mem; DtpntMem *dt_mem; HermiteDataMem content; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjDataPointHermite", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjDataPointHermite", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; if (ca_mem->ca_IMtype != CV_HERMITE) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVadjGetDataPointHermite", MSGCV_WRONG_INTERP); return(CV_ILL_INPUT); } *t = dt_mem[which]->t; content = (HermiteDataMem) (dt_mem[which]->content); if (y != NULL) N_VScale(ONE, content->y, y); if (yd != NULL) N_VScale(ONE, content->yd, yd); return(CV_SUCCESS); } /* * CVodeGetAdjDataPointPolynomial * * This routine returns the solution stored in the data structure * at the 'which' data point. Polynomial interpolation. */ int CVodeGetAdjDataPointPolynomial(void *cvode_mem, int which, realtype *t, int *order, N_Vector y) { CVodeMem cv_mem; CVadjMem ca_mem; DtpntMem *dt_mem; PolynomialDataMem content; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjDataPointPolynomial", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjDataPointPolynomial", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; dt_mem = ca_mem->dt_mem; if (ca_mem->ca_IMtype != CV_POLYNOMIAL) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODEA", "CVadjGetDataPointPolynomial", MSGCV_WRONG_INTERP); return(CV_ILL_INPUT); } *t = dt_mem[which]->t; content = (PolynomialDataMem) (dt_mem[which]->content); if (y != NULL) N_VScale(ONE, content->y, y); *order = content->order; return(CV_SUCCESS); } /* * CVodeGetAdjCurrentCheckPoint * * Returns the address of the 'active' check point. */ int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr) { CVodeMem cv_mem; CVadjMem ca_mem; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODEA", "CVodeGetAdjCurrentCheckPoint", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CV_NO_ADJ, "CVODEA", "CVodeGetAdjCurrentCheckPoint", MSGCV_NO_ADJ); return(CV_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; *addr = (void *) ca_mem->ca_ckpntData; return(CV_SUCCESS); } StanHeaders/src/cvodes/cvodes_diag_impl.h0000644000176200001440000000427313766554456020221 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Implementation header file for the diagonal linear solver, CVDIAG. * ----------------------------------------------------------------- */ #ifndef _CVSDIAG_IMPL_H #define _CVSDIAG_IMPL_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * Types: CVDiagMemRec, CVDiagMem * ----------------------------------------------------------------- * The type CVDiagMem is pointer to a CVDiagMemRec. * This structure contains CVDiag solver-specific data. * ----------------------------------------------------------------- */ typedef struct { realtype di_gammasv; /* gammasv = gamma at the last call to setup or solve */ N_Vector di_M; /* M = (I - gamma J)^{-1} , gamma = h / l1 */ N_Vector di_bit; /* temporary storage vector */ N_Vector di_bitcomp; /* temporary storage vector */ long int di_nfeDI; /* no. of calls to f due to difference quotient diagonal Jacobian approximation */ long int di_last_flag; /* last error return flag */ } CVDiagMemRec, *CVDiagMem; /* Error Messages */ #define MSGDG_CVMEM_NULL "Integrator memory is NULL." #define MSGDG_MEM_FAIL "A memory request failed." #define MSGDG_BAD_NVECTOR "A required vector operation is not implemented." #define MSGDG_LMEM_NULL "CVDIAG memory is NULL." #define MSGDG_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." #define MSGDG_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSGDG_BAD_WHICH "Illegal value for which." #ifdef __cplusplus } #endif #endif StanHeaders/src/cvodes/cvodes_nls_sim.c0000644000176200001440000004236613766554457017741 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the CVODES nonlinear solver interface. * ---------------------------------------------------------------------------*/ /* * When sensitivities are computed using the CV_SIMULTANEOUS approach and the * Newton solver is selected the iteraiton is a quasi-Newton method on the * combined system (by approximating the Jacobian matrix by its block diagonal) * and thus only solve linear systems with multiple right hand sides (all * sharing the same coefficient matrix - whatever iteration matrix we decide on) * we set-up the linear solver to handle N equations at a time. */ #include "cvodes_impl.h" #include "sundials/sundials_math.h" #include "sundials/sundials_nvector_senswrapper.h" /* constant macros */ #define ONE RCONST(1.0) /* private functions */ static int cvNlsResidualSensSim(N_Vector ycorSim, N_Vector resSim, void* cvode_mem); static int cvNlsFPFunctionSensSim(N_Vector ycorSim, N_Vector resSim, void* cvode_mem); static int cvNlsLSetupSensSim(N_Vector ycorSim, N_Vector resSim, booleantype jbad, booleantype* jcur, void* cvode_mem); static int cvNlsLSolveSensSim(N_Vector ycorSim, N_Vector deltaSim, void* cvode_mem); static int cvNlsConvTestSensSim(SUNNonlinearSolver NLS, N_Vector ycorSim, N_Vector delSim, realtype tol, N_Vector ewtSim, void* cvode_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int CVodeSetNonlinearSolverSensSim(void *cvode_mem, SUNNonlinearSolver NLS) { CVodeMem cv_mem; int retval, is; /* Return immediately if CVode memory is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinearSolverSensSim", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Return immediately if NLS memory is NULL */ if (NLS == NULL) { cvProcessError(NULL, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", "NLS must be non-NULL"); return (CV_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", "NLS does not support required operations"); return(CV_ILL_INPUT); } /* check that sensitivities were initialized */ if (!(cv_mem->cv_sensi)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", MSGCV_NO_SENSI); return(CV_ILL_INPUT); } /* check that simultaneous corrector was selected */ if (cv_mem->cv_ism != CV_SIMULTANEOUS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "Sensitivity solution method is not CV_SIMULTANEOUS"); return(CV_ILL_INPUT); } /* free any existing nonlinear solver */ if ((cv_mem->NLSsim != NULL) && (cv_mem->ownNLSsim)) retval = SUNNonlinSolFree(cv_mem->NLSsim); /* set SUNNonlinearSolver pointer */ cv_mem->NLSsim = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, CVODE will set the flag to SUNTRUE after this function returns. */ cv_mem->ownNLSsim = SUNFALSE; /* set the nonlinear system function */ if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_ROOTFIND) { retval = SUNNonlinSolSetSysFn(cv_mem->NLSsim, cvNlsResidualSensSim); } else if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_FIXEDPOINT) { retval = SUNNonlinSolSetSysFn(cv_mem->NLSsim, cvNlsFPFunctionSensSim); } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", "Invalid nonlinear solver type"); return(CV_ILL_INPUT); } if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", "Setting nonlinear system function failed"); return(CV_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(cv_mem->NLSsim, cvNlsConvTestSensSim); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", "Setting convergence test function failed"); return(CV_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(cv_mem->NLSsim, NLS_MAXCOR); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensSim", "Setting maximum number of nonlinear iterations failed"); return(CV_ILL_INPUT); } /* create vector wrappers if necessary */ if (cv_mem->simMallocDone == SUNFALSE) { cv_mem->ycor0Sim = N_VNewEmpty_SensWrapper(cv_mem->cv_Ns+1); if (cv_mem->ycor0Sim == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSetNonlinearSolverSensSim", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->ycorSim = N_VNewEmpty_SensWrapper(cv_mem->cv_Ns+1); if (cv_mem->ycorSim == NULL) { N_VDestroy(cv_mem->ycor0Sim); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSetNonlinearSolverSensSim", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->ewtSim = N_VNewEmpty_SensWrapper(cv_mem->cv_Ns+1); if (cv_mem->ewtSim == NULL) { N_VDestroy(cv_mem->ycor0Sim); N_VDestroy(cv_mem->ycorSim); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSetNonlinearSolverSensSim", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->simMallocDone = SUNTRUE; } /* attach vectors to vector wrappers */ NV_VEC_SW(cv_mem->ycor0Sim, 0) = cv_mem->cv_tempv; NV_VEC_SW(cv_mem->ycorSim, 0) = cv_mem->cv_acor; NV_VEC_SW(cv_mem->ewtSim, 0) = cv_mem->cv_ewt; for (is=0; is < cv_mem->cv_Ns; is++) { NV_VEC_SW(cv_mem->ycor0Sim, is+1) = cv_mem->cv_tempvS[is]; NV_VEC_SW(cv_mem->ycorSim, is+1) = cv_mem->cv_acorS[is]; NV_VEC_SW(cv_mem->ewtSim, is+1) = cv_mem->cv_ewtS[is]; } return(CV_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int cvNlsInitSensSim(CVodeMem cvode_mem) { int retval; /* set the linear solver setup wrapper function */ if (cvode_mem->cv_lsetup) retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLSsim, cvNlsLSetupSensSim); else retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLSsim, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensSim", "Setting the linear solver setup function failed"); return(CV_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (cvode_mem->cv_lsolve) retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLSsim, cvNlsLSolveSensSim); else retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLSsim, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensSim", "Setting linear solver solve function failed"); return(CV_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(cvode_mem->NLSsim); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensSim", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } return(CV_SUCCESS); } static int cvNlsLSetupSensSim(N_Vector ycorSim, N_Vector resSim, booleantype jbad, booleantype* jcur, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsLSetupSensSim", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* if the nonlinear solver marked the Jacobian as bad update convfail */ if (jbad) cv_mem->convfail = CV_FAIL_BAD_J; /* setup the linear solver */ retval = cv_mem->cv_lsetup(cv_mem, cv_mem->convfail, cv_mem->cv_y, cv_mem->cv_ftemp, &(cv_mem->cv_jcur), cv_mem->cv_vtemp1, cv_mem->cv_vtemp2, cv_mem->cv_vtemp3); cv_mem->cv_nsetups++; /* update Jacobian status */ *jcur = cv_mem->cv_jcur; cv_mem->cv_forceSetup = SUNFALSE; cv_mem->cv_gamrat = ONE; cv_mem->cv_gammap = cv_mem->cv_gamma; cv_mem->cv_crate = ONE; cv_mem->cv_crateS = ONE; cv_mem->cv_nstlp = cv_mem->cv_nst; if (retval < 0) return(CV_LSETUP_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); return(CV_SUCCESS); } static int cvNlsLSolveSensSim(N_Vector ycorSim, N_Vector deltaSim, void* cvode_mem) { CVodeMem cv_mem; int retval, is; N_Vector delta; N_Vector *deltaS; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsLSolveSensSim", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract state delta from the vector wrapper */ delta = NV_VEC_SW(deltaSim,0); /* solve the state linear system */ retval = cv_mem->cv_lsolve(cv_mem, delta, cv_mem->cv_ewt, cv_mem->cv_y, cv_mem->cv_ftemp); if (retval < 0) return(CV_LSOLVE_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); /* extract sensitivity deltas from the vector wrapper */ deltaS = NV_VECS_SW(deltaSim)+1; /* solve the sensitivity linear systems */ for (is=0; iscv_Ns; is++) { retval = cv_mem->cv_lsolve(cv_mem, deltaS[is], cv_mem->cv_ewtS[is], cv_mem->cv_y, cv_mem->cv_ftemp); if (retval < 0) return(CV_LSOLVE_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); } return(CV_SUCCESS); } static int cvNlsConvTestSensSim(SUNNonlinearSolver NLS, N_Vector ycorSim, N_Vector deltaSim, realtype tol, N_Vector ewtSim, void* cvode_mem) { CVodeMem cv_mem; int m, retval; realtype del, delS, Del; realtype dcon; N_Vector ycor, delta, ewt; N_Vector *deltaS, *ewtS; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsConvTestSensSim", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract the current state and sensitivity corrections */ ycor = NV_VEC_SW(ycorSim,0); /* extract state and sensitivity deltas */ delta = NV_VEC_SW(deltaSim,0); deltaS = NV_VECS_SW(deltaSim)+1; /* extract state and sensitivity error weights */ ewt = NV_VEC_SW(ewtSim,0); ewtS = NV_VECS_SW(ewtSim)+1; /* compute the norm of the state and sensitivity corrections */ del = N_VWrmsNorm(delta, ewt); delS = cvSensUpdateNorm(cv_mem, del, deltaS, ewtS); /* norm used in error test */ Del = delS; /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != CV_SUCCESS) return(CV_MEM_NULL); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crate, and used in the test. Recall that, even when errconS=SUNFALSE, all variables are used in the convergence test. Hence, we use Del (and not del). However, acnrm is used in the error test and thus it has different forms depending on errconS (and this explains why we have to carry around del and delS). */ if (m > 0) { cv_mem->cv_crate = SUNMAX(CRDOWN * cv_mem->cv_crate, Del/cv_mem->cv_delp); } dcon = Del * SUNMIN(ONE, cv_mem->cv_crate) / tol; /* check if nonlinear system was solved successfully */ if (dcon <= ONE) { if (m == 0) { cv_mem->cv_acnrm = (cv_mem->cv_errconS) ? delS : del; } else { cv_mem->cv_acnrm = (cv_mem->cv_errconS) ? N_VWrmsNorm(ycorSim, ewtSim) : N_VWrmsNorm(ycor, ewt); } return(CV_SUCCESS); } /* check if the iteration seems to be diverging */ if ((m >= 1) && (Del > RDIV*cv_mem->cv_delp)) return(SUN_NLS_CONV_RECVR); /* Save norm of correction and loop again */ cv_mem->cv_delp = Del; /* Not yet converged */ return(SUN_NLS_CONTINUE); } static int cvNlsResidualSensSim(N_Vector ycorSim, N_Vector resSim, void* cvode_mem) { CVodeMem cv_mem; int retval; N_Vector ycor, res; N_Vector *ycorS, *resS; realtype cvals[3]; N_Vector* XXvecs[3]; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsResidualSensSim", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract state and residual vectors from the vector wrapper */ ycor = NV_VEC_SW(ycorSim,0); res = NV_VEC_SW(resSim,0); /* update the state based on the current correction */ N_VLinearSum(ONE, cv_mem->cv_zn[0], ONE, ycor, cv_mem->cv_y); /* evaluate the rhs function */ retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); /* compute the resiudal */ N_VLinearSum(cv_mem->cv_rl1, cv_mem->cv_zn[1], ONE, ycor, res); N_VLinearSum(-cv_mem->cv_gamma, cv_mem->cv_ftemp, ONE, res, res); /* extract sensitivity and residual vectors from the vector wrapper */ ycorS = NV_VECS_SW(ycorSim)+1; resS = NV_VECS_SW(resSim)+1; /* update sensitivities based on the current correction */ retval = N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[0], ONE, ycorS, cv_mem->cv_yS); if (retval != CV_SUCCESS) return(CV_VECTOROP_ERR); /* evaluate the sensitivity rhs function */ retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, cv_mem->cv_yS, cv_mem->cv_ftempS, cv_mem->cv_vtemp1, cv_mem->cv_vtemp2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* compute the sensitivity resiudal */ cvals[0] = cv_mem->cv_rl1; XXvecs[0] = cv_mem->cv_znS[1]; cvals[1] = ONE; XXvecs[1] = ycorS; cvals[2] = -cv_mem->cv_gamma; XXvecs[2] = cv_mem->cv_ftempS; retval = N_VLinearCombinationVectorArray(cv_mem->cv_Ns, 3, cvals, XXvecs, resS); if (retval != CV_SUCCESS) return(CV_VECTOROP_ERR); return(CV_SUCCESS); } static int cvNlsFPFunctionSensSim(N_Vector ycorSim, N_Vector resSim, void* cvode_mem) { CVodeMem cv_mem; int retval, is; N_Vector ycor, res; N_Vector *ycorS, *resS; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsFPFunctionSensSim", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract state and residual vectors from the vector wrapper */ ycor = NV_VEC_SW(ycorSim,0); res = NV_VEC_SW(resSim,0); /* update the state based on the current correction */ N_VLinearSum(ONE, cv_mem->cv_zn[0], ONE, ycor, cv_mem->cv_y); /* evaluate the rhs function */ retval = cv_mem->cv_f(cv_mem->cv_tn, cv_mem->cv_y, res, cv_mem->cv_user_data); cv_mem->cv_nfe++; if (retval < 0) return(CV_RHSFUNC_FAIL); if (retval > 0) return(RHSFUNC_RECVR); /* evaluate fixed point function */ N_VLinearSum(cv_mem->cv_h, res, -ONE, cv_mem->cv_zn[1], res); N_VScale(cv_mem->cv_rl1, res, res); /* extract sensitivity and residual vectors from the vector wrapper */ ycorS = NV_VECS_SW(ycorSim)+1; resS = NV_VECS_SW(resSim)+1; /* update the sensitivities based on the current correction */ N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[0], ONE, ycorS, cv_mem->cv_yS); /* evaluate the sensitivity rhs function */ retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_y, res, cv_mem->cv_yS, resS, cv_mem->cv_vtemp1, cv_mem->cv_vtemp2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* evaluate sensitivity fixed point function */ for (is=0; iscv_Ns; is++) { N_VLinearSum(cv_mem->cv_h, resS[is], -ONE, cv_mem->cv_znS[1][is], resS[is]); N_VScale(cv_mem->cv_rl1, resS[is], resS[is]); } return(CV_SUCCESS); } StanHeaders/src/cvodes/cvodes_bandpre.c0000644000176200001440000004734513766554456017711 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file contains implementations of the banded difference * quotient Jacobian-based preconditioner and solver routines for * use with the CVSLS linear solver interface. * ----------------------------------------------------------------- */ #include #include #include "cvodes_impl.h" #include "cvodes_bandpre_impl.h" #include "cvodes_ls_impl.h" #include #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Prototypes of cvBandPrecSetup and cvBandPrecSolve */ static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data); static int cvBandPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bp_data); /* Prototype for cvBandPrecFree */ static int cvBandPrecFree(CVodeMem cv_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int cvBandPrecDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp); /*================================================================ PART I - Forward Problems ================================================================*/ /*----------------------------------------------------------------- Initialization, Free, and Get Functions NOTE: The band linear solver assumes a serial/OpenMP/Pthreads implementation of the NVECTOR package. Therefore, CVBandPrecInit will first test for a compatible N_Vector internal representation by checking that the function N_VGetArrayPointer exists. -----------------------------------------------------------------*/ int CVBandPrecInit(void *cvode_mem, sunindextype N, sunindextype mu, sunindextype ml) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBandPrecData pdata; sunindextype mup, mlp, storagemu; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Test if the CVSLS linear solver interface has been attached */ if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; /* Test compatibility of NVECTOR package with the BAND preconditioner */ if(cv_mem->cv_tempv->ops->nvgetarraypointer == NULL) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSBANDPRE", "CVBandPrecInit", MSGBP_BAD_NVECTOR); return(CVLS_ILL_INPUT); } /* Allocate data memory */ pdata = NULL; pdata = (CVBandPrecData) malloc(sizeof *pdata); if (pdata == NULL) { cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Load pointers and bandwidths into pdata block. */ pdata->cvode_mem = cvode_mem; pdata->N = N; pdata->mu = mup = SUNMIN(N-1, SUNMAX(0,mu)); pdata->ml = mlp = SUNMIN(N-1, SUNMAX(0,ml)); /* Initialize nfeBP counter */ pdata->nfeBP = 0; /* Allocate memory for saved banded Jacobian approximation. */ pdata->savedJ = NULL; pdata->savedJ = SUNBandMatrixStorage(N, mup, mlp, mup); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Allocate memory for banded preconditioner. */ storagemu = SUNMIN(N-1, mup+mlp); pdata->savedP = NULL; pdata->savedP = SUNBandMatrixStorage(N, mup, mlp, storagemu); if (pdata->savedP == NULL) { SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVLS_MEM_FAIL); } /* Allocate memory for banded linear solver */ pdata->LS = NULL; pdata->LS = SUNLinSol_Band(cv_mem->cv_tempv, pdata->savedP); if (pdata->LS == NULL) { SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVLS_MEM_FAIL); } /* allocate memory for temporary N_Vectors */ pdata->tmp1 = NULL; pdata->tmp1 = N_VClone(cv_mem->cv_tempv); if (pdata->tmp1 == NULL) { SUNLinSolFree(pdata->LS); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVLS_MEM_FAIL); } pdata->tmp2 = NULL; pdata->tmp2 = N_VClone(cv_mem->cv_tempv); if (pdata->tmp2 == NULL) { SUNLinSolFree(pdata->LS); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); N_VDestroy(pdata->tmp1); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_MEM_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_MEM_FAIL); return(CVLS_MEM_FAIL); } /* initialize band linear solver object */ flag = SUNLinSolInitialize(pdata->LS); if (flag != SUNLS_SUCCESS) { SUNLinSolFree(pdata->LS); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); N_VDestroy(pdata->tmp1); N_VDestroy(pdata->tmp2); free(pdata); pdata = NULL; cvProcessError(cv_mem, CVLS_SUNLS_FAIL, "CVSBANDPRE", "CVBandPrecInit", MSGBP_SUNLS_FAIL); return(CVLS_SUNLS_FAIL); } /* make sure P_data is free from any previous allocations */ if (cvls_mem->pfree) cvls_mem->pfree(cv_mem); /* Point to the new P_data field in the LS memory */ cvls_mem->P_data = pdata; /* Attach the pfree function */ cvls_mem->pfree = cvBandPrecFree; /* Attach preconditioner solve and setup functions */ flag = CVodeSetPreconditioner(cvode_mem, cvBandPrecSetup, cvBandPrecSolve); return(flag); } int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwBP, long int *leniwBP) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBandPrecData pdata; sunindextype lrw1, liw1; long int lrw, liw; int flag; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; if (cvls_mem->P_data == NULL) { cvProcessError(cv_mem, CVLS_PMEM_NULL, "CVSBANDPRE", "CVBandPrecGetWorkSpace", MSGBP_PMEM_NULL); return(CVLS_PMEM_NULL); } pdata = (CVBandPrecData) cvls_mem->P_data; /* sum space requirements for all objects in pdata */ *leniwBP = 4; *lenrwBP = 0; if (cv_mem->cv_tempv->ops->nvspace) { N_VSpace(cv_mem->cv_tempv, &lrw1, &liw1); *leniwBP += 2*liw1; *lenrwBP += 2*lrw1; } if (pdata->savedJ->ops->space) { flag = SUNMatSpace(pdata->savedJ, &lrw, &liw); if (flag != 0) return(-1); *leniwBP += liw; *lenrwBP += lrw; } if (pdata->savedP->ops->space) { flag = SUNMatSpace(pdata->savedP, &lrw, &liw); if (flag != 0) return(-1); *leniwBP += liw; *lenrwBP += lrw; } if (pdata->LS->ops->space) { flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); if (flag != 0) return(-1); *leniwBP += liw; *lenrwBP += lrw; } return(CVLS_SUCCESS); } int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP) { CVodeMem cv_mem; CVLsMem cvls_mem; CVBandPrecData pdata; if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; if (cv_mem->cv_lmem == NULL) { cvProcessError(cv_mem, CVLS_LMEM_NULL, "CVSBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_LMEM_NULL); return(CVLS_LMEM_NULL); } cvls_mem = (CVLsMem) cv_mem->cv_lmem; if (cvls_mem->P_data == NULL) { cvProcessError(cv_mem, CVLS_PMEM_NULL, "CVSBANDPRE", "CVBandPrecGetNumRhsEvals", MSGBP_PMEM_NULL); return(CVLS_PMEM_NULL); } pdata = (CVBandPrecData) cvls_mem->P_data; *nfevalsBP = pdata->nfeBP; return(CVLS_SUCCESS); } /*----------------------------------------------------------------- cvBandPrecSetup ----------------------------------------------------------------- Together cvBandPrecSetup and cvBandPrecSolve use a banded difference quotient Jacobian to create a preconditioner. cvBandPrecSetup calculates a new J, if necessary, then calculates P = I - gamma*J, and does an LU factorization of P. The parameters of cvBandPrecSetup are as follows: t is the current value of the independent variable. y is the current value of the dependent variable vector, namely the predicted value of y(t). fy is the vector f(t,y). jok is an input flag indicating whether Jacobian-related data needs to be recomputed, as follows: jok == SUNFALSE means recompute Jacobian-related data from scratch. jok == SUNTRUE means that Jacobian data from the previous PrecSetup call will be reused (with the current value of gamma). A cvBandPrecSetup call with jok == SUNTRUE should only occur after a call with jok == SUNFALSE. *jcurPtr is a pointer to an output integer flag which is set by cvBandPrecSetup as follows: *jcurPtr = SUNTRUE if Jacobian data was recomputed. *jcurPtr = SUNFALSE if Jacobian data was not recomputed, but saved data was reused. gamma is the scalar appearing in the Newton matrix. bp_data is a pointer to preconditoner data (set by cvBandPrecInit) The value to be returned by the cvBandPrecSetup function is 0 if successful, or 1 if the band factorization failed. -----------------------------------------------------------------*/ static int cvBandPrecSetup(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *bp_data) { CVBandPrecData pdata; CVodeMem cv_mem; int retval; sunindextype ier; /* Assume matrix and lpivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; cv_mem = (CVodeMem) pdata->cvode_mem; if (jok) { /* If jok = SUNTRUE, use saved copy of J. */ *jcurPtr = SUNFALSE; retval = SUNMatCopy(pdata->savedJ, pdata->savedP); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_SUNMAT_FAIL); return(-1); } if (retval > 0) { return(1); } } else { /* If jok = SUNFALSE, call CVBandPDQJac for new J value. */ *jcurPtr = SUNTRUE; retval = SUNMatZero(pdata->savedJ); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_SUNMAT_FAIL); return(-1); } if (retval > 0) { return(1); } retval = cvBandPrecDQJac(pdata, t, y, fy, pdata->tmp1, pdata->tmp2); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_RHSFUNC_FAILED); return(-1); } if (retval > 0) { return(1); } retval = SUNMatCopy(pdata->savedJ, pdata->savedP); if (retval < 0) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_SUNMAT_FAIL); return(-1); } if (retval > 0) { return(1); } } /* Scale and add identity to get savedP = I - gamma*J. */ retval = SUNMatScaleAddI(-gamma, pdata->savedP); if (retval) { cvProcessError(cv_mem, -1, "CVBANDPRE", "cvBandPrecSetup", MSGBP_SUNMAT_FAIL); return(-1); } /* Do LU factorization of matrix and return error flag */ ier = SUNLinSolSetup_Band(pdata->LS, pdata->savedP); return(ier); } /*----------------------------------------------------------------- cvBandPrecSolve ----------------------------------------------------------------- cvBandPrecSolve solves a linear system P z = r, where P is the matrix computed by cvBandPrecond. The parameters of cvBandPrecSolve used here are as follows: r is the right-hand side vector of the linear system. bp_data is a pointer to preconditoner data (set by CVBandPrecInit) z is the output vector computed by cvBandPrecSolve. The value returned by the cvBandPrecSolve function is always 0, indicating success. -----------------------------------------------------------------*/ static int cvBandPrecSolve(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *bp_data) { CVBandPrecData pdata; int retval; /* Assume matrix and lpivots have already been allocated. */ pdata = (CVBandPrecData) bp_data; /* Call banded solver object to do the work */ retval = SUNLinSolSolve(pdata->LS, pdata->savedP, z, r, ZERO); return(retval); } static int cvBandPrecFree(CVodeMem cv_mem) { CVLsMem cvls_mem; CVBandPrecData pdata; if (cv_mem->cv_lmem == NULL) return(0); cvls_mem = (CVLsMem) cv_mem->cv_lmem; if (cvls_mem->P_data == NULL) return(0); pdata = (CVBandPrecData) cvls_mem->P_data; SUNLinSolFree(pdata->LS); SUNMatDestroy(pdata->savedP); SUNMatDestroy(pdata->savedJ); N_VDestroy(pdata->tmp1); N_VDestroy(pdata->tmp2); free(pdata); pdata = NULL; return(0); } /*----------------------------------------------------------------- cvBandPrecDQJac ----------------------------------------------------------------- This routine generates a banded difference quotient approximation to the Jacobian of f(t,y). It assumes that a band SUNMatrix is stored column-wise, and that elements within each column are contiguous. This makes it possible to get the address of a column of J via the accessor function SUNBandMatrix_Column() and to write a simple for loop to set each of the elements of a column in succession. -----------------------------------------------------------------*/ static int cvBandPrecDQJac(CVBandPrecData pdata, realtype t, N_Vector y, N_Vector fy, N_Vector ftemp, N_Vector ytemp) { CVodeMem cv_mem; realtype fnorm, minInc, inc, inc_inv, yj, srur, conj; sunindextype group, i, j, width, ngroups, i1, i2; realtype *col_j, *ewt_data, *fy_data, *ftemp_data; realtype *y_data, *ytemp_data, *cns_data; int retval; cv_mem = (CVodeMem) pdata->cvode_mem; /* Obtain pointers to the data for ewt, fy, ftemp, y, ytemp. */ ewt_data = N_VGetArrayPointer(cv_mem->cv_ewt); fy_data = N_VGetArrayPointer(fy); ftemp_data = N_VGetArrayPointer(ftemp); y_data = N_VGetArrayPointer(y); ytemp_data = N_VGetArrayPointer(ytemp); if (cv_mem->cv_constraints != NULL) cns_data = N_VGetArrayPointer(cv_mem->cv_constraints); /* Load ytemp with y = predicted y vector. */ N_VScale(ONE, y, ytemp); /* Set minimum increment based on uround and norm of f. */ srur = SUNRsqrt(cv_mem->cv_uround); fnorm = N_VWrmsNorm(fy, cv_mem->cv_ewt); minInc = (fnorm != ZERO) ? (MIN_INC_MULT * SUNRabs(cv_mem->cv_h) * cv_mem->cv_uround * pdata->N * fnorm) : ONE; /* Set bandwidth and number of column groups for band differencing. */ width = pdata->ml + pdata->mu + 1; ngroups = SUNMIN(width, pdata->N); for (group = 1; group <= ngroups; group++) { /* Increment all y_j in group. */ for(j = group-1; j < pdata->N; j += width) { inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); yj = y_data[j]; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } ytemp_data[j] += inc; } /* Evaluate f with incremented y. */ retval = cv_mem->cv_f(t, ytemp, ftemp, cv_mem->cv_user_data); pdata->nfeBP++; if (retval != 0) return(retval); /* Restore ytemp, then form and load difference quotients. */ for (j = group-1; j < pdata->N; j += width) { yj = y_data[j]; ytemp_data[j] = y_data[j]; col_j = SUNBandMatrix_Column(pdata->savedJ,j); inc = SUNMAX(srur*SUNRabs(y_data[j]), minInc/ewt_data[j]); /* Adjust sign(inc) as before. */ if (cv_mem->cv_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } inc_inv = ONE/inc; i1 = SUNMAX(0, j-pdata->mu); i2 = SUNMIN(j + pdata->ml, pdata->N - 1); for (i=i1; i <= i2; i++) SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (ftemp_data[i] - fy_data[i]); } } return(0); } /*================================================================ PART II - Backward Problems ================================================================*/ /*--------------------------------------------------------------- User-Callable initialization function: wrapper for the backward phase around the corresponding CVODES functions ---------------------------------------------------------------*/ int CVBandPrecInitB(void *cvode_mem, int which, sunindextype nB, sunindextype muB, sunindextype mlB) { CVodeMem cv_mem; CVadjMem ca_mem; CVodeBMem cvB_mem; void *cvodeB_mem; int flag; /* Check if cvode_mem exists */ if (cvode_mem == NULL) { cvProcessError(NULL, CVLS_MEM_NULL, "CVSBANDPRE", "CVBandPrecInitB", MSGBP_MEM_NULL); return(CVLS_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Was ASA initialized? */ if (cv_mem->cv_adjMallocDone == SUNFALSE) { cvProcessError(cv_mem, CVLS_NO_ADJ, "CVSBANDPRE", "CVBandPrecInitB", MSGBP_NO_ADJ); return(CVLS_NO_ADJ); } ca_mem = cv_mem->cv_adj_mem; /* Check which */ if ( which >= ca_mem->ca_nbckpbs ) { cvProcessError(cv_mem, CVLS_ILL_INPUT, "CVSBANDPRE", "CVBandPrecInitB", MSGBP_BAD_WHICH); return(CVLS_ILL_INPUT); } /* Find the CVodeBMem entry in the linked list corresponding to which */ cvB_mem = ca_mem->cvB_mem; while (cvB_mem != NULL) { if ( which == cvB_mem->cv_index ) break; /* advance */ cvB_mem = cvB_mem->cv_next; } /* cv_mem corresponding to 'which' problem. */ cvodeB_mem = (void *) (cvB_mem->cv_mem); /* Set pfree */ cvB_mem->cv_pfree = NULL; /* Initialize the band preconditioner for this backward problem. */ flag = CVBandPrecInit(cvodeB_mem, nB, muB, mlB); return(flag); } StanHeaders/src/cvodes/cvodes_nls_stg1.c0000644000176200001440000002777213766554457020033 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the CVODES nonlinear solver interface. * ---------------------------------------------------------------------------*/ #include "cvodes_impl.h" #include "sundials/sundials_math.h" /* constant macros */ #define ONE RCONST(1.0) /* private functions */ static int cvNlsResidualSensStg1(N_Vector ycor, N_Vector res, void* cvode_mem); static int cvNlsFPFunctionSensStg1(N_Vector ycor, N_Vector res, void* cvode_mem); static int cvNlsLSetupSensStg1(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* cvode_mem); static int cvNlsLSolveSensStg1(N_Vector ycor, N_Vector delta, void* cvode_mem); static int cvNlsConvTestSensStg1(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* cvode_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int CVodeSetNonlinearSolverSensStg1(void *cvode_mem, SUNNonlinearSolver NLS) { CVodeMem cv_mem; int retval; /* Return immediately if CVode memory is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinearSolverSensStg1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Return immediately if NLS memory is NULL */ if (NLS == NULL) { cvProcessError(NULL, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "NLS must be non-NULL"); return (CV_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "NLS does not support required operations"); return(CV_ILL_INPUT); } /* check that sensitivities were initialized */ if (!(cv_mem->cv_sensi)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", MSGCV_NO_SENSI); return(CV_ILL_INPUT); } /* check that staggered corrector was selected */ if (cv_mem->cv_ism != CV_STAGGERED1) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "Sensitivity solution method is not CV_STAGGERED1"); return(CV_ILL_INPUT); } /* free any existing nonlinear solver */ if ((cv_mem->NLSstg1 != NULL) && (cv_mem->ownNLSstg1)) retval = SUNNonlinSolFree(cv_mem->NLSstg1); /* set SUNNonlinearSolver pointer */ cv_mem->NLSstg1 = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, CVODE will set the flag to SUNTRUE after this function returns. */ cv_mem->ownNLSstg1 = SUNFALSE; /* set the nonlinear system function */ if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_ROOTFIND) { retval = SUNNonlinSolSetSysFn(cv_mem->NLSstg1, cvNlsResidualSensStg1); } else if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_FIXEDPOINT) { retval = SUNNonlinSolSetSysFn(cv_mem->NLSstg1, cvNlsFPFunctionSensStg1); } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "Invalid nonlinear solver type"); return(CV_ILL_INPUT); } if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "Setting nonlinear system function failed"); return(CV_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(cv_mem->NLSstg1, cvNlsConvTestSensStg1); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "Setting convergence test function failed"); return(CV_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(cv_mem->NLSstg1, NLS_MAXCOR); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg1", "Setting maximum number of nonlinear iterations failed"); return(CV_ILL_INPUT); } return(CV_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int cvNlsInitSensStg1(CVodeMem cvode_mem) { int retval; /* set the linear solver setup wrapper function */ if (cvode_mem->cv_lsetup) retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLSstg1, cvNlsLSetupSensStg1); else retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLSstg1, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensStg1", "Setting the linear solver setup function failed"); return(CV_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (cvode_mem->cv_lsolve) retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLSstg1, cvNlsLSolveSensStg1); else retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLSstg1, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensStg1", "Setting linear solver solve function failed"); return(CV_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(cvode_mem->NLSstg1); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensStg1", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } /* reset previous iteration count for updating nniS1 */ cvode_mem->nnip = 0; return(CV_SUCCESS); } static int cvNlsLSetupSensStg1(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsLSetupSensStg1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* if the nonlinear solver marked the Jacobian as bad update convfail */ if (jbad) cv_mem->convfail = CV_FAIL_BAD_J; /* setup the linear solver */ retval = cv_mem->cv_lsetup(cv_mem, cv_mem->convfail, cv_mem->cv_y, cv_mem->cv_ftemp, &(cv_mem->cv_jcur), cv_mem->cv_vtemp1, cv_mem->cv_vtemp2, cv_mem->cv_vtemp3); cv_mem->cv_nsetups++; cv_mem->cv_nsetupsS++; /* update Jacobian status */ *jcur = cv_mem->cv_jcur; cv_mem->cv_gamrat = ONE; cv_mem->cv_gammap = cv_mem->cv_gamma; cv_mem->cv_crate = ONE; cv_mem->cv_crateS = ONE; cv_mem->cv_nstlp = cv_mem->cv_nst; if (retval < 0) return(CV_LSETUP_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); return(CV_SUCCESS); } static int cvNlsLSolveSensStg1(N_Vector ycor, N_Vector delta, void* cvode_mem) { CVodeMem cv_mem; int retval, is; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsLSolveSensStg1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* get index of current sensitivity solve */ is = cv_mem->sens_solve_idx; /* solve the sensitivity linear systems */ retval = cv_mem->cv_lsolve(cv_mem, delta, cv_mem->cv_ewtS[is], cv_mem->cv_y, cv_mem->cv_ftemp); if (retval < 0) return(CV_LSOLVE_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); return(CV_SUCCESS); } static int cvNlsConvTestSensStg1(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector delta, realtype tol, N_Vector ewt, void* cvode_mem) { CVodeMem cv_mem; int m, retval; realtype del; realtype dcon; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsConvTestSensStg1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* compute the norm of the state and sensitivity corrections */ del = N_VWrmsNorm(delta, ewt); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != CV_SUCCESS) return(CV_MEM_NULL); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crate, and used in the test. */ if (m > 0) { cv_mem->cv_crateS = SUNMAX(CRDOWN * cv_mem->cv_crateS, del/cv_mem->cv_delp); } dcon = del * SUNMIN(ONE, cv_mem->cv_crateS) / tol; /* check if nonlinear system was solved successfully */ if (dcon <= ONE) return(CV_SUCCESS); /* check if the iteration seems to be diverging */ if ((m >= 1) && (del > RDIV*cv_mem->cv_delp)) return(SUN_NLS_CONV_RECVR); /* Save norm of correction and loop again */ cv_mem->cv_delp = del; /* Not yet converged */ return(SUN_NLS_CONTINUE); } static int cvNlsResidualSensStg1(N_Vector ycor, N_Vector res, void* cvode_mem) { CVodeMem cv_mem; int retval, is; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsResidualSensStg1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* get index of current sensitivity solve */ is = cv_mem->sens_solve_idx; /* update sensitivity based on the current correction */ N_VLinearSum(ONE, cv_mem->cv_znS[0][is], ONE, ycor, cv_mem->cv_yS[is]); /* evaluate the sensitivity rhs function */ retval = cvSensRhs1Wrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, is, cv_mem->cv_yS[is], cv_mem->cv_ftempS[is], cv_mem->cv_vtemp1, cv_mem->cv_vtemp2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* compute the sensitivity resiudal */ N_VLinearSum(cv_mem->cv_rl1, cv_mem->cv_znS[1][is], ONE, ycor, res); N_VLinearSum(-cv_mem->cv_gamma, cv_mem->cv_ftempS[is], ONE, res, res); return(CV_SUCCESS); } static int cvNlsFPFunctionSensStg1(N_Vector ycor, N_Vector res, void* cvode_mem) { CVodeMem cv_mem; int retval, is; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsFPFunctionSensStg1", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* get index of current sensitivity solve */ is = cv_mem->sens_solve_idx; /* update the sensitivities based on the current correction */ N_VLinearSum(ONE, cv_mem->cv_znS[0][is], ONE, ycor, cv_mem->cv_yS[is]); /* evaluate the sensitivity rhs function */ retval = cvSensRhs1Wrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, is, cv_mem->cv_yS[is], res, cv_mem->cv_vtemp1, cv_mem->cv_vtemp2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* evaluate sensitivity fixed point function */ N_VLinearSum(cv_mem->cv_h, res, -ONE, cv_mem->cv_znS[1][is], res); N_VScale(cv_mem->cv_rl1, res, res); return(CV_SUCCESS); } StanHeaders/src/cvodes/NOTICE0000644000176200001440000000221613766554456015457 0ustar liggesusersThis work was produced under the auspices of the U.S. Department of Energy by Lawrence Livermore National Laboratory under Contract DE-AC52-07NA27344. This work was prepared as an account of work sponsored by an agency of the United States Government. Neither the United States Government nor Lawrence Livermore National Security, LLC, nor any of their employees makes any warranty, expressed or implied, or assumes any legal liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately owned rights. Reference herein to any specific commercial product, process, or service by trade name, trademark, manufacturer, or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or Lawrence Livermore National Security, LLC. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or Lawrence Livermore National Security, LLC, and shall not be used for advertising or product endorsement purposes.StanHeaders/src/cvodes/cvodes_direct.c0000644000176200001440000000456713766554456017547 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated direct linear solver interface in * CVODES; these routines now just wrap the updated CVODE generic * linear solver interface in cvodes_ls.h. * -----------------------------------------------------------------*/ #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Exported Functions (wrappers for equivalent routines in cvodes_ls.h) =================================================================*/ int CVDlsSetLinearSolver(void *cvode_mem, SUNLinearSolver LS, SUNMatrix A) { return(CVodeSetLinearSolver(cvode_mem, LS, A)); } int CVDlsSetJacFn(void *cvode_mem, CVDlsJacFn jac) { return(CVodeSetJacFn(cvode_mem, jac)); } int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS) { return(CVodeGetLinWorkSpace(cvode_mem, lenrwLS, leniwLS)); } int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals) { return(CVodeGetNumJacEvals(cvode_mem, njevals)); } int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS) { return(CVodeGetNumLinRhsEvals(cvode_mem, nfevalsLS)); } int CVDlsGetLastFlag(void *cvode_mem, long int *flag) { return(CVodeGetLastLinFlag(cvode_mem, flag)); } char *CVDlsGetReturnFlagName(long int flag) { return(CVodeGetLinReturnFlagName(flag)); } int CVDlsSetLinearSolverB(void *cvode_mem, int which, SUNLinearSolver LS, SUNMatrix A) { return(CVodeSetLinearSolverB(cvode_mem, which, LS, A)); } int CVDlsSetJacFnB(void *cvode_mem, int which, CVDlsJacFnB jacB) { return(CVodeSetJacFnB(cvode_mem, which, jacB)); } int CVDlsSetJacFnBS(void *cvode_mem, int which, CVDlsJacFnBS jacBS) { return(CVodeSetJacFnBS(cvode_mem, which, jacBS)); } #ifdef __cplusplus } #endif StanHeaders/src/cvodes/cvodes_nls_stg.c0000644000176200001440000003532713766554457017745 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the CVODES nonlinear solver interface. * ---------------------------------------------------------------------------*/ #include "cvodes_impl.h" #include "sundials/sundials_math.h" #include "sundials/sundials_nvector_senswrapper.h" /* constant macros */ #define ONE RCONST(1.0) /* private functions */ static int cvNlsResidualSensStg(N_Vector ycorStg, N_Vector resStg, void* cvode_mem); static int cvNlsFPFunctionSensStg(N_Vector ycorStg, N_Vector resStg, void* cvode_mem); static int cvNlsLSetupSensStg(N_Vector ycorStg, N_Vector resStg, booleantype jbad, booleantype* jcur, void* cvode_mem); static int cvNlsLSolveSensStg(N_Vector ycorStg, N_Vector deltaStg, void* cvode_mem); static int cvNlsConvTestSensStg(SUNNonlinearSolver NLS, N_Vector ycorStg, N_Vector delStg, realtype tol, N_Vector ewtStg, void* cvode_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int CVodeSetNonlinearSolverSensStg(void *cvode_mem, SUNNonlinearSolver NLS) { CVodeMem cv_mem; int retval, is; /* Return immediately if CVode memory is NULL */ if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "CVodeSetNonlinearSolverSensStg", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* Return immediately if NLS memory is NULL */ if (NLS == NULL) { cvProcessError(NULL, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "NLS must be non-NULL"); return (CV_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "NLS does not support required operations"); return(CV_ILL_INPUT); } /* check that sensitivities were initialized */ if (!(cv_mem->cv_sensi)) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", MSGCV_NO_SENSI); return(CV_ILL_INPUT); } /* check that staggered corrector was selected */ if (cv_mem->cv_ism != CV_STAGGERED) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "Sensitivity solution method is not CV_STAGGERED"); return(CV_ILL_INPUT); } /* free any existing nonlinear solver */ if ((cv_mem->NLSstg != NULL) && (cv_mem->ownNLSstg)) retval = SUNNonlinSolFree(cv_mem->NLSstg); /* set SUNNonlinearSolver pointer */ cv_mem->NLSstg = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, CVODE will set the flag to SUNTRUE after this function returns. */ cv_mem->ownNLSstg = SUNFALSE; /* set the nonlinear system function */ if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_ROOTFIND) { retval = SUNNonlinSolSetSysFn(cv_mem->NLSstg, cvNlsResidualSensStg); } else if (SUNNonlinSolGetType(NLS) == SUNNONLINEARSOLVER_FIXEDPOINT) { retval = SUNNonlinSolSetSysFn(cv_mem->NLSstg, cvNlsFPFunctionSensStg); } else { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "Invalid nonlinear solver type"); return(CV_ILL_INPUT); } if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "Setting nonlinear system function failed"); return(CV_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(cv_mem->NLSstg, cvNlsConvTestSensStg); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "Setting convergence test function failed"); return(CV_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(cv_mem->NLSstg, NLS_MAXCOR); if (retval != CV_SUCCESS) { cvProcessError(cv_mem, CV_ILL_INPUT, "CVODES", "CVodeSetNonlinearSolverSensStg", "Setting maximum number of nonlinear iterations failed"); return(CV_ILL_INPUT); } /* create vector wrappers if necessary */ if (cv_mem->stgMallocDone == SUNFALSE) { cv_mem->ycor0Stg = N_VNewEmpty_SensWrapper(cv_mem->cv_Ns); if (cv_mem->ycor0Stg == NULL) { cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSetNonlinearSolverSensStg", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->ycorStg = N_VNewEmpty_SensWrapper(cv_mem->cv_Ns); if (cv_mem->ycorStg == NULL) { N_VDestroy(cv_mem->ycor0Stg); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSetNonlinearSolverSensStg", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->ewtStg = N_VNewEmpty_SensWrapper(cv_mem->cv_Ns); if (cv_mem->ewtStg == NULL) { N_VDestroy(cv_mem->ycor0Stg); N_VDestroy(cv_mem->ycorStg); cvProcessError(cv_mem, CV_MEM_FAIL, "CVODES", "CVodeSetNonlinearSolverSensStg", MSGCV_MEM_FAIL); return(CV_MEM_FAIL); } cv_mem->stgMallocDone = SUNTRUE; } /* attach vectors to vector wrappers */ for (is=0; is < cv_mem->cv_Ns; is++) { NV_VEC_SW(cv_mem->ycor0Stg, is) = cv_mem->cv_tempvS[is]; NV_VEC_SW(cv_mem->ycorStg, is) = cv_mem->cv_acorS[is]; NV_VEC_SW(cv_mem->ewtStg, is) = cv_mem->cv_ewtS[is]; } return(CV_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int cvNlsInitSensStg(CVodeMem cvode_mem) { int retval; /* set the linear solver setup wrapper function */ if (cvode_mem->cv_lsetup) retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLSstg, cvNlsLSetupSensStg); else retval = SUNNonlinSolSetLSetupFn(cvode_mem->NLSstg, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensStg", "Setting the linear solver setup function failed"); return(CV_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (cvode_mem->cv_lsolve) retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLSstg, cvNlsLSolveSensStg); else retval = SUNNonlinSolSetLSolveFn(cvode_mem->NLSstg, NULL); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensStg", "Setting linear solver solve function failed"); return(CV_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(cvode_mem->NLSstg); if (retval != CV_SUCCESS) { cvProcessError(cvode_mem, CV_ILL_INPUT, "CVODES", "cvNlsInitSensStg", MSGCV_NLS_INIT_FAIL); return(CV_NLS_INIT_FAIL); } return(CV_SUCCESS); } static int cvNlsLSetupSensStg(N_Vector ycorStg, N_Vector resStg, booleantype jbad, booleantype* jcur, void* cvode_mem) { CVodeMem cv_mem; int retval; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsLSetupSensStg", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* if the nonlinear solver marked the Jacobian as bad update convfail */ if (jbad) cv_mem->convfail = CV_FAIL_BAD_J; /* setup the linear solver */ retval = cv_mem->cv_lsetup(cv_mem, cv_mem->convfail, cv_mem->cv_y, cv_mem->cv_ftemp, &(cv_mem->cv_jcur), cv_mem->cv_vtemp1, cv_mem->cv_vtemp2, cv_mem->cv_vtemp3); cv_mem->cv_nsetups++; cv_mem->cv_nsetupsS++; /* update Jacobian status */ *jcur = cv_mem->cv_jcur; cv_mem->cv_gamrat = ONE; cv_mem->cv_gammap = cv_mem->cv_gamma; cv_mem->cv_crate = ONE; cv_mem->cv_crateS = ONE; cv_mem->cv_nstlp = cv_mem->cv_nst; if (retval < 0) return(CV_LSETUP_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); return(CV_SUCCESS); } static int cvNlsLSolveSensStg(N_Vector ycorStg, N_Vector deltaStg, void* cvode_mem) { CVodeMem cv_mem; int retval, is; N_Vector *deltaS; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsLSolveSensStg", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract sensitivity deltas from the vector wrapper */ deltaS = NV_VECS_SW(deltaStg); /* solve the sensitivity linear systems */ for (is=0; iscv_Ns; is++) { retval = cv_mem->cv_lsolve(cv_mem, deltaS[is], cv_mem->cv_ewtS[is], cv_mem->cv_y, cv_mem->cv_ftemp); if (retval < 0) return(CV_LSOLVE_FAIL); if (retval > 0) return(SUN_NLS_CONV_RECVR); } return(CV_SUCCESS); } static int cvNlsConvTestSensStg(SUNNonlinearSolver NLS, N_Vector ycorStg, N_Vector deltaStg, realtype tol, N_Vector ewtStg, void* cvode_mem) { CVodeMem cv_mem; int m, retval; realtype Del; realtype dcon; N_Vector *ycorS, *deltaS, *ewtS; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsConvTestSensStg", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract the current sensitivity corrections */ ycorS = NV_VECS_SW(ycorStg); /* extract the sensitivity deltas */ deltaS = NV_VECS_SW(deltaStg); /* extract the sensitivity error weights */ ewtS = NV_VECS_SW(ewtStg); /* compute the norm of the state and sensitivity corrections */ Del = cvSensNorm(cv_mem, deltaS, ewtS); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != CV_SUCCESS) return(CV_MEM_NULL); /* Test for convergence. If m > 0, an estimate of the convergence rate constant is stored in crate, and used in the test. Recall that, even when errconS=SUNFALSE, all variables are used in the convergence test. Hence, we use Del (and not del). However, acnrm is used in the error test and thus it has different forms depending on errconS (and this explains why we have to carry around del and delS). */ if (m > 0) { cv_mem->cv_crateS = SUNMAX(CRDOWN * cv_mem->cv_crateS, Del/cv_mem->cv_delp); } dcon = Del * SUNMIN(ONE, cv_mem->cv_crateS) / tol; /* check if nonlinear system was solved successfully */ if (dcon <= ONE) { if (cv_mem->cv_errconS) cv_mem->cv_acnrmS = (m==0) ? Del : cvSensNorm(cv_mem, ycorS, ewtS); return(CV_SUCCESS); } /* check if the iteration seems to be diverging */ if ((m >= 1) && (Del > RDIV*cv_mem->cv_delp)) return(SUN_NLS_CONV_RECVR); /* Save norm of correction and loop again */ cv_mem->cv_delp = Del; /* Not yet converged */ return(SUN_NLS_CONTINUE); } static int cvNlsResidualSensStg(N_Vector ycorStg, N_Vector resStg, void* cvode_mem) { CVodeMem cv_mem; int retval; N_Vector *ycorS, *resS; realtype cvals[3]; N_Vector* XXvecs[3]; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsResidualSensStg", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract sensitivity and residual vectors from the vector wrapper */ ycorS = NV_VECS_SW(ycorStg); resS = NV_VECS_SW(resStg); /* update sensitivities based on the current correction */ retval = N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[0], ONE, ycorS, cv_mem->cv_yS); if (retval != CV_SUCCESS) return(CV_VECTOROP_ERR); /* evaluate the sensitivity rhs function */ retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, cv_mem->cv_yS, cv_mem->cv_ftempS, cv_mem->cv_vtemp1, cv_mem->cv_vtemp2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* compute the sensitivity resiudal */ cvals[0] = cv_mem->cv_rl1; XXvecs[0] = cv_mem->cv_znS[1]; cvals[1] = ONE; XXvecs[1] = ycorS; cvals[2] = -cv_mem->cv_gamma; XXvecs[2] = cv_mem->cv_ftempS; retval = N_VLinearCombinationVectorArray(cv_mem->cv_Ns, 3, cvals, XXvecs, resS); if (retval != CV_SUCCESS) return(CV_VECTOROP_ERR); return(CV_SUCCESS); } static int cvNlsFPFunctionSensStg(N_Vector ycorStg, N_Vector resStg, void* cvode_mem) { CVodeMem cv_mem; int retval, is; N_Vector *ycorS, *resS; if (cvode_mem == NULL) { cvProcessError(NULL, CV_MEM_NULL, "CVODES", "cvNlsFPFunctionSensStg", MSGCV_NO_MEM); return(CV_MEM_NULL); } cv_mem = (CVodeMem) cvode_mem; /* extract sensitivity and residual vectors from the vector wrapper */ ycorS = NV_VECS_SW(ycorStg); resS = NV_VECS_SW(resStg); /* update the sensitivities based on the current correction */ retval = N_VLinearSumVectorArray(cv_mem->cv_Ns, ONE, cv_mem->cv_znS[0], ONE, ycorS, cv_mem->cv_yS); if (retval != CV_SUCCESS) return(CV_VECTOROP_ERR); /* evaluate the sensitivity rhs function */ retval = cvSensRhsWrapper(cv_mem, cv_mem->cv_tn, cv_mem->cv_y, cv_mem->cv_ftemp, cv_mem->cv_yS, resS, cv_mem->cv_vtemp1, cv_mem->cv_vtemp2); if (retval < 0) return(CV_SRHSFUNC_FAIL); if (retval > 0) return(SRHSFUNC_RECVR); /* evaluate sensitivity fixed point function */ for (is=0; iscv_Ns; is++) { N_VLinearSum(cv_mem->cv_h, resS[is], -ONE, cv_mem->cv_znS[1][is], resS[is]); N_VScale(cv_mem->cv_rl1, resS[is], resS[is]); } return(CV_SUCCESS); } StanHeaders/src/cvodes/cvodes_impl.h0000644000176200001440000014462213766554456017240 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Implementation header file for the main CVODES integrator. * ----------------------------------------------------------------- */ #ifndef _CVODES_IMPL_H #define _CVODES_IMPL_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ================================================================= * I N T E R N A L C V O D E S C O N S T A N T S * ================================================================= */ /* Basic CVODES constants */ #define ADAMS_Q_MAX 12 /* max value of q for lmm == ADAMS */ #define BDF_Q_MAX 5 /* max value of q for lmm == BDF */ #define Q_MAX ADAMS_Q_MAX /* max value of q for either lmm */ #define L_MAX (Q_MAX+1) /* max value of L for either lmm */ #define NUM_TESTS 5 /* number of error test quantities */ #define HMIN_DEFAULT RCONST(0.0) /* hmin default value */ #define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ #define MXHNIL_DEFAULT 10 /* mxhnil default value */ #define MXSTEP_DEFAULT 500 /* mxstep default value */ /* Return values for lower level routines used by CVode and functions provided to the nonlinear solver */ #define RHSFUNC_RECVR +9 #define SRHSFUNC_RECVR +12 /* nonlinear solver constants NLS_MAXCOR maximum no. of corrector iterations for the nonlinear solver CRDOWN constant used in the estimation of the convergence rate (crate) of the iterates for the nonlinear equation RDIV declare divergence if ratio del/delp > RDIV */ #define NLS_MAXCOR 3 #define CRDOWN RCONST(0.3) #define RDIV RCONST(2.0) /* * ================================================================= * F O R W A R D P O I N T E R R E F E R E N C E S * ================================================================= */ typedef struct CVadjMemRec *CVadjMem; typedef struct CkpntMemRec *CkpntMem; typedef struct DtpntMemRec *DtpntMem; typedef struct CVodeBMemRec *CVodeBMem; /* * ================================================================= * M A I N I N T E G R A T O R M E M O R Y B L O C K * ================================================================= */ /* * ----------------------------------------------------------------- * Types: struct CVodeMemRec, CVodeMem * ----------------------------------------------------------------- * The type CVodeMem is type pointer to struct CVodeMemRec. * This structure contains fields to keep track of problem state. * ----------------------------------------------------------------- */ typedef struct CVodeMemRec { realtype cv_uround; /* machine unit roundoff */ /*-------------------------- Problem Specification Data --------------------------*/ CVRhsFn cv_f; /* y' = f(t,y(t)) */ void *cv_user_data; /* user pointer passed to f */ int cv_lmm; /* lmm = ADAMS or BDF */ int cv_itol; /* itol = CV_SS, CV_SV, or CV_WF, or CV_NN */ realtype cv_reltol; /* relative tolerance */ realtype cv_Sabstol; /* scalar absolute tolerance */ N_Vector cv_Vabstol; /* vector absolute tolerance */ booleantype cv_user_efun; /* SUNTRUE if user sets efun */ CVEwtFn cv_efun; /* function to set ewt */ void *cv_e_data; /* user pointer passed to efun */ booleantype cv_constraintsSet; /* constraints vector present: do constraints calc */ /*----------------------- Quadrature Related Data -----------------------*/ booleantype cv_quadr; /* SUNTRUE if integrating quadratures */ CVQuadRhsFn cv_fQ; /* q' = fQ(t, y(t)) */ booleantype cv_errconQ; /* SUNTRUE if quadrs. are included in error test */ int cv_itolQ; /* itolQ = CV_SS or CV_SV */ realtype cv_reltolQ; /* relative tolerance for quadratures */ realtype cv_SabstolQ; /* scalar absolute tolerance for quadratures */ N_Vector cv_VabstolQ; /* vector absolute tolerance for quadratures */ /*------------------------ Sensitivity Related Data ------------------------*/ booleantype cv_sensi; /* SUNTRUE if computing sensitivities */ int cv_Ns; /* Number of sensitivities */ int cv_ism; /* ism = SIMULTANEOUS or STAGGERED */ CVSensRhsFn cv_fS; /* fS = (df/dy)*yS + (df/dp) */ CVSensRhs1Fn cv_fS1; /* fS1 = (df/dy)*yS_i + (df/dp) */ void *cv_fS_data; /* data pointer passed to fS */ booleantype cv_fSDQ; /* SUNTRUE if using internal DQ functions */ int cv_ifS; /* ifS = ALLSENS or ONESENS */ realtype *cv_p; /* parameters in f(t,y,p) */ realtype *cv_pbar; /* scale factors for parameters */ int *cv_plist; /* list of sensitivities */ int cv_DQtype; /* central/forward finite differences */ realtype cv_DQrhomax; /* cut-off value for separate/simultaneous FD */ booleantype cv_errconS; /* SUNTRUE if yS are considered in err. control */ int cv_itolS; realtype cv_reltolS; /* relative tolerance for sensitivities */ realtype *cv_SabstolS; /* scalar absolute tolerances for sensi. */ N_Vector *cv_VabstolS; /* vector absolute tolerances for sensi. */ /*----------------------------------- Quadrature Sensitivity Related Data -----------------------------------*/ booleantype cv_quadr_sensi; /* SUNTRUE if computing sensitivties of quadrs. */ CVQuadSensRhsFn cv_fQS; /* fQS = (dfQ/dy)*yS + (dfQ/dp) */ void *cv_fQS_data; /* data pointer passed to fQS */ booleantype cv_fQSDQ; /* SUNTRUE if using internal DQ functions */ booleantype cv_errconQS; /* SUNTRUE if yQS are considered in err. con. */ int cv_itolQS; realtype cv_reltolQS; /* relative tolerance for yQS */ realtype *cv_SabstolQS; /* scalar absolute tolerances for yQS */ N_Vector *cv_VabstolQS; /* vector absolute tolerances for yQS */ /*----------------------- Nordsieck History Array -----------------------*/ N_Vector cv_zn[L_MAX]; /* Nordsieck array, of size N x (q+1). zn[j] is a vector of length N (j=0,...,q) zn[j] = [1/factorial(j)] * h^j * (jth derivative of the interpolating poly.) */ /*------------------- Vectors of length N -------------------*/ N_Vector cv_ewt; /* error weight vector */ N_Vector cv_y; /* y is used as temporary storage by the solver. The memory is provided by the user to CVode where the vector is named yout. */ N_Vector cv_acor; /* In the context of the solution of the nonlinear equation, acor = y_n(m) - y_n(0). On return, this vector is scaled to give the estimated local error in y. */ N_Vector cv_tempv; /* temporary storage vector */ N_Vector cv_ftemp; /* temporary storage vector */ N_Vector cv_vtemp1; /* temporary storage vector */ N_Vector cv_vtemp2; /* temporary storage vector */ N_Vector cv_vtemp3; /* temporary storage vector */ N_Vector cv_mm; /* mask vector in constraints tests */ N_Vector cv_constraints; /* vector of inequality constraint options */ /*-------------------------- Quadrature Related Vectors --------------------------*/ N_Vector cv_znQ[L_MAX]; /* Nordsieck arrays for quadratures */ N_Vector cv_ewtQ; /* error weight vector for quadratures */ N_Vector cv_yQ; /* Unlike y, yQ is not allocated by the user */ N_Vector cv_acorQ; /* acorQ = yQ_n(m) - yQ_n(0) */ N_Vector cv_tempvQ; /* temporary storage vector (~ tempv) */ /*--------------------------- Sensitivity Related Vectors ---------------------------*/ N_Vector *cv_znS[L_MAX]; /* Nordsieck arrays for sensitivities */ N_Vector *cv_ewtS; /* error weight vectors for sensitivities */ N_Vector *cv_yS; /* yS=yS0 (allocated by the user) */ N_Vector *cv_acorS; /* acorS = yS_n(m) - yS_n(0) */ N_Vector *cv_tempvS; /* temporary storage vector (~ tempv) */ N_Vector *cv_ftempS; /* temporary storage vector (~ ftemp) */ booleantype cv_stgr1alloc; /* Did we allocate ncfS1, ncfnS1, and nniS1? */ /*-------------------------------------- Quadrature Sensitivity Related Vectors --------------------------------------*/ N_Vector *cv_znQS[L_MAX]; /* Nordsieck arrays for quadr. sensitivities */ N_Vector *cv_ewtQS; /* error weight vectors for sensitivities */ N_Vector *cv_yQS; /* Unlike yS, yQS is not allocated by the user */ N_Vector *cv_acorQS; /* acorQS = yQS_n(m) - yQS_n(0) */ N_Vector *cv_tempvQS; /* temporary storage vector (~ tempv) */ N_Vector cv_ftempQ; /* temporary storage vector (~ ftemp) */ /*----------------- Tstop information -----------------*/ booleantype cv_tstopset; realtype cv_tstop; /*--------- Step Data ---------*/ int cv_q; /* current order */ int cv_qprime; /* order to be used on the next step * qprime = q-1, q, or q+1 */ int cv_next_q; /* order to be used on the next step */ int cv_qwait; /* number of internal steps to wait before * considering a change in q */ int cv_L; /* L = q + 1 */ realtype cv_hin; realtype cv_h; /* current step size */ realtype cv_hprime; /* step size to be used on the next step */ realtype cv_next_h; /* step size to be used on the next step */ realtype cv_eta; /* eta = hprime / h */ realtype cv_hscale; /* value of h used in zn */ realtype cv_tn; /* current internal value of t */ realtype cv_tretlast; /* last value of t returned */ realtype cv_tau[L_MAX+1]; /* array of previous q+1 successful step * sizes indexed from 1 to q+1 */ realtype cv_tq[NUM_TESTS+1]; /* array of test quantities indexed from * 1 to NUM_TESTS(=5) */ realtype cv_l[L_MAX]; /* coefficients of l(x) (degree q poly) */ realtype cv_rl1; /* the scalar 1/l[1] */ realtype cv_gamma; /* gamma = h * rl1 */ realtype cv_gammap; /* gamma at the last setup call */ realtype cv_gamrat; /* gamma / gammap */ realtype cv_crate; /* est. corrector conv. rate in Nls */ realtype cv_crateS; /* est. corrector conv. rate in NlsStgr */ realtype cv_delp; /* norm of previous nonlinear solver update */ realtype cv_acnrm; /* | acor | */ realtype cv_acnrmQ; /* | acorQ | */ realtype cv_acnrmS; /* | acorS | */ realtype cv_acnrmQS; /* | acorQS | */ realtype cv_nlscoef; /* coeficient in nonlinear convergence test */ int *cv_ncfS1; /* Array of Ns local counters for conv. * failures (used in CVStep for STAGGERED1) */ /*------ Limits ------*/ int cv_qmax; /* q <= qmax */ long int cv_mxstep; /* maximum number of internal steps for one user call */ int cv_mxhnil; /* max. number of warning messages issued to the user that t + h == t for the next internal step */ int cv_maxnef; /* maximum number of error test failures */ int cv_maxncf; /* maximum number of nonlinear conv. failures */ realtype cv_hmin; /* |h| >= hmin */ realtype cv_hmax_inv; /* |h| <= 1/hmax_inv */ realtype cv_etamax; /* eta <= etamax */ /*---------- Counters ----------*/ long int cv_nst; /* number of internal steps taken */ long int cv_nfe; /* number of f calls */ long int cv_nfQe; /* number of fQ calls */ long int cv_nfSe; /* number of fS calls */ long int cv_nfeS; /* number of f calls from sensi DQ */ long int cv_nfQSe; /* number of fQS calls */ long int cv_nfQeS; /* number of fQ calls from sensi DQ */ long int cv_ncfn; /* number of corrector convergence failures */ long int cv_ncfnS; /* number of total sensi. corr. conv. failures */ long int *cv_ncfnS1; /* number of sensi. corrector conv. failures */ long int cv_nni; /* number of nonlinear iterations performed */ long int cv_nniS; /* number of total sensi. nonlinear iterations */ long int *cv_nniS1; /* number of sensi. nonlinear iterations */ long int cv_netf; /* number of error test failures */ long int cv_netfQ; /* number of quadr. error test failures */ long int cv_netfS; /* number of sensi. error test failures */ long int cv_netfQS; /* number of quadr. sensi. error test failures */ long int cv_nsetups; /* number of setup calls */ long int cv_nsetupsS; /* number of setup calls due to sensitivities */ int cv_nhnil; /* number of messages issued to the user that t + h == t for the next iternal step */ /*----------------------------- Space requirements for CVODES -----------------------------*/ sunindextype cv_lrw1; /* no. of realtype words in 1 N_Vector y */ sunindextype cv_liw1; /* no. of integer words in 1 N_Vector y */ sunindextype cv_lrw1Q; /* no. of realtype words in 1 N_Vector yQ */ sunindextype cv_liw1Q; /* no. of integer words in 1 N_Vector yQ */ long int cv_lrw; /* no. of realtype words in CVODES work vectors */ long int cv_liw; /* no. of integer words in CVODES work vectors */ /*---------------- Step size ratios ----------------*/ realtype cv_etaqm1; /* ratio of new to old h for order q-1 */ realtype cv_etaq; /* ratio of new to old h for order q */ realtype cv_etaqp1; /* ratio of new to old h for order q+1 */ /*--------------------- Nonlinear Solver Data ---------------------*/ SUNNonlinearSolver NLS; /* nonlinear solver object for ODE solves */ booleantype ownNLS; /* flag indicating NLS ownership */ SUNNonlinearSolver NLSsim; /* NLS object for the simultaneous corrector */ booleantype ownNLSsim; /* flag indicating NLS ownership */ SUNNonlinearSolver NLSstg; /* NLS object for the staggered corrector */ booleantype ownNLSstg; /* flag indicating NLS ownership */ SUNNonlinearSolver NLSstg1; /* NLS object for the staggered1 corrector */ booleantype ownNLSstg1; /* flag indicating NLS ownership */ int sens_solve_idx; /* index of the current staggered1 solve */ long int nnip; /* previous total number of iterations */ booleantype sens_solve; /* flag indicating if the current solve is a staggered or staggered1 sensitivity solve */ int convfail; /* flag to indicate when a Jacobian update may be needed */ /* The following vectors are NVector wrappers for use with the simultaneous and staggered corrector methods: Simultaneous: ycor0Sim = [ida_delta, ida_deltaS] ycorSim = [ida_ee, ida_eeS] ewtSim = [ida_ewt, ida_ewtS] Staggered: ycor0Stg = ida_deltaS ycorStg = ida_eeS ewtStg = ida_ewtS */ N_Vector ycor0Sim, ycorSim, ewtSim; N_Vector ycor0Stg, ycorStg, ewtStg; /* flags indicating if vector wrappers for the simultaneous and staggered correctors have been allocated */ booleantype simMallocDone; booleantype stgMallocDone; /*------------------ Linear Solver Data ------------------*/ /* Linear Solver functions to be called */ int (*cv_linit)(struct CVodeMemRec *cv_mem); int (*cv_lsetup)(struct CVodeMemRec *cv_mem, int convfail, N_Vector ypred, N_Vector fpred, booleantype *jcurPtr, N_Vector vtemp1, N_Vector vtemp2, N_Vector vtemp3); int (*cv_lsolve)(struct CVodeMemRec *cv_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector fcur); int (*cv_lfree)(struct CVodeMemRec *cv_mem); /* Linear Solver specific memory */ void *cv_lmem; /* Flag to request a call to the setup routine */ booleantype cv_forceSetup; /*------------ Saved Values ------------*/ int cv_qu; /* last successful q value used */ long int cv_nstlp; /* step number of last setup call */ realtype cv_h0u; /* actual initial stepsize */ realtype cv_hu; /* last successful h value used */ realtype cv_saved_tq5; /* saved value of tq[5] */ booleantype cv_jcur; /* is Jacobian info for linear solver current? */ int cv_convfail; /* flag storing previous solver failure mode */ realtype cv_tolsf; /* tolerance scale factor */ int cv_qmax_alloc; /* qmax used when allocating mem */ int cv_qmax_allocQ; /* qmax used when allocating quad. mem */ int cv_qmax_allocS; /* qmax used when allocating sensi. mem */ int cv_qmax_allocQS; /* qmax used when allocating quad. sensi. mem */ int cv_indx_acor; /* index of zn vector in which acor is saved */ /*-------------------------------------------------------------------- Flags turned ON by CVodeInit, CVodeSensMalloc, and CVodeQuadMalloc and read by CVodeReInit, CVodeSensReInit, and CVodeQuadReInit --------------------------------------------------------------------*/ booleantype cv_VabstolMallocDone; booleantype cv_MallocDone; booleantype cv_constraintsMallocDone; booleantype cv_VabstolQMallocDone; booleantype cv_QuadMallocDone; booleantype cv_VabstolSMallocDone; booleantype cv_SabstolSMallocDone; booleantype cv_SensMallocDone; booleantype cv_VabstolQSMallocDone; booleantype cv_SabstolQSMallocDone; booleantype cv_QuadSensMallocDone; /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ CVErrHandlerFn cv_ehfun; /* Error messages are handled by ehfun */ void *cv_eh_data; /* dats pointer passed to ehfun */ FILE *cv_errfp; /* CVODES error messages are sent to errfp */ /*------------------------- Stability Limit Detection -------------------------*/ booleantype cv_sldeton; /* Is Stability Limit Detection on? */ realtype cv_ssdat[6][4]; /* scaled data array for STALD */ int cv_nscon; /* counter for STALD method */ long int cv_nor; /* counter for number of order reductions */ /*---------------- Rootfinding Data ----------------*/ CVRootFn cv_gfun; /* Function g for roots sought */ int cv_nrtfn; /* number of components of g */ int *cv_iroots; /* array for root information */ int *cv_rootdir; /* array specifying direction of zero-crossing */ realtype cv_tlo; /* nearest endpoint of interval in root search */ realtype cv_thi; /* farthest endpoint of interval in root search */ realtype cv_trout; /* t value returned by rootfinding routine */ realtype *cv_glo; /* saved array of g values at t = tlo */ realtype *cv_ghi; /* saved array of g values at t = thi */ realtype *cv_grout; /* array of g values at t = trout */ realtype cv_toutc; /* copy of tout (if NORMAL mode) */ realtype cv_ttol; /* tolerance on root location trout */ int cv_taskc; /* copy of parameter itask */ int cv_irfnd; /* flag showing whether last step had a root */ long int cv_nge; /* counter for g evaluations */ booleantype *cv_gactive; /* array with active/inactive event functions */ int cv_mxgnull; /* number of warning messages about possible g==0 */ /*----------------------- Fused Vector Operations -----------------------*/ realtype* cv_cvals; /* array of scalars */ N_Vector* cv_Xvecs; /* array of vectors */ N_Vector* cv_Zvecs; /* array of vectors */ /*------------------------ Adjoint sensitivity data ------------------------*/ booleantype cv_adj; /* SUNTRUE if performing ASA */ struct CVadjMemRec *cv_adj_mem; /* Pointer to adjoint memory structure */ booleantype cv_adjMallocDone; } *CVodeMem; /* * ================================================================= * A D J O I N T M O D U L E M E M O R Y B L O C K * ================================================================= */ /* * ----------------------------------------------------------------- * Types : struct CkpntMemRec, CkpntMem * ----------------------------------------------------------------- * The type CkpntMem is type pointer to struct CkpntMemRec. * This structure contains fields to store all information at a * check point that is needed to 'hot' start cvodes. * ----------------------------------------------------------------- */ struct CkpntMemRec { /* Integration limits */ realtype ck_t0; realtype ck_t1; /* Nordsieck History Array */ N_Vector ck_zn[L_MAX]; /* Do we need to carry quadratures? */ booleantype ck_quadr; /* Nordsieck History Array for quadratures */ N_Vector ck_znQ[L_MAX]; /* Do we need to carry sensitivities? */ booleantype ck_sensi; /* number of sensitivities */ int ck_Ns; /* Nordsieck History Array for sensitivities */ N_Vector *ck_znS[L_MAX]; /* Do we need to carry quadrature sensitivities? */ booleantype ck_quadr_sensi; /* Nordsieck History Array for quadrature sensitivities */ N_Vector *ck_znQS[L_MAX]; /* Was ck_zn[qmax] allocated? ck_zqm = 0 - no ck_zqm = qmax - yes */ int ck_zqm; /* Step data */ long int ck_nst; realtype ck_tretlast; int ck_q; int ck_qprime; int ck_qwait; int ck_L; realtype ck_gammap; realtype ck_h; realtype ck_hprime; realtype ck_hscale; realtype ck_eta; realtype ck_etamax; realtype ck_tau[L_MAX+1]; realtype ck_tq[NUM_TESTS+1]; realtype ck_l[L_MAX]; /* Saved values */ realtype ck_saved_tq5; /* Pointer to next structure in list */ struct CkpntMemRec *ck_next; }; /* * ----------------------------------------------------------------- * Types for functions provided by an interpolation module * ----------------------------------------------------------------- * cvaIMMallocFn: Type for a function that initializes the content * field of the structures in the dt array * cvaIMFreeFn: Type for a function that deallocates the content * field of the structures in the dt array * cvaIMGetYFn: Type for a function that returns the * interpolated forward solution. * cvaIMStorePnt: Type for a function that stores a new * point in the structure d * ----------------------------------------------------------------- */ typedef booleantype (*cvaIMMallocFn)(CVodeMem cv_mem); typedef void (*cvaIMFreeFn)(CVodeMem cv_mem); typedef int (*cvaIMGetYFn)(CVodeMem cv_mem, realtype t, N_Vector y, N_Vector *yS); typedef int (*cvaIMStorePntFn)(CVodeMem cv_mem, DtpntMem d); /* * ----------------------------------------------------------------- * Type : struct DtpntMemRec * ----------------------------------------------------------------- * This structure contains fields to store all information at a * data point that is needed to interpolate solution of forward * simulations. Its content field depends on IMtype. * ----------------------------------------------------------------- */ struct DtpntMemRec { realtype t; /* time */ void *content; /* IMtype-dependent content */ }; /* Data for cubic Hermite interpolation */ typedef struct HermiteDataMemRec { N_Vector y; N_Vector yd; N_Vector *yS; N_Vector *ySd; } *HermiteDataMem; /* Data for polynomial interpolation */ typedef struct PolynomialDataMemRec { N_Vector y; N_Vector *yS; int order; } *PolynomialDataMem; /* * ----------------------------------------------------------------- * Type : struct CVodeBMemRec * ----------------------------------------------------------------- * The type CVodeBMem is a pointer to a structure which stores all * information for ONE backward problem. * The CVadjMem structure contains a linked list of CVodeBMem pointers * ----------------------------------------------------------------- */ struct CVodeBMemRec { /* Index of this backward problem */ int cv_index; /* Time at which the backward problem is initialized */ realtype cv_t0; /* CVODES memory for this backward problem */ CVodeMem cv_mem; /* Flags to indicate that this backward problem's RHS or quad RHS * require forward sensitivities */ booleantype cv_f_withSensi; booleantype cv_fQ_withSensi; /* Right hand side function for backward run */ CVRhsFnB cv_f; CVRhsFnBS cv_fs; /* Right hand side quadrature function for backward run */ CVQuadRhsFnB cv_fQ; CVQuadRhsFnBS cv_fQs; /* User user_data */ void *cv_user_data; /* Memory block for a linear solver's interface to CVODEA */ void *cv_lmem; /* Function to free any memory allocated by the linear solver */ int (*cv_lfree)(CVodeBMem cvB_mem); /* Memory block for a preconditioner's module interface to CVODEA */ void *cv_pmem; /* Function to free any memory allocated by the preconditioner module */ int (*cv_pfree)(CVodeBMem cvB_mem); /* Time at which to extract solution / quadratures */ realtype cv_tout; /* Workspace Nvector */ N_Vector cv_y; /* Pointer to next structure in list */ struct CVodeBMemRec *cv_next; }; /* * ----------------------------------------------------------------- * Type : struct CVadjMemRec * ----------------------------------------------------------------- * The type CVadjMem is type pointer to struct CVadjMemRec. * This structure contins fields to store all information * necessary for adjoint sensitivity analysis. * ----------------------------------------------------------------- */ struct CVadjMemRec { /* -------------------- * Forward problem data * -------------------- */ /* Integration interval */ realtype ca_tinitial, ca_tfinal; /* Flag for first call to CVodeF */ booleantype ca_firstCVodeFcall; /* Flag if CVodeF was called with TSTOP */ booleantype ca_tstopCVodeFcall; realtype ca_tstopCVodeF; /* ---------------------- * Backward problems data * ---------------------- */ /* Storage for backward problems */ struct CVodeBMemRec *cvB_mem; /* Number of backward problems */ int ca_nbckpbs; /* Address of current backward problem */ struct CVodeBMemRec *ca_bckpbCrt; /* Flag for first call to CVodeB */ booleantype ca_firstCVodeBcall; /* ---------------- * Check point data * ---------------- */ /* Storage for check point information */ struct CkpntMemRec *ck_mem; /* Number of check points */ int ca_nckpnts; /* address of the check point structure for which data is available */ struct CkpntMemRec *ca_ckpntData; /* ------------------ * Interpolation data * ------------------ */ /* Number of steps between 2 check points */ long int ca_nsteps; /* Last index used in CVAfindIndex */ long int ca_ilast; /* Storage for data from forward runs */ struct DtpntMemRec **dt_mem; /* Actual number of data points in dt_mem (typically np=nsteps+1) */ long int ca_np; /* Interpolation type */ int ca_IMtype; /* Functions set by the interpolation module */ cvaIMMallocFn ca_IMmalloc; cvaIMFreeFn ca_IMfree; cvaIMStorePntFn ca_IMstore; /* store a new interpolation point */ cvaIMGetYFn ca_IMget; /* interpolate forward solution */ /* Flags controlling the interpolation module */ booleantype ca_IMmallocDone; /* IM initialized? */ booleantype ca_IMnewData; /* new data available in dt_mem?*/ booleantype ca_IMstoreSensi; /* store sensitivities? */ booleantype ca_IMinterpSensi; /* interpolate sensitivities? */ /* Workspace for the interpolation module */ N_Vector ca_Y[L_MAX]; /* pointers to zn[i] */ N_Vector *ca_YS[L_MAX]; /* pointers to znS[i] */ realtype ca_T[L_MAX]; /* ------------------------------- * Workspace for wrapper functions * ------------------------------- */ N_Vector ca_ytmp; N_Vector *ca_yStmp; }; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R S * ================================================================= */ /* * ----------------------------------------------------------------- * Communication between CVODE and a CVODE Linear Solver * ----------------------------------------------------------------- * convfail (input to cv_lsetup) * * CV_NO_FAILURES : Either this is the first cv_setup call for this * step, or the local error test failed on the * previous attempt at this step (but the nonlinear * solver iteration converged). * * CV_FAIL_BAD_J : This value is passed to cv_lsetup if * * (a) The previous nonlinear solver corrector iteration * did not converge and the linear solver's * setup routine indicated that its Jacobian- * related data is not current * or * (b) During the previous nonlinear solver corrector * iteration, the linear solver's solve routine * failed in a recoverable manner and the * linear solver's setup routine indicated that * its Jacobian-related data is not current. * * CV_FAIL_OTHER : During the current internal step try, the * previous nonlinear solver iteration failed to converge * even though the linear solver was using current * Jacobian-related data. * ----------------------------------------------------------------- */ /* Constants for convfail (input to cv_lsetup) */ #define CV_NO_FAILURES 0 #define CV_FAIL_BAD_J 1 #define CV_FAIL_OTHER 2 /* * ----------------------------------------------------------------- * int (*cv_linit)(CVodeMem cv_mem); * ----------------------------------------------------------------- * The purpose of cv_linit is to complete initializations for a * specific linear solver, such as counters and statistics. * An LInitFn should return 0 if it has successfully initialized the * CVODE linear solver and a negative value otherwise. * If an error does occur, an appropriate message should be sent to * the error handler function. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lsetup)(CVodeMem cv_mem, int convfail, N_Vector ypred, * N_Vector fpred, booleantype *jcurPtr, * N_Vector vtemp1, N_Vector vtemp2, * N_Vector vtemp3); * ----------------------------------------------------------------- * The job of cv_lsetup is to prepare the linear solver for * subsequent calls to cv_lsolve. It may recompute Jacobian- * related data is it deems necessary. Its parameters are as * follows: * * cv_mem - problem memory pointer of type CVodeMem. See the * typedef earlier in this file. * * convfail - a flag to indicate any problem that occurred during * the solution of the nonlinear equation on the * current time step for which the linear solver is * being used. This flag can be used to help decide * whether the Jacobian data kept by a CVODE linear * solver needs to be updated or not. * Its possible values have been documented above. * * ypred - the predicted y vector for the current CVODE internal * step. * * fpred - f(tn, ypred). * * jcurPtr - a pointer to a boolean to be filled in by cv_lsetup. * The function should set *jcurPtr=SUNTRUE if its Jacobian * data is current after the call and should set * *jcurPtr=SUNFALSE if its Jacobian data is not current. * Note: If cv_lsetup calls for re-evaluation of * Jacobian data (based on convfail and CVODE state * data), it should return *jcurPtr=SUNTRUE always; * otherwise an infinite loop can result. * * vtemp1 - temporary N_Vector provided for use by cv_lsetup. * * vtemp3 - temporary N_Vector provided for use by cv_lsetup. * * vtemp3 - temporary N_Vector provided for use by cv_lsetup. * * The cv_lsetup routine should return 0 if successful, a positive * value for a recoverable error, and a negative value for an * unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lsolve)(CVodeMem cv_mem, N_Vector b, N_Vector weight, * N_Vector ycur, N_Vector fcur); * ----------------------------------------------------------------- * cv_lsolve must solve the linear equation P x = b, where * P is some approximation to (I - gamma J), J = (df/dy)(tn,ycur) * and the RHS vector b is input. The N-vector ycur contains * the solver's current approximation to y(tn) and the vector * fcur contains the N_Vector f(tn,ycur). The solution is to be * returned in the vector b. cv_lsolve returns a positive value * for a recoverable error and a negative value for an * unrecoverable error. Success is indicated by a 0 return value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*cv_lfree)(CVodeMem cv_mem); * ----------------------------------------------------------------- * cv_lfree should free up any memory allocated by the linear * solver. This routine is called once a problem has been * completed and the linear solver is no longer needed. It should * return 0 upon success, nonzero on failure. * ----------------------------------------------------------------- */ /* * ================================================================= * C V O D E S I N T E R N A L F U N C T I O N S * ================================================================= */ /* Norm functions */ realtype cvSensNorm(CVodeMem cv_mem, N_Vector *xS, N_Vector *wS); realtype cvSensUpdateNorm(CVodeMem cv_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS); /* Prototype of internal ewtSet function */ int cvEwtSet(N_Vector ycur, N_Vector weight, void *data); /* High level error handler */ void cvProcessError(CVodeMem cv_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void cvErrHandler(int error_code, const char *module, const char *function, char *msg, void *data); /* Prototypes for internal sensitivity rhs wrappers */ int cvSensRhsWrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, N_Vector *yScur, N_Vector *fScur, N_Vector temp1, N_Vector temp2); int cvSensRhs1Wrapper(CVodeMem cv_mem, realtype time, N_Vector ycur, N_Vector fcur, int is, N_Vector yScur, N_Vector fScur, N_Vector temp1, N_Vector temp2); /* Prototypes for internal sensitivity rhs DQ functions */ int cvSensRhsInternalDQ(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *fS_data, N_Vector tempv, N_Vector ftemp); int cvSensRhs1InternalDQ(int Ns, realtype t, N_Vector y, N_Vector ydot, int is, N_Vector yS, N_Vector ySdot, void *fS_data, N_Vector tempv, N_Vector ftemp); /* Nonlinear solver functions */ int cvNlsInit(CVodeMem cv_mem); int cvNlsInitSensSim(CVodeMem cv_mem); int cvNlsInitSensStg(CVodeMem cv_mem); int cvNlsInitSensStg1(CVodeMem cv_mem); /* * ================================================================= * C V O D E S E R R O R M E S S A G E S * ================================================================= */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_TIME "t = %Lg" #define MSG_TIME_H "t = %Lg and h = %Lg" #define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." #define MSG_TIME_TOUT "tout = %Lg" #define MSG_TIME_TSTOP "tstop = %Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_TIME "t = %lg" #define MSG_TIME_H "t = %lg and h = %lg" #define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." #define MSG_TIME_TOUT "tout = %lg" #define MSG_TIME_TSTOP "tstop = %lg" #else #define MSG_TIME "t = %g" #define MSG_TIME_H "t = %g and h = %g" #define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." #define MSG_TIME_TOUT "tout = %g" #define MSG_TIME_TSTOP "tstop = %g" #endif /* Initialization and I/O error messages */ #define MSGCV_NO_MEM "cvode_mem = NULL illegal." #define MSGCV_CVMEM_FAIL "Allocation of cvode_mem failed." #define MSGCV_MEM_FAIL "A memory request failed." #define MSGCV_BAD_LMM "Illegal value for lmm. The legal values are CV_ADAMS and CV_BDF." #define MSGCV_NO_MALLOC "Attempt to call before CVodeInit." #define MSGCV_NEG_MAXORD "maxord <= 0 illegal." #define MSGCV_BAD_MAXORD "Illegal attempt to increase maximum method order." #define MSGCV_SET_SLDET "Attempt to use stability limit detection with the CV_ADAMS method illegal." #define MSGCV_NEG_HMIN "hmin < 0 illegal." #define MSGCV_NEG_HMAX "hmax < 0 illegal." #define MSGCV_BAD_HMIN_HMAX "Inconsistent step size limits: hmin > hmax." #define MSGCV_BAD_RELTOL "reltol < 0 illegal." #define MSGCV_BAD_ABSTOL "abstol has negative component(s) (illegal)." #define MSGCV_NULL_ABSTOL "abstol = NULL illegal." #define MSGCV_NULL_Y0 "y0 = NULL illegal." #define MSGCV_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." #define MSGCV_BAD_ISM_CONSTR "Constraints can not be enforced while forward sensitivity is used with simultaneous method" #define MSGCV_NULL_F "f = NULL illegal." #define MSGCV_NULL_G "g = NULL illegal." #define MSGCV_BAD_NVECTOR "A required vector operation is not implemented." #define MSGCV_BAD_CONSTR "Illegal values in constraints vector." #define MSGCV_BAD_K "Illegal value for k." #define MSGCV_NULL_DKY "dky = NULL illegal." #define MSGCV_BAD_T "Illegal value for t." MSG_TIME_INT #define MSGCV_NO_ROOT "Rootfinding was not initialized." #define MSGCV_NLS_INIT_FAIL "The nonlinear solver's init routine failed." #define MSGCV_NO_QUAD "Quadrature integration not activated." #define MSGCV_BAD_ITOLQ "Illegal value for itolQ. The legal values are CV_SS and CV_SV." #define MSGCV_NULL_ABSTOLQ "abstolQ = NULL illegal." #define MSGCV_BAD_RELTOLQ "reltolQ < 0 illegal." #define MSGCV_BAD_ABSTOLQ "abstolQ has negative component(s) (illegal)." #define MSGCV_SENSINIT_2 "Sensitivity analysis already initialized." #define MSGCV_NO_SENSI "Forward sensitivity analysis not activated." #define MSGCV_BAD_ITOLS "Illegal value for itolS. The legal values are CV_SS, CV_SV, and CV_EE." #define MSGCV_NULL_ABSTOLS "abstolS = NULL illegal." #define MSGCV_BAD_RELTOLS "reltolS < 0 illegal." #define MSGCV_BAD_ABSTOLS "abstolS has negative component(s) (illegal)." #define MSGCV_BAD_PBAR "pbar has zero component(s) (illegal)." #define MSGCV_BAD_PLIST "plist has negative component(s) (illegal)." #define MSGCV_BAD_NS "NS <= 0 illegal." #define MSGCV_NULL_YS0 "yS0 = NULL illegal." #define MSGCV_BAD_ISM "Illegal value for ism. Legal values are: CV_SIMULTANEOUS, CV_STAGGERED and CV_STAGGERED1." #define MSGCV_BAD_IFS "Illegal value for ifS. Legal values are: CV_ALLSENS and CV_ONESENS." #define MSGCV_BAD_ISM_IFS "Illegal ism = CV_STAGGERED1 for CVodeSensInit." #define MSGCV_BAD_IS "Illegal value for is." #define MSGCV_NULL_DKYA "dkyA = NULL illegal." #define MSGCV_BAD_DQTYPE "Illegal value for DQtype. Legal values are: CV_CENTERED and CV_FORWARD." #define MSGCV_BAD_DQRHO "DQrhomax < 0 illegal." #define MSGCV_BAD_ITOLQS "Illegal value for itolQS. The legal values are CV_SS, CV_SV, and CV_EE." #define MSGCV_NULL_ABSTOLQS "abstolQS = NULL illegal." #define MSGCV_BAD_RELTOLQS "reltolQS < 0 illegal." #define MSGCV_BAD_ABSTOLQS "abstolQS has negative component(s) (illegal)." #define MSGCV_NO_QUADSENSI "Forward sensitivity analysis for quadrature variables not activated." #define MSGCV_NULL_YQS0 "yQS0 = NULL illegal." /* CVode Error Messages */ #define MSGCV_NO_TOL "No integration tolerances have been specified." #define MSGCV_LSOLVE_NULL "The linear solver's solve routine is NULL." #define MSGCV_YOUT_NULL "yout = NULL illegal." #define MSGCV_TRET_NULL "tret = NULL illegal." #define MSGCV_BAD_EWT "Initial ewt has component(s) equal to zero (illegal)." #define MSGCV_EWT_NOW_BAD "At " MSG_TIME ", a component of ewt has become <= 0." #define MSGCV_BAD_ITASK "Illegal value for itask." #define MSGCV_BAD_H0 "h0 and tout - t0 inconsistent." #define MSGCV_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration" #define MSGCV_EWT_FAIL "The user-provide EwtSet function failed." #define MSGCV_EWT_NOW_FAIL "At " MSG_TIME ", the user-provide EwtSet function failed." #define MSGCV_LINIT_FAIL "The linear solver's init routine failed." #define MSGCV_HNIL_DONE "The above warning has been issued mxhnil times and will not be issued again for this problem." #define MSGCV_TOO_CLOSE "tout too close to t0 to start integration." #define MSGCV_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." #define MSGCV_TOO_MUCH_ACC "At " MSG_TIME ", too much accuracy requested." #define MSGCV_HNIL "Internal " MSG_TIME_H " are such that t + h = t on the next step. The solver will continue anyway." #define MSGCV_ERR_FAILS "At " MSG_TIME_H ", the error test failed repeatedly or with |h| = hmin." #define MSGCV_CONV_FAILS "At " MSG_TIME_H ", the corrector convergence test failed repeatedly or with |h| = hmin." #define MSGCV_SETUP_FAILED "At " MSG_TIME ", the setup routine failed in an unrecoverable manner." #define MSGCV_SOLVE_FAILED "At " MSG_TIME ", the solve routine failed in an unrecoverable manner." #define MSGCV_FAILED_CONSTR "At " MSG_TIME ", unable to satisfy inequality constraints." #define MSGCV_RHSFUNC_FAILED "At " MSG_TIME ", the right-hand side routine failed in an unrecoverable manner." #define MSGCV_RHSFUNC_UNREC "At " MSG_TIME ", the right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_RHSFUNC_REPTD "At " MSG_TIME " repeated recoverable right-hand side function errors." #define MSGCV_RHSFUNC_FIRST "The right-hand side routine failed at the first call." #define MSGCV_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." #define MSGCV_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." #define MSGCV_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME " in the direction of integration." #define MSGCV_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." #define MSGCV_NLS_SETUP_FAILED "At " MSG_TIME "the nonlinear solver setup failed unrecoverably." #define MSGCV_NLS_INPUT_NULL "At " MSG_TIME "the nonlinear solver was passed a NULL input." #define MSGCV_NO_TOLQ "No integration tolerances for quadrature variables have been specified." #define MSGCV_BAD_EWTQ "Initial ewtQ has component(s) equal to zero (illegal)." #define MSGCV_EWTQ_NOW_BAD "At " MSG_TIME ", a component of ewtQ has become <= 0." #define MSGCV_QRHSFUNC_FAILED "At " MSG_TIME ", the quadrature right-hand side routine failed in an unrecoverable manner." #define MSGCV_QRHSFUNC_UNREC "At " MSG_TIME ", the quadrature right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_QRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable quadrature right-hand side function errors." #define MSGCV_QRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." #define MSGCV_NO_TOLS "No integration tolerances for sensitivity variables have been specified." #define MSGCV_NULL_P "p = NULL when using internal DQ for sensitivity RHS illegal." #define MSGCV_BAD_EWTS "Initial ewtS has component(s) equal to zero (illegal)." #define MSGCV_EWTS_NOW_BAD "At " MSG_TIME ", a component of ewtS has become <= 0." #define MSGCV_SRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity right-hand side routine failed in an unrecoverable manner." #define MSGCV_SRHSFUNC_UNREC "At " MSG_TIME ", the sensitivity right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_SRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable sensitivity right-hand side function errors." #define MSGCV_SRHSFUNC_FIRST "The sensitivity right-hand side routine failed at the first call." #define MSGCV_NULL_FQ "CVODES is expected to use DQ to evaluate the RHS of quad. sensi., but quadratures were not initialized." #define MSGCV_NO_TOLQS "No integration tolerances for quadrature sensitivity variables have been specified." #define MSGCV_BAD_EWTQS "Initial ewtQS has component(s) equal to zero (illegal)." #define MSGCV_EWTQS_NOW_BAD "At " MSG_TIME ", a component of ewtQS has become <= 0." #define MSGCV_QSRHSFUNC_FAILED "At " MSG_TIME ", the quadrature sensitivity right-hand side routine failed in an unrecoverable manner." #define MSGCV_QSRHSFUNC_UNREC "At " MSG_TIME ", the quadrature sensitivity right-hand side failed in a recoverable manner, but no recovery is possible." #define MSGCV_QSRHSFUNC_REPTD "At " MSG_TIME " repeated recoverable quadrature sensitivity right-hand side function errors." #define MSGCV_QSRHSFUNC_FIRST "The quadrature sensitivity right-hand side routine failed at the first call." /* * ================================================================= * C V O D E A E R R O R M E S S A G E S * ================================================================= */ #define MSGCV_NO_ADJ "Illegal attempt to call before calling CVodeAdjMalloc." #define MSGCV_BAD_STEPS "Steps nonpositive illegal." #define MSGCV_BAD_INTERP "Illegal value for interp." #define MSGCV_BAD_WHICH "Illegal value for which." #define MSGCV_NO_BCK "No backward problems have been defined yet." #define MSGCV_NO_FWD "Illegal attempt to call before calling CVodeF." #define MSGCV_BAD_TB0 "The initial time tB0 for problem %d is outside the interval over which the forward problem was solved." #define MSGCV_BAD_SENSI "At least one backward problem requires sensitivities, but they were not stored for interpolation." #define MSGCV_BAD_ITASKB "Illegal value for itaskB. Legal values are CV_NORMAL and CV_ONE_STEP." #define MSGCV_BAD_TBOUT "The final time tBout is outside the interval over which the forward problem was solved." #define MSGCV_BACK_ERROR "Error occured while integrating backward problem # %d" #define MSGCV_BAD_TINTERP "Bad t = %g for interpolation." #define MSGCV_WRONG_INTERP "This function cannot be called for the specified interp type." #ifdef __cplusplus } #endif #endif StanHeaders/src/cvodes/cvodes_bandpre_impl.h0000644000176200001440000000466413766554456020734 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Implementation header file for the CVSBANDPRE module. * ----------------------------------------------------------------- */ #ifndef _CVSBANDPRE_IMPL_H #define _CVSBANDPRE_IMPL_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------------------------------------------------------- Type: CVBandPrecData -----------------------------------------------------------------*/ typedef struct CVBandPrecDataRec { /* Data set by user in CVBandPrecInit */ sunindextype N; sunindextype ml, mu; /* Data set by CVBandPrecSetup */ SUNMatrix savedJ; SUNMatrix savedP; SUNLinearSolver LS; N_Vector tmp1; N_Vector tmp2; /* Rhs calls */ long int nfeBP; /* Pointer to cvode_mem */ void *cvode_mem; } *CVBandPrecData; /*----------------------------------------------------------------- CVBANDPRE error messages -----------------------------------------------------------------*/ #define MSGBP_MEM_NULL "Integrator memory is NULL." #define MSGBP_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBP_MEM_FAIL "A memory request failed." #define MSGBP_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBP_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." #define MSGBP_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." #define MSGBP_PMEM_NULL "Band preconditioner memory is NULL. CVBandPrecInit must be called." #define MSGBP_RHSFUNC_FAILED "The right-hand side routine failed in an unrecoverable manner." #define MSGBP_NO_ADJ "Illegal attempt to call before calling CVodeAdjInit." #define MSGBP_BAD_WHICH "Illegal value for parameter which." #ifdef __cplusplus } #endif #endif StanHeaders/src/install.libs.R0000644000176200001440000000117413532026557015776 0ustar liggesusersif (.Platform$OS.type == "unix") { files <- Sys.glob("../lib/libStanHeaders.a") dest <- file.path(R_PACKAGE_DIR, paste0('lib', R_ARCH)) dir.create(dest, recursive = TRUE, showWarnings = FALSE) file.copy(files, dest, overwrite = TRUE) if (file.exists("symbols.rds")) file.copy("symbols.rds", dest, overwrite = TRUE) } else { files <- Sys.glob(paste0("*", SHLIB_EXT)) dest <- file.path(R_PACKAGE_DIR, paste0('libs', R_ARCH)) dir.create(dest, recursive = TRUE, showWarnings = FALSE) file.copy(files, dest, overwrite = TRUE) if(file.exists("symbols.rds")) file.copy("symbols.rds", dest, overwrite = TRUE) } StanHeaders/src/sunlinsol/0000755000176200001440000000000013766554135015307 5ustar liggesusersStanHeaders/src/sunlinsol/lapackband/0000755000176200001440000000000013766554135017367 5ustar liggesusersStanHeaders/src/sunlinsol/lapackband/fsunlinsol_lapackband.h0000644000176200001440000000361313766554457024106 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_lapackband.c) contains the * definitions needed for the initialization of LAPACK band * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_LAPBAND_H #define _FSUNLINSOL_LAPBAND_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNLAPACKBAND_INIT SUNDIALS_F77_FUNC(fsunlapackbandinit, FSUNLAPACKBANDINIT) #define FSUNMASSLAPACKBAND_INIT SUNDIALS_F77_FUNC(fsunmasslapackbandinit, FSUNMASSLAPACKBANDINIT) #else #define FSUNLAPACKBAND_INIT fsunlapackbandinit_ #define FSUNMASSLAPACKBAND_INIT fsunmasslapackbandinit_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNLAPACKBAND_INIT - initializes LAPACK band linear solver for main problem * FSUNMASSLAPACKBAND_INIT - initializes LAPACK band linear solver for mass matrix solve */ void FSUNLAPACKBAND_INIT(int *code, int *ier); void FSUNMASSLAPACKBAND_INIT(int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/lapackband/fsunlinsol_lapackband.c0000644000176200001440000000546613766554457024111 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_lapackband.h) contains the * implementation needed for the Fortran initialization of LAPACK * band linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_lapackband.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNLAPACKBAND_INIT(int *code, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_LapackBand(F2C_CVODE_vec, F2C_CVODE_matrix); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_LapackBand(F2C_IDA_vec, F2C_IDA_matrix); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_LapackBand(F2C_KINSOL_vec, F2C_KINSOL_matrix); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_LapackBand(F2C_ARKODE_vec, F2C_ARKODE_matrix); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNMASSLAPACKBAND_INIT(int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_LapackBand(F2C_ARKODE_vec, F2C_ARKODE_mass_matrix); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } StanHeaders/src/sunlinsol/lapackband/sunlinsol_lapackband.c0000644000176200001440000001742113766554457023735 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on codes _lapack.c by: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the LAPACK band * implementation of the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Private function prototypes */ sunindextype GlobalVectorLength_LapBand(N_Vector y); /* * ----------------------------------------------------------------- * Band solver structure accessibility macros: * ----------------------------------------------------------------- */ #define LAPACKBAND_CONTENT(S) ( (SUNLinearSolverContent_LapackBand)(S->content) ) #define PIVOTS(S) ( LAPACKBAND_CONTENT(S)->pivots ) #define LASTFLAG(S) ( LAPACKBAND_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNLapackBand(N_Vector y, SUNMatrix A) { return(SUNLinSol_LapackBand(y, A)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new LAPACK band linear solver */ SUNLinearSolver SUNLinSol_LapackBand(N_Vector y, SUNMatrix A) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_LapackBand content; sunindextype MatrixRows, VecLength; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return(NULL); if (SUNBandMatrix_Rows(A) != SUNBandMatrix_Columns(A)) return(NULL); MatrixRows = SUNBandMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_LapBand(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_LapackBand; ops->initialize = SUNLinSolInitialize_LapackBand; ops->setup = SUNLinSolSetup_LapackBand; ops->solve = SUNLinSolSolve_LapackBand; ops->lastflag = SUNLinSolLastFlag_LapackBand; ops->space = SUNLinSolSpace_LapackBand; ops->free = SUNLinSolFree_LapackBand; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_LapackBand) malloc(sizeof(struct _SUNLinearSolverContent_LapackBand)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->N = MatrixRows; content->last_flag = 0; content->pivots = NULL; content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); if (content->pivots == NULL) { free(content); free(ops); free(S); return(NULL); } /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_LapackBand(SUNLinearSolver S) { return(SUNLINEARSOLVER_DIRECT); } int SUNLinSolInitialize_LapackBand(SUNLinearSolver S) { /* all solver-specific memory has already been allocated */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_LapackBand(SUNLinearSolver S, SUNMatrix A) { int n, ml, mu, ldim, ier; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) ) return(SUNLS_MEM_NULL); /* Ensure that A is a band matrix */ if (SUNMatGetID(A) != SUNMATRIX_BAND) { LASTFLAG(S) = SUNLS_ILL_INPUT; return(LASTFLAG(S)); } /* Call LAPACK to do LU factorization of A */ n = SUNBandMatrix_Rows(A); ml = SUNBandMatrix_LowerBandwidth(A); mu = SUNBandMatrix_UpperBandwidth(A); ldim = SUNBandMatrix_LDim(A); xgbtrf_f77(&n, &n, &ml, &mu, SUNBandMatrix_Data(A), &ldim, PIVOTS(S), &ier); LASTFLAG(S) = (long int) ier; if (ier > 0) return(SUNLS_LUFACT_FAIL); if (ier < 0) return(SUNLS_PACKAGE_FAIL_UNREC); return(SUNLS_SUCCESS); } int SUNLinSolSolve_LapackBand(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { int n, ml, mu, ldim, one, ier; realtype *xdata; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) return(SUNLS_MEM_NULL); /* copy b into x */ N_VScale(ONE, b, x); /* access x data array */ xdata = N_VGetArrayPointer(x); if (xdata == NULL) { LASTFLAG(S) = 1; return(LASTFLAG(S)); } /* Call LAPACK to solve the linear system */ n = SUNBandMatrix_Rows(A); ml = SUNBandMatrix_LowerBandwidth(A); mu = SUNBandMatrix_UpperBandwidth(A); ldim = SUNBandMatrix_LDim(A); one = 1; xgbtrs_f77("N", &n, &ml, &mu, &one, SUNBandMatrix_Data(A), &ldim, PIVOTS(S), xdata, &n, &ier, 1); LASTFLAG(S) = (long int) ier; if (ier < 0) return(SUNLS_PACKAGE_FAIL_UNREC); LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } long int SUNLinSolLastFlag_LapackBand(SUNLinearSolver S) { /* return the stored 'last_flag' value */ return(LASTFLAG(S)); } int SUNLinSolSpace_LapackBand(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { *lenrwLS = 0; *leniwLS = 2 + LAPACKBAND_CONTENT(S)->N; return(SUNLS_SUCCESS); } int SUNLinSolFree_LapackBand(SUNLinearSolver S) { /* return with success if already freed */ if (S == NULL) return(SUNLS_SUCCESS); /* delete items from contents, then delete generic structure */ if (S->content) { if (PIVOTS(S)) { free(PIVOTS(S)); PIVOTS(S) = NULL; } free(S->content); S->content = NULL; } if (S->ops) { free(S->ops); S->ops = NULL; } free(S); S = NULL; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ /* Inefficient kludge for determining the number of entries in a N_Vector object (replace if such a routine is ever added to the N_Vector API). Returns "-1" on an error. */ sunindextype GlobalVectorLength_LapBand(N_Vector y) { realtype len; N_Vector tmp = NULL; tmp = N_VClone(y); if (tmp == NULL) return(-1); N_VConst(ONE, tmp); len = N_VDotProd(tmp, tmp); N_VDestroy(tmp); return( (sunindextype) len ); } StanHeaders/src/sunlinsol/sptfqmr/0000755000176200001440000000000013766554135017003 5ustar liggesusersStanHeaders/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h0000644000176200001440000000616513766554457023143 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_sptfqmr.c) contains the * definitions needed for the initialization of SPTFQMR * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_SPTFQMR_H #define _FSUNLINSOL_SPTFQMR_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNSPTFQMR_INIT SUNDIALS_F77_FUNC(fsunsptfqmrinit, FSUNSPTFQMRINIT) #define FSUNSPTFQMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunsptfqmrsetprectype, FSUNSPTFQMRSETPRECTYPE) #define FSUNSPTFQMR_SETMAXL SUNDIALS_F77_FUNC(fsunsptfqmrsetmaxl, FSUNSPTFQMRSETMAXL) #define FSUNMASSSPTFQMR_INIT SUNDIALS_F77_FUNC(fsunmasssptfqmrinit, FSUNMASSSPTFQMRINIT) #define FSUNMASSSPTFQMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmasssptfqmrsetprectype, FSUNMASSSPTFQMRSETPRECTYPE) #define FSUNMASSSPTFQMR_SETMAXL SUNDIALS_F77_FUNC(fsunmasssptfqmrsetmaxl, FSUNMASSSPTFQMRSETMAXL) #else #define FSUNSPTFQMR_INIT fsunsptfqmrinit_ #define FSUNSPTFQMR_SETPRECTYPE fsunsptfqmrsetprectype_ #define FSUNSPTFQMR_SETMAXL fsunsptfqmrsetmaxl_ #define FSUNMASSSPTFQMR_INIT fsunmasssptfqmrinit_ #define FSUNMASSSPTFQMR_SETPRECTYPE fsunmasssptfqmrsetprectype_ #define FSUNMASSSPTFQMR_SETMAXL fsunmasssptfqmrsetmaxl_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNSPTFQMR_INIT - initializes SPTFQMR linear solver for main problem * FSUNSPTFQMR_SETPRECTYPE - sets the preconditioning type for main problem * FSUNSPTFQMR_SETMAXL - sets the max number of iterations for main problem * * FSUNMASSSPTFQMR_INIT - initializes SPTFQMR linear solver for mass matrix solve * FSUNMASSSPTFQMR_SETPRECTYPE - sets the preconditioning type for mass matrix solve * FSUNMASSSPTFQMR_SETMAXL - sets the max number of iterations for mass matrix solve */ void FSUNSPTFQMR_INIT(int *code, int *pretype, int *maxl, int *ier); void FSUNSPTFQMR_SETPRECTYPE(int *code, int *pretype, int *ier); void FSUNSPTFQMR_SETMAXL(int *code, int *maxl, int *ier); void FSUNMASSSPTFQMR_INIT(int *pretype, int *maxl, int *ier); void FSUNMASSSPTFQMR_SETPRECTYPE(int *pretype, int *ier); void FSUNMASSSPTFQMR_SETMAXL(int *maxl, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c0000644000176200001440000005525513766554457022774 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on sundials_sptfqmr.c code, written by Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the SPTFQMR implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * SPTFQMR solver structure accessibility macros: * ----------------------------------------------------------------- */ #define SPTFQMR_CONTENT(S) ( (SUNLinearSolverContent_SPTFQMR)(S->content) ) #define LASTFLAG(S) ( SPTFQMR_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNSPTFQMR(N_Vector y, int pretype, int maxl) { return(SUNLinSol_SPTFQMR(y, pretype, maxl)); } int SUNSPTFQMRSetPrecType(SUNLinearSolver S, int pretype) { return(SUNLinSol_SPTFQMRSetPrecType(S, pretype)); } int SUNSPTFQMRSetMaxl(SUNLinearSolver S, int maxl) { return(SUNLinSol_SPTFQMRSetMaxl(S, maxl)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new SPTFQMR linear solver */ SUNLinearSolver SUNLinSol_SPTFQMR(N_Vector y, int pretype, int maxl) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_SPTFQMR content; /* check for legal pretype and maxl values; if illegal use defaults */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; if (maxl <= 0) maxl = SUNSPTFQMR_MAXL_DEFAULT; /* check that the supplied N_Vector supports all requisite operations */ if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || (y->ops->nvlinearsum == NULL) || (y->ops->nvconst == NULL) || (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_SPTFQMR; ops->setatimes = SUNLinSolSetATimes_SPTFQMR; ops->setpreconditioner = SUNLinSolSetPreconditioner_SPTFQMR; ops->setscalingvectors = SUNLinSolSetScalingVectors_SPTFQMR; ops->initialize = SUNLinSolInitialize_SPTFQMR; ops->setup = SUNLinSolSetup_SPTFQMR; ops->solve = SUNLinSolSolve_SPTFQMR; ops->numiters = SUNLinSolNumIters_SPTFQMR; ops->resnorm = SUNLinSolResNorm_SPTFQMR; ops->resid = SUNLinSolResid_SPTFQMR; ops->lastflag = SUNLinSolLastFlag_SPTFQMR; ops->space = SUNLinSolSpace_SPTFQMR; ops->free = SUNLinSolFree_SPTFQMR; /* Create content */ content = NULL; content = (SUNLinearSolverContent_SPTFQMR) malloc(sizeof(struct _SUNLinearSolverContent_SPTFQMR)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->last_flag = 0; content->maxl = maxl; content->pretype = pretype; content->numiters = 0; content->resnorm = ZERO; content->r_star = N_VClone(y); if (content->r_star == NULL) return(NULL); content->q = N_VClone(y); if (content->q == NULL) return(NULL); content->d = N_VClone(y); if (content->d == NULL) return(NULL); content->v = N_VClone(y); if (content->v == NULL) return(NULL); content->p = N_VClone(y); if (content->p == NULL) return(NULL); content->r = N_VCloneVectorArray(2, y); if (content->r == NULL) return(NULL); content->u = N_VClone(y); if (content->u == NULL) return(NULL); content->vtemp1 = N_VClone(y); if (content->vtemp1 == NULL) return(NULL); content->vtemp2 = N_VClone(y); if (content->vtemp2 == NULL) return(NULL); content->vtemp3 = N_VClone(y); if (content->vtemp3 == NULL) return(NULL); content->s1 = NULL; content->s2 = NULL; content->ATimes = NULL; content->ATData = NULL; content->Psetup = NULL; content->Psolve = NULL; content->PData = NULL; /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to set the type of preconditioning for SPTFQMR to use */ SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetPrecType(SUNLinearSolver S, int pretype) { /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { return(SUNLS_ILL_INPUT); } /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ SPTFQMR_CONTENT(S)->pretype = pretype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the maximum number of iterations for SPTFQMR to use */ SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetMaxl(SUNLinearSolver S, int maxl) { /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Check for legal pretype */ if (maxl <= 0) maxl = SUNSPTFQMR_MAXL_DEFAULT; /* Set pretype */ SPTFQMR_CONTENT(S)->maxl = maxl; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_SPTFQMR(SUNLinearSolver S) { return(SUNLINEARSOLVER_ITERATIVE); } int SUNLinSolInitialize_SPTFQMR(SUNLinearSolver S) { SUNLinearSolverContent_SPTFQMR content; /* set shortcut to SPTFQMR memory structure */ if (S == NULL) return(SUNLS_MEM_NULL); content = SPTFQMR_CONTENT(S); /* ensure valid options */ if ( (content->pretype != PREC_LEFT) && (content->pretype != PREC_RIGHT) && (content->pretype != PREC_BOTH) ) content->pretype = PREC_NONE; if (content->maxl <= 0) content->maxl = SUNSPTFQMR_MAXL_DEFAULT; /* no additional memory to allocate */ /* return with success */ content->last_flag = SUNLS_SUCCESS; return(SUNLS_SUCCESS); } int SUNLinSolSetATimes_SPTFQMR(SUNLinearSolver S, void* ATData, ATimesFn ATimes) { /* set function pointers to integrator-supplied ATimes routine and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPTFQMR_CONTENT(S)->ATimes = ATimes; SPTFQMR_CONTENT(S)->ATData = ATData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetPreconditioner_SPTFQMR(SUNLinearSolver S, void* PData, PSetupFn Psetup, PSolveFn Psolve) { /* set function pointers to integrator-supplied Psetup and PSolve routines and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPTFQMR_CONTENT(S)->Psetup = Psetup; SPTFQMR_CONTENT(S)->Psolve = Psolve; SPTFQMR_CONTENT(S)->PData = PData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetScalingVectors_SPTFQMR(SUNLinearSolver S, N_Vector s1, N_Vector s2) { /* set N_Vector pointers to integrator-supplied scaling vectors, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPTFQMR_CONTENT(S)->s1 = s1; SPTFQMR_CONTENT(S)->s2 = s2; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_SPTFQMR(SUNLinearSolver S, SUNMatrix A) { int ier; PSetupFn Psetup; void* PData; /* Set shortcuts to SPTFQMR memory structures */ if (S == NULL) return(SUNLS_MEM_NULL); Psetup = SPTFQMR_CONTENT(S)->Psetup; PData = SPTFQMR_CONTENT(S)->PData; /* no solver-specific setup is required, but if user-supplied Psetup routine exists, call that here */ if (Psetup != NULL) { ier = Psetup(PData); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; return(LASTFLAG(S)); } } /* return with success */ return(SUNLS_SUCCESS); } int SUNLinSolSolve_SPTFQMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype delta) { /* local data and shortcut variables */ realtype alpha, tau, eta, beta, c, sigma, v_bar, omega; realtype rho[2]; realtype r_init_norm, r_curr_norm; realtype temp_val; booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; booleantype b_ok; int n, m, ier, l_max; void *A_data, *P_data; ATimesFn atimes; PSolveFn psolve; realtype *res_norm; int *nli; N_Vector sx, sb, r_star, q, d, v, p, *r, u, vtemp1, vtemp2, vtemp3; /* local variables for fused vector operations */ realtype cv[3]; N_Vector Xv[3]; /* Make local shorcuts to solver variables. */ if (S == NULL) return(SUNLS_MEM_NULL); l_max = SPTFQMR_CONTENT(S)->maxl; r_star = SPTFQMR_CONTENT(S)->r_star; q = SPTFQMR_CONTENT(S)->q; d = SPTFQMR_CONTENT(S)->d; v = SPTFQMR_CONTENT(S)->v; p = SPTFQMR_CONTENT(S)->p; r = SPTFQMR_CONTENT(S)->r; u = SPTFQMR_CONTENT(S)->u; vtemp1 = SPTFQMR_CONTENT(S)->vtemp1; vtemp2 = SPTFQMR_CONTENT(S)->vtemp2; vtemp3 = SPTFQMR_CONTENT(S)->vtemp3; sb = SPTFQMR_CONTENT(S)->s1; sx = SPTFQMR_CONTENT(S)->s2; A_data = SPTFQMR_CONTENT(S)->ATData; P_data = SPTFQMR_CONTENT(S)->PData; atimes = SPTFQMR_CONTENT(S)->ATimes; psolve = SPTFQMR_CONTENT(S)->Psolve; nli = &(SPTFQMR_CONTENT(S)->numiters); res_norm = &(SPTFQMR_CONTENT(S)->resnorm); /* Initialize counters and convergence flag */ temp_val = r_curr_norm = -ONE; *nli = 0; converged = SUNFALSE; b_ok = SUNFALSE; /* set booleantype flags for internal solver options */ preOnLeft = ( (SPTFQMR_CONTENT(S)->pretype == PREC_LEFT) || (SPTFQMR_CONTENT(S)->pretype == PREC_BOTH) ); preOnRight = ( (SPTFQMR_CONTENT(S)->pretype == PREC_RIGHT) || (SPTFQMR_CONTENT(S)->pretype == PREC_BOTH) ); scale_x = (sx != NULL); scale_b = (sb != NULL); /* Set r_star to initial (unscaled) residual r_star = r_0 = b - A*x_0 */ /* NOTE: if x == 0 then just set residual to b and continue */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); else { ier = atimes(A_data, x, r_star); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } N_VLinearSum(ONE, b, -ONE, r_star, r_star); } /* Apply left preconditioner and b-scaling to r_star (or really just r_0) */ if (preOnLeft) { ier = psolve(P_data, r_star, vtemp1, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, r_star, vtemp1); if (scale_b) N_VProd(sb, vtemp1, r_star); else N_VScale(ONE, vtemp1, r_star); /* Initialize rho[0] */ /* NOTE: initialized here to reduce number of computations - avoid need to compute r_star^T*r_star twice, and avoid needlessly squaring values */ rho[0] = N_VDotProd(r_star, r_star); /* Compute norm of initial residual (r_0) to see if we really need to do anything */ *res_norm = r_init_norm = SUNRsqrt(rho[0]); if (r_init_norm <= delta) { LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* Set v = A*r_0 (preconditioned and scaled) */ if (scale_x) N_VDiv(r_star, sx, vtemp1); else N_VScale(ONE, r_star, vtemp1); if (preOnRight) { N_VScale(ONE, vtemp1, v); ier = psolve(P_data, v, vtemp1, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } ier = atimes(A_data, vtemp1, v); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } if (preOnLeft) { ier = psolve(P_data, v, vtemp1, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, v, vtemp1); if (scale_b) N_VProd(sb, vtemp1, v); else N_VScale(ONE, vtemp1, v); /* Initialize remaining variables */ N_VScale(ONE, r_star, r[0]); N_VScale(ONE, r_star, u); N_VScale(ONE, r_star, p); N_VConst(ZERO, d); tau = r_init_norm; v_bar = eta = ZERO; /* START outer loop */ for (n = 0; n < l_max; ++n) { /* Increment linear iteration counter */ (*nli)++; /* sigma = r_star^T*v */ sigma = N_VDotProd(r_star, v); /* alpha = rho[0]/sigma */ alpha = rho[0]/sigma; /* q = u-alpha*v */ N_VLinearSum(ONE, u, -alpha, v, q); /* r[1] = r[0]-alpha*A*(u+q) */ N_VLinearSum(ONE, u, ONE, q, r[1]); if (scale_x) N_VDiv(r[1], sx, r[1]); if (preOnRight) { N_VScale(ONE, r[1], vtemp1); ier = psolve(P_data, vtemp1, r[1], delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } ier = atimes(A_data, r[1], vtemp1); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } if (preOnLeft) { ier = psolve(P_data, vtemp1, r[1], delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, vtemp1, r[1]); if (scale_b) N_VProd(sb, r[1], vtemp1); else N_VScale(ONE, r[1], vtemp1); N_VLinearSum(ONE, r[0], -alpha, vtemp1, r[1]); /* START inner loop */ for (m = 0; m < 2; ++m) { /* d = [*]+(v_bar^2*eta/alpha)*d */ /* NOTES: * (1) [*] = u if m == 0, and q if m == 1 * (2) using temp_val reduces the number of required computations * if the inner loop is executed twice */ if (m == 0) { temp_val = SUNRsqrt(N_VDotProd(r[1], r[1])); omega = SUNRsqrt(SUNRsqrt(N_VDotProd(r[0], r[0]))*temp_val); N_VLinearSum(ONE, u, SUNSQR(v_bar)*eta/alpha, d, d); } else { omega = temp_val; N_VLinearSum(ONE, q, SUNSQR(v_bar)*eta/alpha, d, d); } /* v_bar = omega/tau */ v_bar = omega/tau; /* c = (1+v_bar^2)^(-1/2) */ c = ONE / SUNRsqrt(ONE+SUNSQR(v_bar)); /* tau = tau*v_bar*c */ tau = tau*v_bar*c; /* eta = c^2*alpha */ eta = SUNSQR(c)*alpha; /* x = x+eta*d */ N_VLinearSum(ONE, x, eta, d, x); /* Check for convergence... */ /* NOTE: just use approximation to norm of residual, if possible */ *res_norm = r_curr_norm = tau*SUNRsqrt(m+1); /* Exit inner loop if iteration has converged based upon approximation to norm of current residual */ if (r_curr_norm <= delta) { converged = SUNTRUE; break; } /* Decide if actual norm of residual vector should be computed */ /* NOTES: * (1) if r_curr_norm > delta, then check if actual residual norm * is OK (recall we first compute an approximation) * (2) if r_curr_norm >= r_init_norm and m == 1 and n == l_max, then * compute actual residual norm to see if the iteration can be * saved * (3) the scaled and preconditioned right-hand side of the given * linear system (denoted by b) is only computed once, and the * result is stored in vtemp3 so it can be reused - reduces the * number of psovles if using left preconditioning */ if ((r_curr_norm > delta) || (r_curr_norm >= r_init_norm && m == 1 && n == l_max)) { /* Compute norm of residual ||b-A*x||_2 (preconditioned and scaled) */ if (scale_x) N_VDiv(x, sx, vtemp1); else N_VScale(ONE, x, vtemp1); if (preOnRight) { ier = psolve(P_data, vtemp1, vtemp2, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_UNREC; return(LASTFLAG(S)); } N_VScale(ONE, vtemp2, vtemp1); } ier = atimes(A_data, vtemp1, vtemp2); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } if (preOnLeft) { ier = psolve(P_data, vtemp2, vtemp1, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, vtemp2, vtemp1); if (scale_b) N_VProd(sb, vtemp1, vtemp2); else N_VScale(ONE, vtemp1, vtemp2); /* Only precondition and scale b once (result saved for reuse) */ if (!b_ok) { b_ok = SUNTRUE; if (preOnLeft) { ier = psolve(P_data, b, vtemp3, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, b, vtemp3); if (scale_b) N_VProd(sb, vtemp3, vtemp3); } N_VLinearSum(ONE, vtemp3, -ONE, vtemp2, vtemp1); *res_norm = r_curr_norm = SUNRsqrt(N_VDotProd(vtemp1, vtemp1)); /* Exit inner loop if inequality condition is satisfied (meaning exit if we have converged) */ if (r_curr_norm <= delta) { converged = SUNTRUE; break; } } } /* END inner loop */ /* If converged, then exit outer loop as well */ if (converged == SUNTRUE) break; /* rho[1] = r_star^T*r_[1] */ rho[1] = N_VDotProd(r_star, r[1]); /* beta = rho[1]/rho[0] */ beta = rho[1]/rho[0]; /* u = r[1]+beta*q */ N_VLinearSum(ONE, r[1], beta, q, u); /* p = u+beta*(q+beta*p) = beta*beta*p + beta*q + u */ cv[0] = SUNSQR(beta); Xv[0] = p; cv[1] = beta; Xv[1] = q; cv[2] = ONE; Xv[2] = u; ier = N_VLinearCombination(3, cv, Xv, p); if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); /* v = A*p */ if (scale_x) N_VDiv(p, sx, vtemp1); else N_VScale(ONE, p, vtemp1); if (preOnRight) { N_VScale(ONE, vtemp1, v); ier = psolve(P_data, v, vtemp1, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } ier = atimes(A_data, vtemp1, v); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } if (preOnLeft) { ier = psolve(P_data, v, vtemp1, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, v, vtemp1); if (scale_b) N_VProd(sb, vtemp1, v); else N_VScale(ONE, vtemp1, v); /* Shift variable values */ /* NOTE: reduces storage requirements */ N_VScale(ONE, r[1], r[0]); rho[0] = rho[1]; } /* END outer loop */ /* Determine return value */ /* If iteration converged or residual was reduced, then return current iterate (x) */ if ((converged == SUNTRUE) || (r_curr_norm < r_init_norm)) { if (scale_x) N_VDiv(x, sx, x); if (preOnRight) { ier = psolve(P_data, x, vtemp1, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_UNREC; return(LASTFLAG(S)); } N_VScale(ONE, vtemp1, x); } if (converged == SUNTRUE) LASTFLAG(S) = SUNLS_SUCCESS; else LASTFLAG(S) = SUNLS_RES_REDUCED; return(LASTFLAG(S)); } /* Otherwise, return error code */ else { LASTFLAG(S) = SUNLS_CONV_FAIL; return(LASTFLAG(S)); } } int SUNLinSolNumIters_SPTFQMR(SUNLinearSolver S) { /* return the stored 'numiters' value */ if (S == NULL) return(-1); return (SPTFQMR_CONTENT(S)->numiters); } realtype SUNLinSolResNorm_SPTFQMR(SUNLinearSolver S) { /* return the stored 'resnorm' value */ if (S == NULL) return(-ONE); return (SPTFQMR_CONTENT(S)->resnorm); } N_Vector SUNLinSolResid_SPTFQMR(SUNLinearSolver S) { /* return the stored 'vtemp1' vector */ return (SPTFQMR_CONTENT(S)->vtemp1); } long int SUNLinSolLastFlag_SPTFQMR(SUNLinearSolver S) { /* return the stored 'last_flag' value */ if (S == NULL) return(-1); return (LASTFLAG(S)); } int SUNLinSolSpace_SPTFQMR(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { sunindextype liw1, lrw1; if (SPTFQMR_CONTENT(S)->vtemp1->ops->nvspace) N_VSpace(SPTFQMR_CONTENT(S)->vtemp1, &lrw1, &liw1); else lrw1 = liw1 = 0; *lenrwLS = lrw1*11; *leniwLS = liw1*11; return(SUNLS_SUCCESS); } int SUNLinSolFree_SPTFQMR(SUNLinearSolver S) { if (S == NULL) return(SUNLS_SUCCESS); /* delete items from within the content structure */ if (SPTFQMR_CONTENT(S)->r_star) N_VDestroy(SPTFQMR_CONTENT(S)->r_star); if (SPTFQMR_CONTENT(S)->q) N_VDestroy(SPTFQMR_CONTENT(S)->q); if (SPTFQMR_CONTENT(S)->d) N_VDestroy(SPTFQMR_CONTENT(S)->d); if (SPTFQMR_CONTENT(S)->v) N_VDestroy(SPTFQMR_CONTENT(S)->v); if (SPTFQMR_CONTENT(S)->p) N_VDestroy(SPTFQMR_CONTENT(S)->p); if (SPTFQMR_CONTENT(S)->r) N_VDestroyVectorArray(SPTFQMR_CONTENT(S)->r, 2); if (SPTFQMR_CONTENT(S)->u) N_VDestroy(SPTFQMR_CONTENT(S)->u); if (SPTFQMR_CONTENT(S)->vtemp1) N_VDestroy(SPTFQMR_CONTENT(S)->vtemp1); if (SPTFQMR_CONTENT(S)->vtemp2) N_VDestroy(SPTFQMR_CONTENT(S)->vtemp2); if (SPTFQMR_CONTENT(S)->vtemp3) N_VDestroy(SPTFQMR_CONTENT(S)->vtemp3); /* delete generic structures */ free(S->content); S->content = NULL; free(S->ops); S->ops = NULL; free(S); S = NULL; return(SUNLS_SUCCESS); } StanHeaders/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c0000644000176200001440000001126613766554457023134 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_sptfqmr.h) contains the * implementation needed for the Fortran initialization of SPTFQMR * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_sptfqmr.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNSPTFQMR_INIT(int *code, int *pretype, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_SPTFQMR(F2C_CVODE_vec, *pretype, *maxl); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_SPTFQMR(F2C_IDA_vec, *pretype, *maxl); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_SPTFQMR(F2C_KINSOL_vec, *pretype, *maxl); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_SPTFQMR(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNSPTFQMR_SETPRECTYPE(int *code, int *pretype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_CVODE_linsol, *pretype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_IDA_linsol, *pretype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_KINSOL_linsol, *pretype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_ARKODE_linsol, *pretype); break; default: *ier = -1; } } void FSUNSPTFQMR_SETMAXL(int *code, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_CVODE_linsol, *maxl); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_IDA_linsol, *maxl); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_KINSOL_linsol, *maxl); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_ARKODE_linsol, *maxl); break; default: *ier = -1; } } void FSUNMASSSPTFQMR_INIT(int *pretype, int *maxl, int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_SPTFQMR(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSSPTFQMR_SETPRECTYPE(int *pretype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetPrecType(F2C_ARKODE_mass_sol, *pretype); } void FSUNMASSSPTFQMR_SETMAXL(int *maxl, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPTFQMRSetMaxl(F2C_ARKODE_mass_sol, *maxl); } StanHeaders/src/sunlinsol/sptfqmr/F90/0000755000176200001440000000000013766554135017341 5ustar liggesusersStanHeaders/src/sunlinsol/sptfqmr/F90/fsunlinsol_sptfqmr.f900000644000176200001440000001456113766554457023647 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS SPTFQMR linear solver using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_sptfqmr_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_SPTFQMR(y, pretype, maxl) & bind(C,name='SUNLinSol_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y integer(c_int), value :: pretype integer(c_int), value :: maxl end function FSUNLinSol_SPTFQMR ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_SPTFQMR(LS) & bind(C,name='SUNLinSolFree_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_SPTFQMR ! ================================================================= ! Setters ! ================================================================= integer(c_int) function FSUNLinSol_SPTFQMRSetPrecType(LS, pretype) & bind(C,name='SUNLinSol_SPTFQMRSetPrecType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: pretype end function FSUNLinSol_SPTFQMRSetPrecType integer(c_int) function FSUNLinSol_SPTFQMRSetMaxl(LS, maxl) & bind(C,name='SUNLinSol_SPTFQMRSetMaxl') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: maxl end function FSUNLinSol_SPTFQMRSetMaxl ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_SPTFQMR(LS) & bind(C,name='SUNLinSolGetType_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_SPTFQMR integer(c_int) function FSUNLinSolInitialize_SPTFQMR(LS) & bind(C,name='SUNLinSolInitialize_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_SPTFQMR integer(c_int) function FSUNLinSolSetATimes_SPTFQMR(LS, A_data, ATimes) & bind(C,name='SUNLinSolSetATimes_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A_data type(c_funptr), value :: ATimes end function FSUNLinSolSetATimes_SPTFQMR integer(c_int) function FSUNLinSolSetPreconditioner_SPTFQMR(LS, & P_data, & Pset, & Psol) & bind(C,name='SUNLinSolSetPreconditioner_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: P_data type(c_funptr), value :: Pset type(c_funptr), value :: Psol end function FSUNLinSolSetPreconditioner_SPTFQMR integer(c_int) function FSUNLinSolSetScalingVectors_SPTFQMR(LS, s1, s2) & bind(C,name='SUNLinSolSetScalingVectors_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: s1 type(c_ptr), value :: s2 end function FSUNLinSolSetScalingVectors_SPTFQMR integer(c_int) function FSUNLinSolSetup_SPTFQMR(LS, A) & bind(C,name='SUNLinSolSetup_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_SPTFQMR integer(c_int) function FSUNLinSolSolve_SPTFQMR(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_SPTFQMR integer(c_int) function FSUNLinSolNumIters_SPTFQMR(LS) & bind(C,name='SUNLinSolNumIters_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolNumIters_SPTFQMR real(c_double) function FSUNLinSolResNorm_SPTFQMR(LS) & bind(C,name='SUNLinSolResNorm_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResNorm_SPTFQMR type(c_ptr) function FSUNLinSolResid_SPTFQMR(LS) & bind(C,name='SUNLinSolResid_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResid_SPTFQMR integer(c_long) function FSUNLinSolLastFlag_SPTFQMR(LS) & bind(C,name='SUNLinSolLastFlag_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_SPTFQMR integer(c_int) function FSUNLinSolSpace_SPTFQMR(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_SPTFQMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_SPTFQMR end interface end module fsunlinsol_sptfqmr_mod StanHeaders/src/sunlinsol/klu/0000755000176200001440000000000013766554135016102 5ustar liggesusersStanHeaders/src/sunlinsol/klu/fsunlinsol_klu.h0000644000176200001440000000574613766554457021345 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_klu.c) contains the * definitions needed for the initialization of klu * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_KLU_H #define _FSUNLINSOL_KLU_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNKLU_INIT SUNDIALS_F77_FUNC(fsunkluinit, FSUNKLUINIT) #define FSUNKLU_REINIT SUNDIALS_F77_FUNC(fsunklureinit, FSUNKLUREINIT) #define FSUNKLU_SETORDERING SUNDIALS_F77_FUNC(fsunklusetordering, FSUNKLUSETORDERING) #define FSUNMASSKLU_INIT SUNDIALS_F77_FUNC(fsunmasskluinit, FSUNMASSKLUINIT) #define FSUNMASSKLU_REINIT SUNDIALS_F77_FUNC(fsunmassklureinit, FSUNMASSKLUREINIT) #define FSUNMASSKLU_SETORDERING SUNDIALS_F77_FUNC(fsunmassklusetordering, FSUNMASSKLUSETORDERING) #else #define FSUNKLU_INIT fsunkluinit_ #define FSUNKLU_REINIT fsunklureinit_ #define FSUNKLU_SETORDERING fsunklusetordering_ #define FSUNMASSKLU_INIT fsunmasskluinit_ #define FSUNMASSKLU_REINIT fsunmassklureinit_ #define FSUNMASSKLU_SETORDERING fsunmassklusetordering_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNKLU_INIT - initializes klu linear solver for main problem * FSUNKLU_REINIT - reinitializes klu linear solver for main problem * FSUNKLU_SETORDERING - sets the ordering choice used by KLU for main problem * FSUNMASSKLU_INIT - initializes klu linear solver for mass matrix solve * FSUNMASSKLU_REINIT - reinitializes klu linear solver for mass matrix solve * FSUNMASSKLU_SETORDERING - sets the ordering choice used by KLU for mass matrix solve */ void FSUNKLU_INIT(int *code, int *ier); void FSUNKLU_REINIT(int *code, long int *NNZ, int *reinit_type, int *ier); void FSUNKLU_SETORDERING(int *code, int *ordering, int *ier); void FSUNMASSKLU_INIT(int *ier); void FSUNMASSKLU_REINIT(long int *NNZ, int *reinit_type, int *ier); void FSUNMASSKLU_SETORDERING(int *ordering, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/klu/sunlinsol_klu.c0000644000176200001440000003332013766554457021157 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on codes _klu.c, written by Carol Woodward @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the KLU implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define TWOTHIRDS RCONST(0.666666666666666666666666666666667) /* Private function prototypes */ sunindextype GlobalVectorLength_KLU(N_Vector y); /* * ----------------------------------------------------------------- * KLU solver structure accessibility macros: * ----------------------------------------------------------------- */ #define KLU_CONTENT(S) ( (SUNLinearSolverContent_KLU)(S->content) ) #define LASTFLAG(S) ( KLU_CONTENT(S)->last_flag ) #define FIRSTFACTORIZE(S) ( KLU_CONTENT(S)->first_factorize ) #define SYMBOLIC(S) ( KLU_CONTENT(S)->symbolic ) #define NUMERIC(S) ( KLU_CONTENT(S)->numeric ) #define COMMON(S) ( KLU_CONTENT(S)->common ) #define SOLVE(S) ( KLU_CONTENT(S)->klu_solver ) /* * ----------------------------------------------------------------- * typedef to handle pointer casts from sunindextype to KLU type * ----------------------------------------------------------------- */ #if defined(SUNDIALS_INT64_T) #define KLU_INDEXTYPE long int #else #define KLU_INDEXTYPE int #endif /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNKLU(N_Vector y, SUNMatrix A) { return(SUNLinSol_KLU(y, A)); } int SUNKLUReInit(SUNLinearSolver S, SUNMatrix A, sunindextype nnz, int reinit_type) { return(SUNLinSol_KLUReInit(S, A, nnz, reinit_type)); } int SUNKLUSetOrdering(SUNLinearSolver S, int ordering_choice) { return(SUNLinSol_KLUSetOrdering(S, ordering_choice)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new KLU linear solver */ SUNLinearSolver SUNLinSol_KLU(N_Vector y, SUNMatrix A) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_KLU content; sunindextype MatrixRows, VecLength; int flag; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return(NULL); if (SUNSparseMatrix_Rows(A) != SUNSparseMatrix_Columns(A)) return(NULL); MatrixRows = SUNSparseMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_KLU(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_KLU; ops->initialize = SUNLinSolInitialize_KLU; ops->setup = SUNLinSolSetup_KLU; ops->solve = SUNLinSolSolve_KLU; ops->lastflag = SUNLinSolLastFlag_KLU; ops->space = SUNLinSolSpace_KLU; ops->free = SUNLinSolFree_KLU; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_KLU) malloc(sizeof(struct _SUNLinearSolverContent_KLU)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->last_flag = 0; content->first_factorize = 1; #if defined(SUNDIALS_INT64_T) if (SUNSparseMatrix_SparseType(A) == CSC_MAT) { content->klu_solver = (KLUSolveFn) &klu_l_solve; } else { content->klu_solver = (KLUSolveFn) &klu_l_tsolve; } #elif defined(SUNDIALS_INT32_T) if (SUNSparseMatrix_SparseType(A) == CSC_MAT) { content->klu_solver = &klu_solve; } else { content->klu_solver = &klu_tsolve; } #else /* incompatible sunindextype for KLU */ #error Incompatible sunindextype for KLU #endif content->symbolic = NULL; content->numeric = NULL; flag = sun_klu_defaults(&(content->common)); if (flag == 0) { free(content); free(ops); free(S); return(NULL); } (content->common).ordering = SUNKLU_ORDERING_DEFAULT; /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to reinitialize a KLU linear solver */ int SUNLinSol_KLUReInit(SUNLinearSolver S, SUNMatrix A, sunindextype nnz, int reinit_type) { /* Check for non-NULL SUNLinearSolver */ if ((S == NULL) || (A == NULL)) return(SUNLS_MEM_NULL); /* Check for valid SUNMatrix */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return(SUNLS_ILL_INPUT); /* Check for valid reinit_type */ if ((reinit_type != SUNKLU_REINIT_FULL) && (reinit_type != SUNKLU_REINIT_PARTIAL)) return(SUNLS_ILL_INPUT); /* Full re-initialization: reallocate matrix for updated storage */ if (reinit_type == SUNKLU_REINIT_FULL) if (SUNSparseMatrix_Reallocate(A, nnz) != 0) return(SUNLS_MEM_FAIL); /* Free the prior factorazation and reset for first factorization */ if( SYMBOLIC(S) != NULL) sun_klu_free_symbolic(&SYMBOLIC(S), &COMMON(S)); if( NUMERIC(S) != NULL) sun_klu_free_numeric(&NUMERIC(S), &COMMON(S)); FIRSTFACTORIZE(S) = 1; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* ---------------------------------------------------------------------------- * Function to set the ordering type for a KLU linear solver */ int SUNLinSol_KLUSetOrdering(SUNLinearSolver S, int ordering_choice) { /* Check for legal ordering_choice */ if ((ordering_choice < 0) || (ordering_choice > 2)) return(SUNLS_ILL_INPUT); /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set ordering_choice */ COMMON(S).ordering = ordering_choice; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_KLU(SUNLinearSolver S) { return(SUNLINEARSOLVER_DIRECT); } int SUNLinSolInitialize_KLU(SUNLinearSolver S) { /* Force factorization */ FIRSTFACTORIZE(S) = 1; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_KLU(SUNLinearSolver S, SUNMatrix A) { int retval; realtype uround_twothirds; uround_twothirds = SUNRpowerR(UNIT_ROUNDOFF,TWOTHIRDS); /* Ensure that A is a sparse matrix */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) { LASTFLAG(S) = SUNLS_ILL_INPUT; return(LASTFLAG(S)); } /* On first decomposition, get the symbolic factorization */ if (FIRSTFACTORIZE(S)) { /* Perform symbolic analysis of sparsity structure */ if (SYMBOLIC(S)) sun_klu_free_symbolic(&SYMBOLIC(S), &COMMON(S)); SYMBOLIC(S) = sun_klu_analyze(SUNSparseMatrix_NP(A), (KLU_INDEXTYPE*) SUNSparseMatrix_IndexPointers(A), (KLU_INDEXTYPE*) SUNSparseMatrix_IndexValues(A), &COMMON(S)); if (SYMBOLIC(S) == NULL) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_UNREC; return(LASTFLAG(S)); } /* ------------------------------------------------------------ Compute the LU factorization of the matrix ------------------------------------------------------------*/ if(NUMERIC(S)) sun_klu_free_numeric(&NUMERIC(S), &COMMON(S)); NUMERIC(S) = sun_klu_factor((KLU_INDEXTYPE*) SUNSparseMatrix_IndexPointers(A), (KLU_INDEXTYPE*) SUNSparseMatrix_IndexValues(A), SUNSparseMatrix_Data(A), SYMBOLIC(S), &COMMON(S)); if (NUMERIC(S) == NULL) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_UNREC; return(LASTFLAG(S)); } FIRSTFACTORIZE(S) = 0; } else { /* not the first decomposition, so just refactor */ retval = sun_klu_refactor((KLU_INDEXTYPE*) SUNSparseMatrix_IndexPointers(A), (KLU_INDEXTYPE*) SUNSparseMatrix_IndexValues(A), SUNSparseMatrix_Data(A), SYMBOLIC(S), NUMERIC(S), &COMMON(S)); if (retval == 0) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_REC; return(LASTFLAG(S)); } /*----------------------------------------------------------- Check if a cheap estimate of the reciprocal of the condition number is getting too small. If so, delete the prior numeric factorization and recompute it. -----------------------------------------------------------*/ retval = sun_klu_rcond(SYMBOLIC(S), NUMERIC(S), &COMMON(S)); if (retval == 0) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_REC; return(LASTFLAG(S)); } if ( COMMON(S).rcond < uround_twothirds ) { /* Condition number may be getting large. Compute more accurate estimate */ retval = sun_klu_condest((KLU_INDEXTYPE*) SUNSparseMatrix_IndexPointers(A), SUNSparseMatrix_Data(A), SYMBOLIC(S), NUMERIC(S), &COMMON(S)); if (retval == 0) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_REC; return(LASTFLAG(S)); } if ( COMMON(S).condest > (ONE/uround_twothirds) ) { /* More accurate estimate also says condition number is large, so recompute the numeric factorization */ sun_klu_free_numeric(&NUMERIC(S), &COMMON(S)); NUMERIC(S) = sun_klu_factor((KLU_INDEXTYPE*) SUNSparseMatrix_IndexPointers(A), (KLU_INDEXTYPE*) SUNSparseMatrix_IndexValues(A), SUNSparseMatrix_Data(A), SYMBOLIC(S), &COMMON(S)); if (NUMERIC(S) == NULL) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_UNREC; return(LASTFLAG(S)); } } } } LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSolve_KLU(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { int flag; realtype *xdata; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) return(SUNLS_MEM_NULL); /* copy b into x */ N_VScale(ONE, b, x); /* access x data array */ xdata = N_VGetArrayPointer(x); if (xdata == NULL) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* Call KLU to solve the linear system */ flag = SOLVE(S)(SYMBOLIC(S), NUMERIC(S), SUNSparseMatrix_NP(A), 1, xdata, &COMMON(S)); if (flag == 0) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_REC; return(LASTFLAG(S)); } LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } long int SUNLinSolLastFlag_KLU(SUNLinearSolver S) { /* return the stored 'last_flag' value */ return(LASTFLAG(S)); } int SUNLinSolSpace_KLU(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { /* since the klu structures are opaque objects, we omit those from these results */ *leniwLS = 2; *lenrwLS = 0; return(SUNLS_SUCCESS); } int SUNLinSolFree_KLU(SUNLinearSolver S) { /* return with success if already freed */ if (S == NULL) return(SUNLS_SUCCESS); /* delete items from the contents structure (if it exists) */ if (S->content) { if (NUMERIC(S)) sun_klu_free_numeric(&NUMERIC(S), &COMMON(S)); if (SYMBOLIC(S)) sun_klu_free_symbolic(&SYMBOLIC(S), &COMMON(S)); free(S->content); S->content = NULL; } /* delete generic structures */ if (S->ops) { free(S->ops); S->ops = NULL; } free(S); S = NULL; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ /* Inefficient kludge for determining the number of entries in a N_Vector object (replace if such a routine is ever added to the N_Vector API). Returns "-1" on an error. */ sunindextype GlobalVectorLength_KLU(N_Vector y) { realtype len; N_Vector tmp = NULL; tmp = N_VClone(y); if (tmp == NULL) return(-1); N_VConst(ONE, tmp); len = N_VDotProd(tmp, tmp); N_VDestroy(tmp); return( (sunindextype) len ); } StanHeaders/src/sunlinsol/klu/fsunlinsol_klu.c0000644000176200001440000001053313766554457021326 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_klu.h) contains the * implementation needed for the Fortran initialization of klu * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_klu.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNKLU_INIT(int *code, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_KLU(F2C_CVODE_vec, F2C_CVODE_matrix); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_KLU(F2C_IDA_vec, F2C_IDA_matrix); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_KLU(F2C_KINSOL_vec, F2C_KINSOL_matrix); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_KLU(F2C_ARKODE_vec, F2C_ARKODE_matrix); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNKLU_REINIT(int *code, long int *NNZ, int *reinit_type, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: *ier = SUNLinSol_KLUReInit(F2C_CVODE_linsol, F2C_CVODE_matrix, *NNZ, *reinit_type); break; case FCMIX_IDA: *ier = SUNLinSol_KLUReInit(F2C_IDA_linsol, F2C_IDA_matrix, *NNZ, *reinit_type); break; case FCMIX_KINSOL: *ier = SUNLinSol_KLUReInit(F2C_KINSOL_linsol, F2C_KINSOL_matrix, *NNZ, *reinit_type); break; case FCMIX_ARKODE: *ier = SUNLinSol_KLUReInit(F2C_ARKODE_linsol, F2C_ARKODE_matrix, *NNZ, *reinit_type); break; default: *ier = -1; } } void FSUNKLU_SETORDERING(int *code, int *ordering_choice, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: *ier = SUNLinSol_KLUSetOrdering(F2C_CVODE_linsol, *ordering_choice); break; case FCMIX_IDA: *ier = SUNLinSol_KLUSetOrdering(F2C_IDA_linsol, *ordering_choice); break; case FCMIX_KINSOL: *ier = SUNLinSol_KLUSetOrdering(F2C_KINSOL_linsol, *ordering_choice); break; case FCMIX_ARKODE: *ier = SUNLinSol_KLUSetOrdering(F2C_ARKODE_linsol, *ordering_choice); break; default: *ier = -1; } } void FSUNMASSKLU_INIT(int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_KLU(F2C_ARKODE_vec, F2C_ARKODE_mass_matrix); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSKLU_REINIT(long int *NNZ, int *reinit_type, int *ier) { *ier = 0; *ier = SUNLinSol_KLUReInit(F2C_ARKODE_mass_sol, F2C_ARKODE_mass_matrix, *NNZ, *reinit_type); } void FSUNMASSKLU_SETORDERING(int *ordering_choice, int *ier) { *ier = 0; *ier = SUNLinSol_KLUSetOrdering(F2C_ARKODE_mass_sol, *ordering_choice); } StanHeaders/src/sunlinsol/klu/F90/0000755000176200001440000000000013766554135016440 5ustar liggesusersStanHeaders/src/sunlinsol/klu/F90/fsunlinsol_klu.f900000644000176200001440000001052713766554457022043 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS sparse matrix using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_klu_mod use, intrinsic :: iso_c_binding, only : c_int integer(c_int), parameter :: SUNKLU_ORDERING_DEFAULT = 1 ! COLAMD integer(c_int), parameter :: SUNKLU_REINIT_FULL = 1 integer(c_int), parameter :: SUNKLU_REINIT_PARTIAL = 2 !======= Interfaces ======== interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNKLU(y, A) & bind(C,name='SUNKLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y type(c_ptr), value :: A end function FSUNKLU ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_KLU(LS) & bind(C,name='SUNLinSolFree_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_KLU ! ================================================================= ! Setter/init routines ! ================================================================= integer(c_int) function FSUNKLUReInit(LS, A, nnz, reinit_type) & bind(C,name='SUNKLUReInit') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A integer(c_long), value :: nnz integer(c_int), value :: reinit_type end function FSUNKLUReInit integer(c_int) function FSUNKLUSetOrdering(LS, ordering_choice) & bind(C,name='SUNKLUSetOrdering') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: ordering_choice end function FSUNKLUSetOrdering ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_KLU(LS) & bind(C,name='SUNLinSolGetType_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_KLU integer(c_int) function FSUNLinSolInitialize_KLU(LS) & bind(C,name='SUNLinSolInitialize_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_KLU integer(c_int) function FSUNLinSolSetup_KLU(LS, A) & bind(C,name='SUNLinSolSetup_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_KLU integer(c_int) function FSUNLinSolSolve_KLU(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_KLU integer(c_long) function FSUNLinSolLastFlag_KLU(LS) & bind(C,name='SUNLinSolLastFlag_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_KLU integer(c_int) function FSUNLinSolSpace_KLU(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_KLU') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long), value :: lenrwLS integer(c_long), value :: leniwLS end function FSUNLinSolSpace_KLU end interface end module fsunlinsol_klu_mod StanHeaders/src/sunlinsol/dense/0000755000176200001440000000000013766554456016413 5ustar liggesusersStanHeaders/src/sunlinsol/dense/fsunlinsol_dense.c0000644000176200001440000000564213766554457022141 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_dense.h) contains the * implementation needed for the Fortran initialization of dense * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_dense.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNDENSELINSOL_INIT(int *code, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_Dense(F2C_CVODE_vec, F2C_CVODE_matrix); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_Dense(F2C_IDA_vec, F2C_IDA_matrix); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_Dense(F2C_KINSOL_vec, F2C_KINSOL_matrix); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_Dense(F2C_ARKODE_vec, F2C_ARKODE_matrix); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNMASSDENSELINSOL_INIT(int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_Dense(F2C_ARKODE_vec, F2C_ARKODE_mass_matrix); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } StanHeaders/src/sunlinsol/dense/fsunlinsol_dense.h0000644000176200001440000000361213766554457022141 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_dense.c) contains the * definitions needed for the initialization of dense * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_DENSE_H #define _FSUNLINSOL_DENSE_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNDENSELINSOL_INIT SUNDIALS_F77_FUNC(fsundenselinsolinit, FSUNDENSELINSOLINIT) #define FSUNMASSDENSELINSOL_INIT SUNDIALS_F77_FUNC(fsunmassdenselinsolinit, FSUNMASSDENSELINSOLINIT) #else #define FSUNDENSELINSOL_INIT fsundenselinsolinit_ #define FSUNMASSDENSELINSOL_INIT fsunmassdenselinsolinit_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNDENSELINSOL_INIT - initializes dense linear solver for main problem * FSUNMASSDENSELINSOL_INIT - initializes dense linear solver for mass matrix solve */ void FSUNDENSELINSOL_INIT(int *code, int *ier); void FSUNMASSDENSELINSOL_INIT(int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/dense/sunlinsol_dense.c0000644000176200001440000001712113766554457021766 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the dense implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ONE RCONST(1.0) /* Private function prototypes */ sunindextype GlobalVectorLength_DenseLS(N_Vector y); /* * ----------------------------------------------------------------- * Dense solver structure accessibility macros: * ----------------------------------------------------------------- */ #define DENSE_CONTENT(S) ( (SUNLinearSolverContent_Dense)(S->content) ) #define PIVOTS(S) ( DENSE_CONTENT(S)->pivots ) #define LASTFLAG(S) ( DENSE_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNDenseLinearSolver(N_Vector y, SUNMatrix A) { return(SUNLinSol_Dense(y, A)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new dense linear solver */ SUNLinearSolver SUNLinSol_Dense(N_Vector y, SUNMatrix A) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_Dense content; sunindextype MatrixRows, VecLength; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) return(NULL); if (SUNDenseMatrix_Rows(A) != SUNDenseMatrix_Columns(A)) return(NULL); MatrixRows = SUNDenseMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_DenseLS(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_Dense; ops->initialize = SUNLinSolInitialize_Dense; ops->setup = SUNLinSolSetup_Dense; ops->solve = SUNLinSolSolve_Dense; ops->lastflag = SUNLinSolLastFlag_Dense; ops->space = SUNLinSolSpace_Dense; ops->free = SUNLinSolFree_Dense; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_Dense) malloc(sizeof(struct _SUNLinearSolverContent_Dense)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->N = MatrixRows; content->last_flag = 0; content->pivots = NULL; content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); if (content->pivots == NULL) { free(content); free(ops); free(S); return(NULL); } /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_Dense(SUNLinearSolver S) { return(SUNLINEARSOLVER_DIRECT); } int SUNLinSolInitialize_Dense(SUNLinearSolver S) { /* all solver-specific memory has already been allocated */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_Dense(SUNLinearSolver S, SUNMatrix A) { realtype **A_cols; sunindextype *pivots; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) ) return(SUNLS_MEM_NULL); /* Ensure that A is a dense matrix */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) { LASTFLAG(S) = SUNLS_ILL_INPUT; return(LASTFLAG(S)); } /* access data pointers (return with failure on NULL) */ A_cols = NULL; pivots = NULL; A_cols = SUNDenseMatrix_Cols(A); pivots = PIVOTS(S); if ( (A_cols == NULL) || (pivots == NULL) ) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* perform LU factorization of input matrix */ LASTFLAG(S) = denseGETRF(A_cols, SUNDenseMatrix_Rows(A), SUNDenseMatrix_Columns(A), pivots); /* store error flag (if nonzero, this row encountered zero-valued pivod) */ if (LASTFLAG(S) > 0) return(SUNLS_LUFACT_FAIL); return(SUNLS_SUCCESS); } int SUNLinSolSolve_Dense(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { realtype **A_cols, *xdata; sunindextype *pivots; if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) return(SUNLS_MEM_NULL); /* copy b into x */ N_VScale(ONE, b, x); /* access data pointers (return with failure on NULL) */ A_cols = NULL; xdata = NULL; pivots = NULL; A_cols = SUNDenseMatrix_Cols(A); xdata = N_VGetArrayPointer(x); pivots = PIVOTS(S); if ( (A_cols == NULL) || (xdata == NULL) || (pivots == NULL) ) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* solve using LU factors */ denseGETRS(A_cols, SUNDenseMatrix_Rows(A), pivots, xdata); LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } long int SUNLinSolLastFlag_Dense(SUNLinearSolver S) { /* return the stored 'last_flag' value */ return(LASTFLAG(S)); } int SUNLinSolSpace_Dense(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { *leniwLS = 2 + DENSE_CONTENT(S)->N; *lenrwLS = 0; return(SUNLS_SUCCESS); } int SUNLinSolFree_Dense(SUNLinearSolver S) { /* return if S is already free */ if (S == NULL) return(SUNLS_SUCCESS); /* delete items from contents, then delete generic structure */ if (S->content) { if (PIVOTS(S)) { free(PIVOTS(S)); PIVOTS(S) = NULL; } free(S->content); S->content = NULL; } if (S->ops) { free(S->ops); S->ops = NULL; } free(S); S = NULL; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ /* Inefficient kludge for determining the number of entries in a N_Vector object (replace if such a routine is ever added to the N_Vector API). Returns "-1" on an error. */ sunindextype GlobalVectorLength_DenseLS(N_Vector y) { realtype len; N_Vector tmp = NULL; tmp = N_VClone(y); if (tmp == NULL) return(-1); N_VConst(ONE, tmp); len = N_VDotProd(tmp, tmp); N_VDestroy(tmp); return( (sunindextype) len ); } StanHeaders/src/sunlinsol/dense/F90/0000755000176200001440000000000013766554135016743 5ustar liggesusersStanHeaders/src/sunlinsol/dense/F90/fsunlinsol_dense.f900000644000176200001440000000737413766554457022657 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): David J. Gardner @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS dense linear solver using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_dense_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_Dense(y, A) & bind(C,name='SUNLinSol_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y type(c_ptr), value :: A end function FSUNLinSol_Dense ! Deprecated type(c_ptr) function FSUNDenseLinearSolver(y, A) & bind(C,name='SUNDenseLinearSolver') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y type(c_ptr), value :: A end function FSUNDenseLinearSolver ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_Dense(LS) & bind(C,name='SUNLinSolFree_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_Dense ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_Dense(LS) & bind(C,name='SUNLinSolGetType_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_Dense integer(c_int) function FSUNLinSolInitialize_Dense(LS) & bind(C,name='SUNLinSolInitialize_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_Dense integer(c_int) function FSUNLinSolSetup_Dense(LS, A) & bind(C,name='SUNLinSolSetup_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_Dense integer(c_int) function FSUNLinSolSolve_Dense(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_Dense integer(c_long) function FSUNLinSolLastFlag_Dense(LS) & bind(C,name='SUNLinSolLastFlag_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_Dense integer(c_int) function FSUNLinSolSpace_Dense(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_Dense end interface end module fsunlinsol_dense_mod StanHeaders/src/sunlinsol/spfgmr/0000755000176200001440000000000013766554135016605 5ustar liggesusersStanHeaders/src/sunlinsol/spfgmr/sunlinsol_spfgmr.c0000644000176200001440000005227513766554457022377 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on sundials_spfgmr.c code, written by Daniel R. Reynolds * and Hilari C. Tiedeman @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the SPFGMR implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * SPFGMR solver structure accessibility macros: * ----------------------------------------------------------------- */ #define SPFGMR_CONTENT(S) ( (SUNLinearSolverContent_SPFGMR)(S->content) ) #define LASTFLAG(S) ( SPFGMR_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNSPFGMR(N_Vector y, int pretype, int maxl) { return(SUNLinSol_SPFGMR(y, pretype, maxl)); } int SUNSPFGMRSetPrecType(SUNLinearSolver S, int pretype) { return(SUNLinSol_SPFGMRSetPrecType(S, pretype)); } int SUNSPFGMRSetGSType(SUNLinearSolver S, int gstype) { return(SUNLinSol_SPFGMRSetGSType(S, gstype)); } int SUNSPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) { return(SUNLinSol_SPFGMRSetMaxRestarts(S, maxrs)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new SPFGMR linear solver */ SUNLinearSolver SUNLinSol_SPFGMR(N_Vector y, int pretype, int maxl) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_SPFGMR content; /* set preconditioning flag (enabling any preconditioner implies right preconditioning, since SPFGMR does not support left preconditioning) */ pretype = ( (pretype == PREC_LEFT) || (pretype == PREC_RIGHT) || (pretype == PREC_BOTH) ) ? PREC_RIGHT : PREC_NONE; /* if maxl input is illegal, set to default */ if (maxl <= 0) maxl = SUNSPFGMR_MAXL_DEFAULT; /* check that the supplied N_Vector supports all requisite operations */ if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || (y->ops->nvlinearsum == NULL) || (y->ops->nvconst == NULL) || (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_SPFGMR; ops->setatimes = SUNLinSolSetATimes_SPFGMR; ops->setpreconditioner = SUNLinSolSetPreconditioner_SPFGMR; ops->setscalingvectors = SUNLinSolSetScalingVectors_SPFGMR; ops->initialize = SUNLinSolInitialize_SPFGMR; ops->setup = SUNLinSolSetup_SPFGMR; ops->solve = SUNLinSolSolve_SPFGMR; ops->numiters = SUNLinSolNumIters_SPFGMR; ops->resnorm = SUNLinSolResNorm_SPFGMR; ops->resid = SUNLinSolResid_SPFGMR; ops->lastflag = SUNLinSolLastFlag_SPFGMR; ops->space = SUNLinSolSpace_SPFGMR; ops->free = SUNLinSolFree_SPFGMR; /* Create content */ content = NULL; content = (SUNLinearSolverContent_SPFGMR) malloc(sizeof(struct _SUNLinearSolverContent_SPFGMR)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->last_flag = 0; content->maxl = maxl; content->pretype = pretype; content->gstype = SUNSPFGMR_GSTYPE_DEFAULT; content->max_restarts = SUNSPFGMR_MAXRS_DEFAULT; content->numiters = 0; content->resnorm = ZERO; content->xcor = N_VClone(y); if (content->xcor == NULL) return(NULL); content->vtemp = N_VClone(y); if (content->vtemp == NULL) return(NULL); content->s1 = NULL; content->s2 = NULL; content->ATimes = NULL; content->ATData = NULL; content->Psetup = NULL; content->Psolve = NULL; content->PData = NULL; content->V = NULL; content->Z = NULL; content->Hes = NULL; content->givens = NULL; content->yg = NULL; content->cv = NULL; content->Xv = NULL; /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to toggle preconditioning on/off -- turns on if pretype is any * one of PREC_LEFT, PREC_RIGHT or PREC_BOTH; otherwise turns off */ SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetPrecType(SUNLinearSolver S, int pretype) { /* Check for legal pretype */ pretype = ( (pretype == PREC_LEFT) || (pretype == PREC_RIGHT) || (pretype == PREC_BOTH) ) ? PREC_RIGHT : PREC_NONE; /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ SPFGMR_CONTENT(S)->pretype = pretype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the type of Gram-Schmidt orthogonalization for SPFGMR to use */ SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetGSType(SUNLinearSolver S, int gstype) { /* Check for legal gstype */ if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { return(SUNLS_ILL_INPUT); } /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ SPFGMR_CONTENT(S)->gstype = gstype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the maximum number of FGMRES restarts to allow */ SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) { /* Illegal maxrs implies use of default value */ if (maxrs < 0) maxrs = SUNSPFGMR_MAXRS_DEFAULT; /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set max_restarts */ SPFGMR_CONTENT(S)->max_restarts = maxrs; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_SPFGMR(SUNLinearSolver S) { return(SUNLINEARSOLVER_ITERATIVE); } int SUNLinSolInitialize_SPFGMR(SUNLinearSolver S) { int k; SUNLinearSolverContent_SPFGMR content; /* set shortcut to SPFGMR memory structure */ if (S == NULL) return(SUNLS_MEM_NULL); content = SPFGMR_CONTENT(S); /* ensure valid options */ if (content->max_restarts < 0) content->max_restarts = SUNSPFGMR_MAXRS_DEFAULT; if ( (content->pretype != PREC_LEFT) && (content->pretype != PREC_RIGHT) && (content->pretype != PREC_BOTH) ) content->pretype = PREC_NONE; /* allocate solver-specific memory (where the size depends on the choice of maxl) here */ /* Krylov subspace vectors */ if (content->V == NULL) { content->V = N_VCloneVectorArray(content->maxl+1, content->vtemp); if (content->V == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* Preconditioned basis vectors */ if (content->Z == NULL) { content->Z = N_VCloneVectorArray(content->maxl+1, content->vtemp); if (content->Z == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* Hessenberg matrix Hes */ if (content->Hes == NULL) { content->Hes = (realtype **) malloc((content->maxl+1)*sizeof(realtype *)); if (content->Hes == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } for (k=0; k<=content->maxl; k++) { content->Hes[k] = NULL; content->Hes[k] = (realtype *) malloc(content->maxl*sizeof(realtype)); if (content->Hes[k] == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } } /* Givens rotation components */ if (content->givens == NULL) { content->givens = (realtype *) malloc(2*content->maxl*sizeof(realtype)); if (content->givens == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* y and g vectors */ if (content->yg == NULL) { content->yg = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); if (content->yg == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* cv vector for fused vector ops */ if (content->cv == NULL) { content->cv = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); if (content->cv == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* Xv vector for fused vector ops */ if (content->Xv == NULL) { content->Xv = (N_Vector *) malloc((content->maxl+1)*sizeof(N_Vector)); if (content->Xv == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* return with success */ content->last_flag = SUNLS_SUCCESS; return(SUNLS_SUCCESS); } int SUNLinSolSetATimes_SPFGMR(SUNLinearSolver S, void* ATData, ATimesFn ATimes) { /* set function pointers to integrator-supplied ATimes routine and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPFGMR_CONTENT(S)->ATimes = ATimes; SPFGMR_CONTENT(S)->ATData = ATData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetPreconditioner_SPFGMR(SUNLinearSolver S, void* PData, PSetupFn Psetup, PSolveFn Psolve) { /* set function pointers to integrator-supplied Psetup and PSolve routines and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPFGMR_CONTENT(S)->Psetup = Psetup; SPFGMR_CONTENT(S)->Psolve = Psolve; SPFGMR_CONTENT(S)->PData = PData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetScalingVectors_SPFGMR(SUNLinearSolver S, N_Vector s1, N_Vector s2) { /* set N_Vector pointers to integrator-supplied scaling vectors, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPFGMR_CONTENT(S)->s1 = s1; SPFGMR_CONTENT(S)->s2 = s2; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_SPFGMR(SUNLinearSolver S, SUNMatrix A) { int ier; PSetupFn Psetup; void* PData; /* Set shortcuts to SPFGMR memory structures */ if (S == NULL) return(SUNLS_MEM_NULL); Psetup = SPFGMR_CONTENT(S)->Psetup; PData = SPFGMR_CONTENT(S)->PData; /* no solver-specific setup is required, but if user-supplied Psetup routine exists, call that here */ if (Psetup != NULL) { ier = Psetup(PData); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; return(LASTFLAG(S)); } } /* return with success */ return(SUNLS_SUCCESS); } int SUNLinSolSolve_SPFGMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype delta) { /* local data and shortcut variables */ N_Vector *V, *Z, xcor, vtemp, s1, s2; realtype **Hes, *givens, *yg, *res_norm; realtype beta, rotation_product, r_norm, s_product, rho; booleantype preOnRight, scale1, scale2, converged; int i, j, k, l, l_max, krydim, ier, ntries, max_restarts, gstype; int *nli; void *A_data, *P_data; ATimesFn atimes; PSolveFn psolve; /* local shortcuts for fused vector operations */ realtype* cv; N_Vector* Xv; /* Initialize some variables */ krydim = 0; /* Make local shorcuts to solver variables. */ if (S == NULL) return(SUNLS_MEM_NULL); l_max = SPFGMR_CONTENT(S)->maxl; max_restarts = SPFGMR_CONTENT(S)->max_restarts; gstype = SPFGMR_CONTENT(S)->gstype; V = SPFGMR_CONTENT(S)->V; Z = SPFGMR_CONTENT(S)->Z; Hes = SPFGMR_CONTENT(S)->Hes; givens = SPFGMR_CONTENT(S)->givens; xcor = SPFGMR_CONTENT(S)->xcor; yg = SPFGMR_CONTENT(S)->yg; vtemp = SPFGMR_CONTENT(S)->vtemp; s1 = SPFGMR_CONTENT(S)->s1; s2 = SPFGMR_CONTENT(S)->s2; A_data = SPFGMR_CONTENT(S)->ATData; P_data = SPFGMR_CONTENT(S)->PData; atimes = SPFGMR_CONTENT(S)->ATimes; psolve = SPFGMR_CONTENT(S)->Psolve; nli = &(SPFGMR_CONTENT(S)->numiters); res_norm = &(SPFGMR_CONTENT(S)->resnorm); cv = SPFGMR_CONTENT(S)->cv; Xv = SPFGMR_CONTENT(S)->Xv; /* Initialize counters and convergence flag */ *nli = 0; converged = SUNFALSE; /* set booleantype flags for internal solver options */ preOnRight = ( (SPFGMR_CONTENT(S)->pretype == PREC_LEFT) || (SPFGMR_CONTENT(S)->pretype == PREC_RIGHT) || (SPFGMR_CONTENT(S)->pretype == PREC_BOTH) ); scale1 = (s1 != NULL); scale2 = (s2 != NULL); /* Set vtemp and V[0] to initial (unscaled) residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) { N_VScale(ONE, b, vtemp); } else { ier = atimes(A_data, x, vtemp); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); } /* Apply left scaling to vtemp = r_0 to fill V[0]. */ if (scale1) { N_VProd(s1, vtemp, V[0]); } else { N_VScale(ONE, vtemp, V[0]); } /* Set r_norm = beta to L2 norm of V[0] = s1 r_0, and return if small */ *res_norm = r_norm = beta = SUNRsqrt(N_VDotProd(V[0], V[0])); if (r_norm <= delta) { LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* Initialize rho to avoid compiler warning message */ rho = beta; /* Set xcor = 0. */ N_VConst(ZERO, xcor); /* Begin outer iterations: up to (max_restarts + 1) attempts. */ for (ntries=0; ntries<=max_restarts; ntries++) { /* Initialize the Hessenberg matrix Hes and Givens rotation product. Normalize the initial vector V[0]. */ for (i=0; i<=l_max; i++) for (j=0; j0; i--) { yg[i] = s_product*givens[2*i-2]; s_product *= givens[2*i-1]; } yg[0] = s_product; /* Scale r_norm and yg. */ r_norm *= s_product; for (i=0; i<=krydim; i++) yg[i] *= r_norm; r_norm = SUNRabs(r_norm); /* Multiply yg by V_(krydim+1) to get last residual vector; restart. */ for (k=0; k<=krydim; k++) { cv[k] = yg[k]; Xv[k] = V[k]; } ier = N_VLinearCombination(krydim+1, cv, Xv, V[0]); if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); } /* Failed to converge, even after allowed restarts. If the residual norm was reduced below its initial value, compute and return x anyway. Otherwise return failure flag. */ if (rho < beta) { N_VLinearSum(ONE, x, ONE, xcor, x); { LASTFLAG(S) = SUNLS_RES_REDUCED; return(LASTFLAG(S)); } } LASTFLAG(S) = SUNLS_CONV_FAIL; return(LASTFLAG(S)); } int SUNLinSolNumIters_SPFGMR(SUNLinearSolver S) { /* return the stored 'numiters' value */ if (S == NULL) return(-1); return (SPFGMR_CONTENT(S)->numiters); } realtype SUNLinSolResNorm_SPFGMR(SUNLinearSolver S) { /* return the stored 'resnorm' value */ if (S == NULL) return(-ONE); return (SPFGMR_CONTENT(S)->resnorm); } N_Vector SUNLinSolResid_SPFGMR(SUNLinearSolver S) { /* return the stored 'vtemp' vector */ return (SPFGMR_CONTENT(S)->vtemp); } long int SUNLinSolLastFlag_SPFGMR(SUNLinearSolver S) { /* return the stored 'last_flag' value */ if (S == NULL) return(-1); return (LASTFLAG(S)); } int SUNLinSolSpace_SPFGMR(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { int maxl; sunindextype liw1, lrw1; maxl = SPFGMR_CONTENT(S)->maxl; if (SPFGMR_CONTENT(S)->vtemp->ops->nvspace) N_VSpace(SPFGMR_CONTENT(S)->vtemp, &lrw1, &liw1); else lrw1 = liw1 = 0; *lenrwLS = lrw1*(2*maxl + 4) + maxl*(maxl + 5) + 2; *leniwLS = liw1*(2*maxl + 4); return(SUNLS_SUCCESS); } int SUNLinSolFree_SPFGMR(SUNLinearSolver S) { int k; if (S == NULL) return(SUNLS_SUCCESS); /* delete items from within the content structure */ if (SPFGMR_CONTENT(S)->xcor) N_VDestroy(SPFGMR_CONTENT(S)->xcor); if (SPFGMR_CONTENT(S)->vtemp) N_VDestroy(SPFGMR_CONTENT(S)->vtemp); if (SPFGMR_CONTENT(S)->V) N_VDestroyVectorArray(SPFGMR_CONTENT(S)->V, SPFGMR_CONTENT(S)->maxl+1); if (SPFGMR_CONTENT(S)->Z) N_VDestroyVectorArray(SPFGMR_CONTENT(S)->Z, SPFGMR_CONTENT(S)->maxl+1); if (SPFGMR_CONTENT(S)->Hes) { for (k=0; k<=SPFGMR_CONTENT(S)->maxl; k++) if (SPFGMR_CONTENT(S)->Hes[k]) free(SPFGMR_CONTENT(S)->Hes[k]); free(SPFGMR_CONTENT(S)->Hes); } if (SPFGMR_CONTENT(S)->givens) free(SPFGMR_CONTENT(S)->givens); if (SPFGMR_CONTENT(S)->yg) free(SPFGMR_CONTENT(S)->yg); if (SPFGMR_CONTENT(S)->cv) free(SPFGMR_CONTENT(S)->cv); if (SPFGMR_CONTENT(S)->Xv) free(SPFGMR_CONTENT(S)->Xv); /* delete generic structures */ free(S->content); S->content = NULL; free(S->ops); S->ops = NULL; free(S); S = NULL; return(SUNLS_SUCCESS); } StanHeaders/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h0000644000176200001440000000732213766554457022543 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_spfgmr.c) contains the * definitions needed for the initialization of SPFGMR * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_SPFGMR_H #define _FSUNLINSOL_SPFGMR_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNSPFGMR_INIT SUNDIALS_F77_FUNC(fsunspfgmrinit, FSUNSPFGMRINIT) #define FSUNSPFGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunspfgmrsetgstype, FSUNSPFGMRSETGSTYPE) #define FSUNSPFGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunspfgmrsetprectype, FSUNSPFGMRSETPRECTYPE) #define FSUNSPFGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunspfgmrsetmaxrs, FSUNSPFGMRSETMAXRS) #define FSUNMASSSPFGMR_INIT SUNDIALS_F77_FUNC(fsunmassspfgmrinit, FSUNMASSSPFGMRINIT) #define FSUNMASSSPFGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunmassspfgmrsetgstype, FSUNMASSSPFGMRSETGSTYPE) #define FSUNMASSSPFGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmassspfgmrsetprectype, FSUNMASSSPFGMRSETPRECTYPE) #define FSUNMASSSPFGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunmassspfgmrsetmaxrs, FSUNMASSSPFGMRSETMAXRS) #else #define FSUNSPFGMR_INIT fsunspfgmrinit_ #define FSUNSPFGMR_SETGSTYPE fsunspfgmrsetgstype_ #define FSUNSPFGMR_SETPRECTYPE fsunspfgmrsetprectype_ #define FSUNSPFGMR_SETMAXRS fsunspfgmrsetmaxrs_ #define FSUNMASSSPFGMR_INIT fsunmassspfgmrinit_ #define FSUNMASSSPFGMR_SETGSTYPE fsunmassspfgmrsetgstype_ #define FSUNMASSSPFGMR_SETPRECTYPE fsunmassspfgmrsetprectype_ #define FSUNMASSSPFGMR_SETMAXRS fsunmassspfgmrsetmaxrs_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNSPFGMR_INIT - initializes SPFGMR linear solver for main problem * FSUNSPFGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for main problem * FSUNSPFGMR_SETPRECTYPE - sets the preconditioning type for main problem * FSUNSPFGMR_SETMAXRS - sets the maximum number of restarts to allow for main problem * * FSUNMASSSPFGMR_INIT - initializes SPFGMR linear solver for mass matrix solve * FSUNMASSSPFGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for mass matrix solve * FSUNMASSSPFGMR_SETPRECTYPE - sets the preconditioning type for mass matrix solve * FSUNMASSSPFGMR_SETMAXRS - sets the maximum number of restarts to allow for mass matrix solve */ void FSUNSPFGMR_INIT(int *code, int *pretype, int *maxl, int *ier); void FSUNSPFGMR_SETGSTYPE(int *code, int *gstype, int *ier); void FSUNSPFGMR_SETPRECTYPE(int *code, int *pretype, int *ier); void FSUNSPFGMR_SETMAXRS(int *code, int *maxrs, int *ier); void FSUNMASSSPFGMR_INIT(int *pretype, int *maxl, int *ier); void FSUNMASSSPFGMR_SETGSTYPE(int *gstype, int *ier); void FSUNMASSSPFGMR_SETPRECTYPE(int *pretype, int *ier); void FSUNMASSSPFGMR_SETMAXRS(int *maxrs, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c0000644000176200001440000001323313766554457022534 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_spfgmr.h) contains the * implementation needed for the Fortran initialization of SPFGMR * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_spfgmr.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNSPFGMR_INIT(int *code, int *pretype, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_SPFGMR(F2C_CVODE_vec, *pretype, *maxl); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_SPFGMR(F2C_IDA_vec, *pretype, *maxl); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_SPFGMR(F2C_KINSOL_vec, *pretype, *maxl); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_SPFGMR(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNSPFGMR_SETGSTYPE(int *code, int *gstype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetGSType(F2C_CVODE_linsol, *gstype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetGSType(F2C_IDA_linsol, *gstype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetGSType(F2C_KINSOL_linsol, *gstype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetGSType(F2C_ARKODE_linsol, *gstype); break; default: *ier = -1; } } void FSUNSPFGMR_SETPRECTYPE(int *code, int *pretype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetPrecType(F2C_CVODE_linsol, *pretype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetPrecType(F2C_IDA_linsol, *pretype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetPrecType(F2C_KINSOL_linsol, *pretype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetPrecType(F2C_ARKODE_linsol, *pretype); break; default: *ier = -1; } } void FSUNSPFGMR_SETMAXRS(int *code, int *maxrs, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_CVODE_linsol, *maxrs); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_IDA_linsol, *maxrs); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_KINSOL_linsol, *maxrs); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_ARKODE_linsol, *maxrs); break; default: *ier = -1; } } void FSUNMASSSPFGMR_INIT(int *pretype, int *maxl, int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_SPFGMR(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSSPFGMR_SETGSTYPE(int *gstype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetGSType(F2C_ARKODE_mass_sol, *gstype); } void FSUNMASSSPFGMR_SETPRECTYPE(int *pretype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetPrecType(F2C_ARKODE_mass_sol, *pretype); } void FSUNMASSSPFGMR_SETMAXRS(int *maxrs, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPFGMRSetMaxRestarts(F2C_ARKODE_mass_sol, *maxrs); } StanHeaders/src/sunlinsol/spfgmr/F90/0000755000176200001440000000000013766554135017143 5ustar liggesusersStanHeaders/src/sunlinsol/spfgmr/F90/fsunlinsol_spfgmr.f900000644000176200001440000001520513766554457023247 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS SPGMR linear solver using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_spfgmr_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_SPFGMR(y, pretype, maxl) & bind(C,name='SUNLinSol_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y integer(c_int), value :: pretype integer(c_int), value :: maxl end function FSUNLinSol_SPFGMR ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_SPFGMR(LS) & bind(C,name='SUNLinSolFree_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_SPFGMR ! ================================================================= ! Setters ! ================================================================= integer(c_int) function FSUNLinSol_SPFGMRSetPrecType(LS, pretype) & bind(C,name='SUNLinSol_SPFGMRSetPrecType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: pretype end function FSUNLinSol_SPFGMRSetPrecType integer(c_int) function FSUNLinSol_SPFGMRSetGSType(LS, gstype) & bind(C,name='SUNLinSol_SPFGMRSetGSType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: gstype end function FSUNLinSol_SPFGMRSetGSType integer(c_int) function FSUNLinSol_SPFGMRSetMaxRestarts(LS, maxrs) & bind(C,name='SUNLinSol_SPFGMRSetMaxRestarts') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: maxrs end function FSUNLinSol_SPFGMRSetMaxRestarts ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_SPFGMR(LS) & bind(C,name='SUNLinSolGetType_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_SPFGMR integer(c_int) function FSUNLinSolInitialize_SPFGMR(LS) & bind(C,name='SUNLinSolInitialize_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_SPFGMR integer(c_int) function FSUNLinSolSetATimes_SPFGMR(LS, A_data, ATimes) & bind(C,name='SUNLinSolSetATimes_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A_data type(c_funptr), value :: ATimes end function FSUNLinSolSetATimes_SPFGMR integer(c_int) function FSUNLinSolSetPreconditioner_SPFGMR(LS, & P_data, & Pset, & Psol) & bind(C,name='SUNLinSolSetPreconditioner_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: P_data type(c_funptr), value :: Pset type(c_funptr), value :: Psol end function FSUNLinSolSetPreconditioner_SPFGMR integer(c_int) function FSUNLinSolSetScalingVectors_SPFGMR(LS, s1, s2) & bind(C,name='SUNLinSolSetScalingVectors_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: s1 type(c_ptr), value :: s2 end function FSUNLinSolSetScalingVectors_SPFGMR integer(c_int) function FSUNLinSolSetup_SPFGMR(LS, A) & bind(C,name='SUNLinSolSetup_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_SPFGMR integer(c_int) function FSUNLinSolSolve_SPFGMR(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_SPFGMR integer(c_int) function FSUNLinSolNumIters_SPFGMR(LS) & bind(C,name='SUNLinSolNumIters_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolNumIters_SPFGMR real(c_double) function FSUNLinSolResNorm_SPFGMR(LS) & bind(C,name='SUNLinSolResNorm_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResNorm_SPFGMR type(c_ptr) function FSUNLinSolResid_SPFGMR(LS) & bind(C,name='SUNLinSolResid_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResid_SPFGMR integer(c_long) function FSUNLinSolLastFlag_SPFGMR(LS) & bind(C,name='SUNLinSolLastFlag_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_SPFGMR integer(c_int) function FSUNLinSolSpace_SPFGMR(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_SPFGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_SPFGMR end interface end module fsunlinsol_spfgmr_mod StanHeaders/src/sunlinsol/lapackdense/0000755000176200001440000000000013766554135017561 5ustar liggesusersStanHeaders/src/sunlinsol/lapackdense/sunlinsol_lapackdense.c0000644000176200001440000001701013766554457024313 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on codes _lapack.c by: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the LAPACK dense * implementation of the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Private function prototypes */ sunindextype GlobalVectorLength_LapDense(N_Vector y); /* * ----------------------------------------------------------------- * LapackDense solver structure accessibility macros: * ----------------------------------------------------------------- */ #define LAPACKDENSE_CONTENT(S) ( (SUNLinearSolverContent_LapackDense)(S->content) ) #define PIVOTS(S) ( LAPACKDENSE_CONTENT(S)->pivots ) #define LASTFLAG(S) ( LAPACKDENSE_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNLapackDense(N_Vector y, SUNMatrix A) { return(SUNLinSol_LapackDense(y, A)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new LAPACK dense linear solver */ SUNLinearSolver SUNLinSol_LapackDense(N_Vector y, SUNMatrix A) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_LapackDense content; sunindextype MatrixRows, VecLength; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) return(NULL); if (SUNDenseMatrix_Rows(A) != SUNDenseMatrix_Columns(A)) return(NULL); MatrixRows = SUNDenseMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_LapDense(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_LapackDense; ops->initialize = SUNLinSolInitialize_LapackDense; ops->setup = SUNLinSolSetup_LapackDense; ops->solve = SUNLinSolSolve_LapackDense; ops->lastflag = SUNLinSolLastFlag_LapackDense; ops->space = SUNLinSolSpace_LapackDense; ops->free = SUNLinSolFree_LapackDense; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_LapackDense) malloc(sizeof(struct _SUNLinearSolverContent_LapackDense)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->N = MatrixRows; content->last_flag = 0; content->pivots = NULL; content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); if (content->pivots == NULL) { free(content); free(ops); free(S); return(NULL); } /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_LapackDense(SUNLinearSolver S) { return(SUNLINEARSOLVER_DIRECT); } int SUNLinSolInitialize_LapackDense(SUNLinearSolver S) { /* all solver-specific memory has already been allocated */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_LapackDense(SUNLinearSolver S, SUNMatrix A) { int n, ier; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) ) return(SUNLS_MEM_NULL); /* Ensure that A is a dense matrix */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) { LASTFLAG(S) = SUNLS_ILL_INPUT; return(LASTFLAG(S)); } /* Call LAPACK to do LU factorization of A */ n = SUNDenseMatrix_Rows(A); xgetrf_f77(&n, &n, SUNDenseMatrix_Data(A), &n, PIVOTS(S), &ier); LASTFLAG(S) = (long int) ier; if (ier > 0) return(SUNLS_LUFACT_FAIL); if (ier < 0) return(SUNLS_PACKAGE_FAIL_UNREC); return(SUNLS_SUCCESS); } int SUNLinSolSolve_LapackDense(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { int n, one, ier; realtype *xdata; if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) return(SUNLS_MEM_NULL); /* copy b into x */ N_VScale(ONE, b, x); /* access x data array */ xdata = N_VGetArrayPointer(x); if (xdata == NULL) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* Call LAPACK to solve the linear system */ n = SUNDenseMatrix_Rows(A); one = 1; xgetrs_f77("N", &n, &one, SUNDenseMatrix_Data(A), &n, PIVOTS(S), xdata, &n, &ier, 1); LASTFLAG(S) = (long int) ier; if (ier < 0) return(SUNLS_PACKAGE_FAIL_UNREC); LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } long int SUNLinSolLastFlag_LapackDense(SUNLinearSolver S) { /* return the stored 'last_flag' value */ return(LASTFLAG(S)); } int SUNLinSolSpace_LapackDense(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { *lenrwLS = 0; *leniwLS = 2 + LAPACKDENSE_CONTENT(S)->N; return(SUNLS_SUCCESS); } int SUNLinSolFree_LapackDense(SUNLinearSolver S) { /* return if S is already free */ if (S == NULL) return(SUNLS_SUCCESS); /* delete items from contents, then delete generic structure */ if (S->content) { if (PIVOTS(S)) { free(PIVOTS(S)); PIVOTS(S) = NULL; } free(S->content); S->content = NULL; } if (S->ops) { free(S->ops); S->ops = NULL; } free(S); S = NULL; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ /* Inefficient kludge for determining the number of entries in a N_Vector object (replace if such a routine is ever added to the N_Vector API). Returns "-1" on an error. */ sunindextype GlobalVectorLength_LapDense(N_Vector y) { realtype len; N_Vector tmp = NULL; tmp = N_VClone(y); if (tmp == NULL) return(-1); N_VConst(ONE, tmp); len = N_VDotProd(tmp, tmp); N_VDestroy(tmp); return( (sunindextype) len ); } StanHeaders/src/sunlinsol/lapackdense/fsunlinsol_lapackdense.c0000644000176200001440000000547713766554457024477 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_lapackdense.h) contains the * implementation needed for the Fortran initialization of LAPACK * dense linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_lapackdense.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNLAPACKDENSE_INIT(int *code, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_LapackDense(F2C_CVODE_vec, F2C_CVODE_matrix); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_LapackDense(F2C_IDA_vec, F2C_IDA_matrix); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_LapackDense(F2C_KINSOL_vec, F2C_KINSOL_matrix); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_LapackDense(F2C_ARKODE_vec, F2C_ARKODE_matrix); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNMASSLAPACKDENSE_INIT(int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_LapackDense(F2C_ARKODE_vec, F2C_ARKODE_mass_matrix); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } StanHeaders/src/sunlinsol/lapackdense/fsunlinsol_lapackdense.h0000644000176200001440000000364013766554457024472 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_lapackdense.c) contains the * definitions needed for the initialization of LAPACK dense * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_LAPDENSE_H #define _FSUNLINSOL_LAPDENSE_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNLAPACKDENSE_INIT SUNDIALS_F77_FUNC(fsunlapackdenseinit, FSUNLAPACKDENSEINIT) #define FSUNMASSLAPACKDENSE_INIT SUNDIALS_F77_FUNC(fsunmasslapackdenseinit, FSUNMASSLAPACKDENSEINIT) #else #define FSUNLAPACKDENSE_INIT fsunlapackdenseinit_ #define FSUNMASSLAPACKDENSE_INIT fsunmasslapackdenseinit_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNLAPACKDENSE_INIT - initializes LAPACK dense linear solver for main problem * FSUNMASSLAPACKDENSE_INIT - initializes LAPACK dense linear solver for mass matrix solve */ void FSUNLAPACKDENSE_INIT(int *code, int *ier); void FSUNMASSLAPACKDENSE_INIT(int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/pcg/0000755000176200001440000000000013766554135016060 5ustar liggesusersStanHeaders/src/sunlinsol/pcg/fsunlinsol_pcg.c0000644000176200001440000001112613766554457021261 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_pcg.h) contains the * implementation needed for the Fortran initialization of PCG * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_pcg.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNPCG_INIT(int *code, int *pretype, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_PCG(F2C_CVODE_vec, *pretype, *maxl); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_PCG(F2C_IDA_vec, *pretype, *maxl); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_PCG(F2C_KINSOL_vec, *pretype, *maxl); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_PCG(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNPCG_SETPRECTYPE(int *code, int *pretype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetPrecType(F2C_CVODE_linsol, *pretype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetPrecType(F2C_IDA_linsol, *pretype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetPrecType(F2C_KINSOL_linsol, *pretype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetPrecType(F2C_ARKODE_linsol, *pretype); break; default: *ier = -1; } } void FSUNPCG_SETMAXL(int *code, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetMaxl(F2C_CVODE_linsol, *maxl); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetMaxl(F2C_IDA_linsol, *maxl); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetMaxl(F2C_KINSOL_linsol, *maxl); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetMaxl(F2C_ARKODE_linsol, *maxl); break; default: *ier = -1; } } void FSUNMASSPCG_INIT(int *pretype, int *maxl, int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_PCG(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSPCG_SETPRECTYPE(int *pretype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetPrecType(F2C_ARKODE_mass_sol, *pretype); } void FSUNMASSPCG_SETMAXL(int *maxl, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_PCGSetMaxl(F2C_ARKODE_mass_sol, *maxl); } StanHeaders/src/sunlinsol/pcg/fsunlinsol_pcg.h0000644000176200001440000000565113766554457021274 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_pcg.c) contains the * definitions needed for the initialization of PCG * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_PCG_H #define _FSUNLINSOL_PCG_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNPCG_INIT SUNDIALS_F77_FUNC(fsunpcginit, FSUNPCGINIT) #define FSUNPCG_SETPRECTYPE SUNDIALS_F77_FUNC(fsunpcgsetprectype, FSUNPCGSETPRECTYPE) #define FSUNPCG_SETMAXL SUNDIALS_F77_FUNC(fsunpcgsetmaxl, FSUNPCGSETMAXL) #define FSUNMASSPCG_INIT SUNDIALS_F77_FUNC(fsunmasspcginit, FSUNMASSPCGINIT) #define FSUNMASSPCG_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmasspcgsetprectype, FSUNMASSPCGSETPRECTYPE) #define FSUNMASSPCG_SETMAXL SUNDIALS_F77_FUNC(fsunmasspcgsetmaxl, FSUNMASSPCGSETMAXL) #else #define FSUNPCG_INIT fsunpcginit_ #define FSUNPCG_SETPRECTYPE fsunpcgsetprectype_ #define FSUNPCG_SETMAXL fsunpcgsetmaxl_ #define FSUNMASSPCG_INIT fsunmasspcginit_ #define FSUNMASSPCG_SETPRECTYPE fsunmasspcgsetprectype_ #define FSUNMASSPCG_SETMAXL fsunmasspcgsetmaxl_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNPCG_INIT - initializes PCG linear solver for main problem * FSUNPCG_SETPRECTYPE - sets preconditioning type for main problem * FSUNPCG_SETMAXL - sets the max number of iterations for main problem * * FSUNMASSPCG_INIT - initializes PCG linear solver for mass matrix solve * FSUNMASSPCG_SETPRECTYPE - sets preconditioning type for mass matrix solve * FSUNMASSPCG_SETMAXL - sets the max number of iterations for mass matrix solve */ void FSUNPCG_INIT(int *code, int *pretype, int *maxl, int *ier); void FSUNPCG_SETPRECTYPE(int *code, int *pretype, int *ier); void FSUNPCG_SETMAXL(int *code, int *maxl, int *ier); void FSUNMASSPCG_INIT(int *pretype, int *maxl, int *ier); void FSUNMASSPCG_SETPRECTYPE(int *pretype, int *ier); void FSUNMASSPCG_SETMAXL(int *maxl, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/pcg/F90/0000755000176200001440000000000013766554135016416 5ustar liggesusersStanHeaders/src/sunlinsol/pcg/F90/fsunlinsol_pcg.f900000644000176200001440000001427113766554457021777 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS PCG linear solver using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_pcg_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_PCG(y, pretype, maxl) & bind(C,name='SUNLinSol_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y integer(c_int), value :: pretype integer(c_int), value :: maxl end function FSUNLinSol_PCG ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_PCG(LS) & bind(C,name='SUNLinSolFree_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_PCG ! ================================================================= ! Setters ! ================================================================= integer(c_int) function FSUNLinSol_PCGSetPrecType(LS, pretype) & bind(C,name='SUNLinSol_PCGSetPrecType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: pretype end function FSUNLinSol_PCGSetPrecType integer(c_int) function FSUNLinSol_SPTFQMRSetMaxl(LS, maxl) & bind(C,name='SUNLinSol_SPTFQMRSetMaxl') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: maxl end function FSUNLinSol_SPTFQMRSetMaxl ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_PCG(LS) & bind(C,name='SUNLinSolGetType_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_PCG integer(c_int) function FSUNLinSolInitialize_PCG(LS) & bind(C,name='SUNLinSolInitialize_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_PCG integer(c_int) function FSUNLinSolSetATimes_PCG(LS, A_data, ATimes) & bind(C,name='SUNLinSolSetATimes_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A_data type(c_funptr), value :: ATimes end function FSUNLinSolSetATimes_PCG integer(c_int) function FSUNLinSolSetPreconditioner_PCG(LS, & P_data, & Pset, & Psol) & bind(C,name='SUNLinSolSetPreconditioner_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: P_data type(c_funptr), value :: Pset type(c_funptr), value :: Psol end function FSUNLinSolSetPreconditioner_PCG integer(c_int) function FSUNLinSolSetScalingVectors_PCG(LS, s1, nul) & bind(C,name='SUNLinSolSetScalingVectors_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: s1 type(c_ptr), value :: nul end function FSUNLinSolSetScalingVectors_PCG integer(c_int) function FSUNLinSolSetup_PCG(LS, nul) & bind(C,name='SUNLinSolSetup_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: nul end function FSUNLinSolSetup_PCG integer(c_int) function FSUNLinSolSolve_PCG(LS, nul, x, b, tol) & bind(C,name='SUNLinSolSolve_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: nul type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_PCG integer(c_int) function FSUNLinSolNumIters_PCG(LS) & bind(C,name='SUNLinSolNumIters_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolNumIters_PCG real(c_double) function FSUNLinSolResNorm_PCG(LS) & bind(C,name='SUNLinSolResNorm_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResNorm_PCG type(c_ptr) function FSUNLinSolResid_PCG(LS) & bind(C,name='SUNLinSolResid_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResid_PCG integer(c_long) function FSUNLinSolLastFlag_PCG(LS) & bind(C,name='SUNLinSolLastFlag_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_PCG integer(c_int) function FSUNLinSolSpace_PCG(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_PCG') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_PCG end interface end module fsunlinsol_pcg_mod StanHeaders/src/sunlinsol/pcg/sunlinsol_pcg.c0000644000176200001440000003203413766554457021114 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU * Based on sundials_pcg.c code, written by Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the PCG implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * PCG solver structure accessibility macros: * ----------------------------------------------------------------- */ #define PCG_CONTENT(S) ( (SUNLinearSolverContent_PCG)(S->content) ) #define PRETYPE(S) ( PCG_CONTENT(S)->pretype ) #define LASTFLAG(S) ( PCG_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNPCG(N_Vector y, int pretype, int maxl) { return(SUNLinSol_PCG(y, pretype, maxl)); } int SUNPCGSetPrecType(SUNLinearSolver S, int pretype) { return(SUNLinSol_PCGSetPrecType(S, pretype)); } int SUNPCGSetMaxl(SUNLinearSolver S, int maxl) { return(SUNLinSol_PCGSetMaxl(S, maxl)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new PCG linear solver */ SUNLinearSolver SUNLinSol_PCG(N_Vector y, int pretype, int maxl) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_PCG content; /* check for legal pretype and maxl values; if illegal use defaults */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; if (maxl <= 0) maxl = SUNPCG_MAXL_DEFAULT; /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_PCG; ops->setatimes = SUNLinSolSetATimes_PCG; ops->setpreconditioner = SUNLinSolSetPreconditioner_PCG; ops->setscalingvectors = SUNLinSolSetScalingVectors_PCG; ops->initialize = SUNLinSolInitialize_PCG; ops->setup = SUNLinSolSetup_PCG; ops->solve = SUNLinSolSolve_PCG; ops->numiters = SUNLinSolNumIters_PCG; ops->resnorm = SUNLinSolResNorm_PCG; ops->resid = SUNLinSolResid_PCG; ops->lastflag = SUNLinSolLastFlag_PCG; ops->space = SUNLinSolSpace_PCG; ops->free = SUNLinSolFree_PCG; /* Create content */ content = NULL; content = (SUNLinearSolverContent_PCG) malloc(sizeof(struct _SUNLinearSolverContent_PCG)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->last_flag = 0; content->maxl = maxl; content->pretype = pretype; content->numiters = 0; content->resnorm = ZERO; content->r = N_VClone(y); if (content->r == NULL) return NULL; content->p = N_VClone(y); if (content->p == NULL) return NULL; content->z = N_VClone(y); if (content->z == NULL) return NULL; content->Ap = N_VClone(y); if (content->Ap == NULL) return NULL; content->s = NULL; content->ATimes = NULL; content->ATData = NULL; content->Psetup = NULL; content->Psolve = NULL; content->PData = NULL; /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to set the type of preconditioning for PCG to use */ SUNDIALS_EXPORT int SUNLinSol_PCGSetPrecType(SUNLinearSolver S, int pretype) { /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { return(SUNLS_ILL_INPUT); } /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ PRETYPE(S) = pretype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the maximum number of iterations for PCG to use */ SUNDIALS_EXPORT int SUNLinSol_PCGSetMaxl(SUNLinearSolver S, int maxl) { /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Check for legal pretype */ if (maxl <= 0) maxl = SUNPCG_MAXL_DEFAULT; /* Set pretype */ PCG_CONTENT(S)->maxl = maxl; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_PCG(SUNLinearSolver S) { return(SUNLINEARSOLVER_ITERATIVE); } int SUNLinSolInitialize_PCG(SUNLinearSolver S) { /* ensure valid options */ if (S == NULL) return(SUNLS_MEM_NULL); if ( (PRETYPE(S) != PREC_LEFT) && (PRETYPE(S) != PREC_RIGHT) && (PRETYPE(S) != PREC_BOTH) ) PRETYPE(S) = PREC_NONE; if (PCG_CONTENT(S)->maxl <= 0) PCG_CONTENT(S)->maxl = SUNPCG_MAXL_DEFAULT; /* no additional memory to allocate */ /* return with success */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetATimes_PCG(SUNLinearSolver S, void* ATData, ATimesFn ATimes) { /* set function pointers to integrator-supplied ATimes routine and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); PCG_CONTENT(S)->ATimes = ATimes; PCG_CONTENT(S)->ATData = ATData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetPreconditioner_PCG(SUNLinearSolver S, void* PData, PSetupFn Psetup, PSolveFn Psolve) { /* set function pointers to integrator-supplied Psetup and PSolve routines and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); PCG_CONTENT(S)->Psetup = Psetup; PCG_CONTENT(S)->Psolve = Psolve; PCG_CONTENT(S)->PData = PData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetScalingVectors_PCG(SUNLinearSolver S, N_Vector s, N_Vector nul) { /* set N_Vector pointer to integrator-supplied scaling vector (only use the first one), and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); PCG_CONTENT(S)->s = s; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_PCG(SUNLinearSolver S, SUNMatrix nul) { int ier; PSetupFn Psetup; void* PData; /* Set shortcuts to PCG memory structures */ if (S == NULL) return(SUNLS_MEM_NULL); Psetup = PCG_CONTENT(S)->Psetup; PData = PCG_CONTENT(S)->PData; /* no solver-specific setup is required, but if user-supplied Psetup routine exists, call that here */ if (Psetup != NULL) { ier = Psetup(PData); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; return(LASTFLAG(S)); } } /* return with success */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSolve_PCG(SUNLinearSolver S, SUNMatrix nul, N_Vector x, N_Vector b, realtype delta) { /* local data and shortcut variables */ realtype alpha, beta, r0_norm, rho, rz, rz_old; N_Vector r, p, z, Ap, w; booleantype UsePrec, UseScaling, converged; int l, l_max, pretype, ier; void *A_data, *P_data; ATimesFn atimes; PSolveFn psolve; realtype *res_norm; int *nli; /* Make local shorcuts to solver variables. */ if (S == NULL) return(SUNLS_MEM_NULL); l_max = PCG_CONTENT(S)->maxl; r = PCG_CONTENT(S)->r; p = PCG_CONTENT(S)->p; z = PCG_CONTENT(S)->z; Ap = PCG_CONTENT(S)->Ap; w = PCG_CONTENT(S)->s; A_data = PCG_CONTENT(S)->ATData; P_data = PCG_CONTENT(S)->PData; atimes = PCG_CONTENT(S)->ATimes; psolve = PCG_CONTENT(S)->Psolve; pretype = PCG_CONTENT(S)->pretype; nli = &(PCG_CONTENT(S)->numiters); res_norm = &(PCG_CONTENT(S)->resnorm); /* Initialize counters and convergence flag */ *nli = 0; converged = SUNFALSE; /* set booleantype flags for internal solver options */ UsePrec = ( (pretype == PREC_BOTH) || (pretype == PREC_LEFT) || (pretype == PREC_RIGHT) ); UseScaling = (w != NULL); /* Set r to initial residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r); else { ier = atimes(A_data, x, r); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } N_VLinearSum(ONE, b, -ONE, r, r); } /* Set rho to scaled L2 norm of r, and return if small */ if (UseScaling) N_VProd(r, w, Ap); else N_VScale(ONE, r, Ap); *res_norm = r0_norm = rho = SUNRsqrt(N_VDotProd(Ap, Ap)); if (rho <= delta) { LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* Apply preconditioner and b-scaling to r = r_0 */ if (UsePrec) { ier = psolve(P_data, r, z, delta, PREC_LEFT); /* z = P^{-1}r */ if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, r, z); /* Initialize rz to */ rz = N_VDotProd(r, z); /* Copy z to p */ N_VScale(ONE, z, p); /* Begin main iteration loop */ for(l=0; l / */ alpha = rz / N_VDotProd(Ap, p); /* Update x = x + alpha*p */ N_VLinearSum(ONE, x, alpha, p, x); /* Update r = r - alpha*Ap */ N_VLinearSum(ONE, r, -alpha, Ap, r); /* Set rho and check convergence */ if (UseScaling) N_VProd(r, w, Ap); else N_VScale(ONE, r, Ap); *res_norm = rho = SUNRsqrt(N_VDotProd(Ap, Ap)); if (rho <= delta) { converged = SUNTRUE; break; } /* Apply preconditioner: z = P^{-1}*r */ if (UsePrec) { ier = psolve(P_data, r, z, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, r, z); /* update rz */ rz_old = rz; rz = N_VDotProd(r, z); /* Calculate beta = / */ beta = rz / rz_old; /* Update p = z + beta*p */ N_VLinearSum(ONE, z, beta, p, p); } /* Main loop finished, return with result */ if (converged == SUNTRUE) { LASTFLAG(S) = SUNLS_SUCCESS; } else if (rho < r0_norm) { LASTFLAG(S) = SUNLS_RES_REDUCED; } else { LASTFLAG(S) = SUNLS_CONV_FAIL; } return(LASTFLAG(S)); } int SUNLinSolNumIters_PCG(SUNLinearSolver S) { /* return the stored 'numiters' value */ if (S == NULL) return(-1); return (PCG_CONTENT(S)->numiters); } realtype SUNLinSolResNorm_PCG(SUNLinearSolver S) { /* return the stored 'resnorm' value */ if (S == NULL) return(-ONE); return (PCG_CONTENT(S)->resnorm); } N_Vector SUNLinSolResid_PCG(SUNLinearSolver S) { /* return the stored 'r' vector */ return (PCG_CONTENT(S)->r); } long int SUNLinSolLastFlag_PCG(SUNLinearSolver S) { /* return the stored 'last_flag' value */ if (S == NULL) return(-1); return (LASTFLAG(S)); } int SUNLinSolSpace_PCG(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { sunindextype liw1, lrw1; N_VSpace(PCG_CONTENT(S)->r, &lrw1, &liw1); *lenrwLS = 1 + lrw1*4; *leniwLS = 4 + liw1*4; return(SUNLS_SUCCESS); } int SUNLinSolFree_PCG(SUNLinearSolver S) { if (S == NULL) return(SUNLS_SUCCESS); /* delete items from within the content structure */ if (PCG_CONTENT(S)->r) N_VDestroy(PCG_CONTENT(S)->r); if (PCG_CONTENT(S)->p) N_VDestroy(PCG_CONTENT(S)->p); if (PCG_CONTENT(S)->z) N_VDestroy(PCG_CONTENT(S)->z); if (PCG_CONTENT(S)->Ap) N_VDestroy(PCG_CONTENT(S)->Ap); /* delete generic structures */ free(S->content); S->content = NULL; free(S->ops); S->ops = NULL; free(S); S = NULL; return 0; } StanHeaders/src/sunlinsol/superlumt/0000755000176200001440000000000013766554135017347 5ustar liggesusersStanHeaders/src/sunlinsol/superlumt/fsunlinsol_superlumt.h0000644000176200001440000000513713766554457024051 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_superlumt.c) contains the * definitions needed for the initialization of superlumt * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_SUPERLUMT_H #define _FSUNLINSOL_SUPERLUMT_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNSUPERLUMT_INIT SUNDIALS_F77_FUNC(fsunsuperlumtinit, FSUNSUPERLUMTINIT) #define FSUNSUPERLUMT_SETORDERING SUNDIALS_F77_FUNC(fsunsuperlumtsetordering, FSUNSUPERLUMTSETORDERING) #define FSUNMASSSUPERLUMT_INIT SUNDIALS_F77_FUNC(fsunmasssuperlumtinit, FSUNMASSSUPERLUMTINIT) #define FSUNMASSSUPERLUMT_SETORDERING SUNDIALS_F77_FUNC(fsunmasssuperlumtsetordering, FSUNMASSSUPERLUMTSETORDERING) #else #define FSUNSUPERLUMT_INIT fsunsuperlumtinit_ #define FSUNSUPERLUMT_SETORDERING fsunsuperlumtsetordering_ #define FSUNMASSSUPERLUMT_INIT fsunmasssuperlumtinit_ #define FSUNMASSSUPERLUMT_SETORDERING fsunmasssuperlumtsetordering_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNSUPERLUMT_INIT - initializes superlumt linear solver for main problem * FSUNSUPERLUMT_SETORDERING - sets the ordering choice used by SUPERLUMT for main problem * FSUNMASSSUPERLUMT_INIT - initializes superlumt linear solver for mass matrix * FSUNMASSSUPERLUMT_SETORDERING - sets the ordering choice used by SUPERLUMT for mass matrix */ void FSUNSUPERLUMT_INIT(int *code, int *num_threads, int *ier); void FSUNSUPERLUMT_SETORDERING(int *code, int *ordering, int *ier); void FSUNMASSSUPERLUMT_INIT(int *num_threads, int *ier); void FSUNMASSSUPERLUMT_SETORDERING(int *ordering, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/superlumt/sunlinsol_superlumt.c0000644000176200001440000003265313766554457023701 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on codes _superlumt.c, written by * Carol S. Woodward @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the SuperLUMT implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Private function prototypes */ sunindextype GlobalVectorLength_SuperLUMT(N_Vector y); /* * ----------------------------------------------------------------- * SuperLUMT solver structure accessibility macros: * ----------------------------------------------------------------- */ #define SLUMT_CONTENT(S) ( (SUNLinearSolverContent_SuperLUMT)(S->content) ) #define LASTFLAG(S) ( SLUMT_CONTENT(S)->last_flag ) #define FIRSTFACTORIZE(S) ( SLUMT_CONTENT(S)->first_factorize ) #define SM_A(S) ( SLUMT_CONTENT(S)->A ) #define SM_AC(S) ( SLUMT_CONTENT(S)->AC ) #define SM_L(S) ( SLUMT_CONTENT(S)->L ) #define SM_U(S) ( SLUMT_CONTENT(S)->U ) #define SM_B(S) ( SLUMT_CONTENT(S)->B ) #define GSTAT(S) ( SLUMT_CONTENT(S)->Gstat ) #define PERMR(S) ( SLUMT_CONTENT(S)->perm_r ) #define PERMC(S) ( SLUMT_CONTENT(S)->perm_c ) #define SIZE(S) ( SLUMT_CONTENT(S)->N ) #define NUMTHREADS(S) ( SLUMT_CONTENT(S)->num_threads ) #define DIAGPIVOTTHRESH(S) ( SLUMT_CONTENT(S)->diag_pivot_thresh ) #define ORDERING(S) ( SLUMT_CONTENT(S)->ordering ) #define OPTIONS(S) ( SLUMT_CONTENT(S)->options ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNSuperLUMT(N_Vector y, SUNMatrix A, int num_threads) { return(SUNLinSol_SuperLUMT(y, A, num_threads)); } int SUNSuperLUMTSetOrdering(SUNLinearSolver S, int ordering_choice) { return(SUNLinSol_SuperLUMTSetOrdering(S, ordering_choice)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new SuperLUMT linear solver */ SUNLinearSolver SUNLinSol_SuperLUMT(N_Vector y, SUNMatrix A, int num_threads) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_SuperLUMT content; sunindextype MatrixRows, VecLength; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return(NULL); if (SUNSparseMatrix_Rows(A) != SUNSparseMatrix_Columns(A)) return(NULL); MatrixRows = SUNSparseMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_SuperLUMT(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_SuperLUMT; ops->initialize = SUNLinSolInitialize_SuperLUMT; ops->setup = SUNLinSolSetup_SuperLUMT; ops->solve = SUNLinSolSolve_SuperLUMT; ops->lastflag = SUNLinSolLastFlag_SuperLUMT; ops->space = SUNLinSolSpace_SuperLUMT; ops->free = SUNLinSolFree_SuperLUMT; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_SuperLUMT) malloc(sizeof(struct _SUNLinearSolverContent_SuperLUMT)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->N = MatrixRows; content->last_flag = 0; content->num_threads = num_threads; content->diag_pivot_thresh = ONE; content->ordering = SUNSLUMT_ORDERING_DEFAULT; content->perm_r = NULL; content->perm_r = (sunindextype *) malloc(MatrixRows*sizeof(sunindextype)); if (content->perm_r == NULL) { free(content); free(ops); free(S); return(NULL); } content->perm_c = NULL; content->perm_c = (sunindextype *) malloc(MatrixRows*sizeof(sunindextype)); if (content->perm_c == NULL) { free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->Gstat = (Gstat_t *) malloc(sizeof(Gstat_t)); if (content->Gstat == NULL) { free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->A = (SuperMatrix *) malloc(sizeof(SuperMatrix)); if (content->A == NULL) { free(content->Gstat); free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->A->Store = NULL; content->AC = (SuperMatrix *) malloc(sizeof(SuperMatrix)); if (content->AC == NULL) { free(content->A); free(content->Gstat); free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->AC->Store = NULL; content->L = (SuperMatrix *) malloc(sizeof(SuperMatrix)); if (content->L == NULL) { free(content->AC); free(content->A); free(content->Gstat); free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->L->Store = NULL; content->U = (SuperMatrix *) malloc(sizeof(SuperMatrix)); if (content->U == NULL) { free(content->L); free(content->AC); free(content->A); free(content->Gstat); free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->U->Store = NULL; content->B = (SuperMatrix *) malloc(sizeof(SuperMatrix)); if (content->B == NULL) { free(content->U); free(content->L); free(content->AC); free(content->A); free(content->Gstat); free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } content->B->Store = NULL; xCreate_Dense_Matrix(content->B, MatrixRows, 1, NULL, MatrixRows, SLU_DN, SLU_D, SLU_GE); content->options = (superlumt_options_t *) malloc(sizeof(superlumt_options_t)); if (content->options == NULL) { free(content->B); free(content->U); free(content->L); free(content->AC); free(content->A); free(content->Gstat); free(content->perm_c); free(content->perm_r); free(content); free(ops); free(S); return(NULL); } StatAlloc(MatrixRows, num_threads, sp_ienv(1), sp_ienv(2), content->Gstat); /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to set the ordering type for a SuperLUMT linear solver */ int SUNLinSol_SuperLUMTSetOrdering(SUNLinearSolver S, int ordering_choice) { /* Check for legal ordering_choice */ if ((ordering_choice < 0) || (ordering_choice > 3)) return(SUNLS_ILL_INPUT); /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set ordering_choice */ ORDERING(S) = ordering_choice; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_SuperLUMT(SUNLinearSolver S) { return(SUNLINEARSOLVER_DIRECT); } int SUNLinSolInitialize_SuperLUMT(SUNLinearSolver S) { /* force a first factorization */ FIRSTFACTORIZE(S) = 1; /* Initialize statistics variables */ StatInit(SIZE(S), NUMTHREADS(S), GSTAT(S)); LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_SuperLUMT(SUNLinearSolver S, SUNMatrix A) { int_t retval; int panel_size, relax, lwork; double drop_tol; fact_t fact; trans_t trans; yes_no_t refact, usepr; void *work; /* Set option values for SuperLU_MT */ panel_size = sp_ienv(1); relax = sp_ienv(2); fact = EQUILIBRATE; trans = (SUNSparseMatrix_SparseType(A) == CSC_MAT) ? NOTRANS : TRANS; usepr = NO; drop_tol = ZERO; lwork = 0; work = NULL; /* free and reallocate sparse matrix */ if (SM_A(S)->Store) SUPERLU_FREE(SM_A(S)->Store); xCreate_CompCol_Matrix(SM_A(S), SUNSparseMatrix_Rows(A), SUNSparseMatrix_Columns(A), SUNSparseMatrix_NNZ(A), SUNSparseMatrix_Data(A), (int_t*) SUNSparseMatrix_IndexValues(A), (int_t*) SUNSparseMatrix_IndexPointers(A), SLU_NC, SLU_D, SLU_GE); /* On first decomposition, set up reusable pieces */ if (FIRSTFACTORIZE(S)) { /* Get column permutation vector perm_c[], according to ordering */ get_perm_c(ORDERING(S), SM_A(S), (int_t *) PERMC(S)); refact = NO; FIRSTFACTORIZE(S) = 0; } else { /* Re-initialize statistics variables */ StatInit(SIZE(S), NUMTHREADS(S), GSTAT(S)); Destroy_CompCol_Permuted(SM_AC(S)); refact = YES; } /* Initialize the option structure using the user-input parameters. Subsequent calls will re-initialize options. Apply perm_c to columns of original A to form AC */ pxgstrf_init(NUMTHREADS(S), fact, trans, refact, panel_size, relax, DIAGPIVOTTHRESH(S), usepr, drop_tol, (int_t *) PERMC(S), (int_t *) PERMR(S), work, lwork, SM_A(S), SM_AC(S), OPTIONS(S), GSTAT(S)); /* Compute the LU factorization of A. The following routine will create num_threads threads. */ pxgstrf(OPTIONS(S), SM_AC(S), (int_t *) PERMR(S), SM_L(S), SM_U(S), GSTAT(S), &retval); if (retval != 0) { LASTFLAG(S) = (retval < 0) ? SUNLS_PACKAGE_FAIL_UNREC : SUNLS_PACKAGE_FAIL_REC; return(LASTFLAG(S)); } LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSolve_SuperLUMT(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { int_t retval; realtype *xdata; DNformat *Bstore; trans_t trans; /* copy b into x */ N_VScale(ONE, b, x); /* access x data array */ xdata = N_VGetArrayPointer(x); if (xdata == NULL) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } Bstore = (DNformat *) (SM_B(S)->Store); Bstore->nzval = xdata; /* Call SuperLUMT to solve the linear system using L and U */ trans = (SUNSparseMatrix_SparseType(A) == CSC_MAT) ? NOTRANS : TRANS; xgstrs(trans, SM_L(S), SM_U(S), (int_t *) PERMR(S), (int_t *) PERMC(S), SM_B(S), GSTAT(S), &retval); if (retval != 0) { LASTFLAG(S) = SUNLS_PACKAGE_FAIL_UNREC; return(LASTFLAG(S)); } LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } long int SUNLinSolLastFlag_SuperLUMT(SUNLinearSolver S) { /* return the stored 'last_flag' value */ return(LASTFLAG(S)); } int SUNLinSolSpace_SuperLUMT(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { /* since the SuperLU_MT structures are opaque objects, we omit those from these results */ *leniwLS = 5 + 2*SIZE(S); *lenrwLS = 1; return(SUNLS_SUCCESS); } int SUNLinSolFree_SuperLUMT(SUNLinearSolver S) { /* return with success if already freed */ if (S == NULL) return(SUNLS_SUCCESS); /* delete items from the contents structure (if it exists) */ if (S->content) { pxgstrf_finalize(OPTIONS(S), SM_AC(S)); free(PERMR(S)); free(PERMC(S)); free(OPTIONS(S)); Destroy_SuperNode_SCP(SM_L(S)); Destroy_CompCol_NCP(SM_U(S)); StatFree(GSTAT(S)); free(GSTAT(S)); Destroy_SuperMatrix_Store(SM_B(S)); SUPERLU_FREE(SM_A(S)->Store); free(SM_B(S)); free(SM_A(S)); free(SM_AC(S)); free(SM_L(S)); free(SM_U(S)); free(S->content); S->content = NULL; } /* delete generic structures */ if (S->ops) { free(S->ops); S->ops = NULL; } free(S); S = NULL; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ /* Inefficient kludge for determining the number of entries in a N_Vector object (replace if such a routine is ever added to the N_Vector API). Returns "-1" on an error. */ sunindextype GlobalVectorLength_SuperLUMT(N_Vector y) { realtype len; N_Vector tmp = NULL; tmp = N_VClone(y); if (tmp == NULL) return(-1); N_VConst(ONE, tmp); len = N_VDotProd(tmp, tmp); N_VDestroy(tmp); return( (sunindextype) len ); } StanHeaders/src/sunlinsol/superlumt/fsunlinsol_superlumt.c0000644000176200001440000001004713766554457024040 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_superlumt.h) contains the * implementation needed for the Fortran initialization of superlumt * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_superlumt.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNSUPERLUMT_INIT(int *code, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_SuperLUMT(F2C_CVODE_vec, F2C_CVODE_matrix, *num_threads); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_SuperLUMT(F2C_IDA_vec, F2C_IDA_matrix, *num_threads); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_SuperLUMT(F2C_KINSOL_vec, F2C_KINSOL_matrix, *num_threads); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_SuperLUMT(F2C_ARKODE_vec, F2C_ARKODE_matrix, *num_threads); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNSUPERLUMT_SETORDERING(int *code, int *ordering_choice, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: *ier = SUNLinSol_SuperLUMTSetOrdering(F2C_CVODE_linsol, *ordering_choice); break; case FCMIX_IDA: *ier = SUNLinSol_SuperLUMTSetOrdering(F2C_IDA_linsol, *ordering_choice); break; case FCMIX_KINSOL: *ier = SUNLinSol_SuperLUMTSetOrdering(F2C_KINSOL_linsol, *ordering_choice); break; case FCMIX_ARKODE: *ier = SUNLinSol_SuperLUMTSetOrdering(F2C_ARKODE_linsol, *ordering_choice); break; default: *ier = -1; } } void FSUNMASSSUPERLUMT_INIT(int *num_threads, int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_SuperLUMT(F2C_ARKODE_vec, F2C_ARKODE_mass_matrix, *num_threads); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSSUPERLUMT_SETORDERING(int *ordering_choice, int *ier) { *ier = 0; *ier = SUNLinSol_SuperLUMTSetOrdering(F2C_ARKODE_mass_sol, *ordering_choice); } StanHeaders/src/sunlinsol/band/0000755000176200001440000000000013766554456016221 5ustar liggesusersStanHeaders/src/sunlinsol/band/fsunlinsol_band.h0000644000176200001440000000354413766554457021561 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_band.c) contains the * definitions needed for the initialization of band * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_BAND_H #define _FSUNLINSOL_BAND_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNBANDLINSOL_INIT SUNDIALS_F77_FUNC(fsunbandlinsolinit, FSUNBANDLINSOLINIT) #define FSUNMASSBANDLINSOL_INIT SUNDIALS_F77_FUNC(fsunmassbandlinsolinit, FSUNMASSBANDLINSOLINIT) #else #define FSUNBANDLINSOL_INIT fsunbandlinsolinit_ #define FSUNMASSBANDLINSOL_INIT fsunmassbandlinsolinit_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNBANDLINSOL_INIT - initializes band linear solver for main problem * FSUNMASSBANDLINSOL_INIT - initializes band linear solver for mass matrix solve */ void FSUNBANDLINSOL_INIT(int *code, int *ier); void FSUNMASSBANDLINSOL_INIT(int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/band/sunlinsol_band.c0000644000176200001440000002010413766554457021375 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the band implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define ROW(i,j,smu) (i-j+smu) /* Private function prototypes */ sunindextype GlobalVectorLength_BandLS(N_Vector y); /* * ----------------------------------------------------------------- * Band solver structure accessibility macros: * ----------------------------------------------------------------- */ #define BAND_CONTENT(S) ( (SUNLinearSolverContent_Band)(S->content) ) #define PIVOTS(S) ( BAND_CONTENT(S)->pivots ) #define LASTFLAG(S) ( BAND_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNBandLinearSolver(N_Vector y, SUNMatrix A) { return(SUNLinSol_Band(y, A)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new band linear solver */ SUNLinearSolver SUNLinSol_Band(N_Vector y, SUNMatrix A) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_Band content; sunindextype MatrixRows, VecLength; /* Check compatibility with supplied SUNMatrix and N_Vector */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return(NULL); if (SUNBandMatrix_Rows(A) != SUNBandMatrix_Columns(A)) return(NULL); MatrixRows = SUNBandMatrix_Rows(A); if ( (N_VGetVectorID(y) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(y) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(y) != SUNDIALS_NVEC_PTHREADS) ) return(NULL); /* Check that A has appropriate storage upper bandwidth for factorization */ if (SUNBandMatrix_StoredUpperBandwidth(A) < SUNMIN(MatrixRows-1, SUNBandMatrix_LowerBandwidth(A)+SUNBandMatrix_UpperBandwidth(A))) return(NULL); /* optimally this function would be replaced with a generic N_Vector routine */ VecLength = GlobalVectorLength_BandLS(y); if (MatrixRows != VecLength) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_Band; ops->initialize = SUNLinSolInitialize_Band; ops->setup = SUNLinSolSetup_Band; ops->solve = SUNLinSolSolve_Band; ops->lastflag = SUNLinSolLastFlag_Band; ops->space = SUNLinSolSpace_Band; ops->free = SUNLinSolFree_Band; ops->setatimes = NULL; ops->setpreconditioner = NULL; ops->setscalingvectors = NULL; ops->numiters = NULL; ops->resnorm = NULL; ops->resid = NULL; /* Create content */ content = NULL; content = (SUNLinearSolverContent_Band) malloc(sizeof(struct _SUNLinearSolverContent_Band)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->N = MatrixRows; content->last_flag = 0; content->pivots = NULL; content->pivots = (sunindextype *) malloc(MatrixRows * sizeof(sunindextype)); if (content->pivots == NULL) { free(content); free(ops); free(S); return(NULL); } /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_Band(SUNLinearSolver S) { return(SUNLINEARSOLVER_DIRECT); } int SUNLinSolInitialize_Band(SUNLinearSolver S) { /* all solver-specific memory has already been allocated */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_Band(SUNLinearSolver S, SUNMatrix A) { realtype **A_cols; sunindextype *pivots; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) ) return(SUNLS_MEM_NULL); /* Ensure that A is a band matrix */ if (SUNMatGetID(A) != SUNMATRIX_BAND) { LASTFLAG(S) = SUNLS_ILL_INPUT; return(LASTFLAG(S)); } /* access data pointers (return with failure on NULL) */ A_cols = NULL; pivots = NULL; A_cols = SM_COLS_B(A); pivots = PIVOTS(S); if ( (A_cols == NULL) || (pivots == NULL) ) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* ensure that storage upper bandwidth is sufficient for fill-in */ if (SM_SUBAND_B(A) < SUNMIN(SM_COLUMNS_B(A)-1, SM_UBAND_B(A) + SM_LBAND_B(A))) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* perform LU factorization of input matrix */ LASTFLAG(S) = bandGBTRF(A_cols, SM_COLUMNS_B(A), SM_UBAND_B(A), SM_LBAND_B(A), SM_SUBAND_B(A), pivots); /* store error flag (if nonzero, that row encountered zero-valued pivod) */ if (LASTFLAG(S) > 0) return(SUNLS_LUFACT_FAIL); return(SUNLS_SUCCESS); } int SUNLinSolSolve_Band(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { realtype **A_cols, *xdata; sunindextype *pivots; /* check for valid inputs */ if ( (A == NULL) || (S == NULL) || (x == NULL) || (b == NULL) ) return(SUNLS_MEM_NULL); /* copy b into x */ N_VScale(ONE, b, x); /* access data pointers (return with failure on NULL) */ A_cols = NULL; xdata = NULL; pivots = NULL; A_cols = SUNBandMatrix_Cols(A); xdata = N_VGetArrayPointer(x); pivots = PIVOTS(S); if ( (A_cols == NULL) || (xdata == NULL) || (pivots == NULL) ) { LASTFLAG(S) = SUNLS_MEM_FAIL; return(LASTFLAG(S)); } /* solve using LU factors */ bandGBTRS(A_cols, SM_COLUMNS_B(A), SM_SUBAND_B(A), SM_LBAND_B(A), pivots, xdata); LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } long int SUNLinSolLastFlag_Band(SUNLinearSolver S) { /* return the stored 'last_flag' value */ return(LASTFLAG(S)); } int SUNLinSolSpace_Band(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { *leniwLS = 2 + BAND_CONTENT(S)->N; *lenrwLS = 0; return(SUNLS_SUCCESS); } int SUNLinSolFree_Band(SUNLinearSolver S) { /* return if S is already free */ if (S == NULL) return(SUNLS_SUCCESS); /* delete items from contents, then delete generic structure */ if (S->content) { if (PIVOTS(S)) { free(PIVOTS(S)); PIVOTS(S) = NULL; } free(S->content); S->content = NULL; } if (S->ops) { free(S->ops); S->ops = NULL; } free(S); S = NULL; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * private functions * ----------------------------------------------------------------- */ /* Inefficient kludge for determining the number of entries in a N_Vector object (replace if such a routine is ever added to the N_Vector API). Returns "-1" on an error. */ sunindextype GlobalVectorLength_BandLS(N_Vector y) { realtype len; N_Vector tmp = NULL; tmp = N_VClone(y); if (tmp == NULL) return(-1); N_VConst(ONE, tmp); len = N_VDotProd(tmp, tmp); N_VDestroy(tmp); return( (sunindextype) len ); } StanHeaders/src/sunlinsol/band/fsunlinsol_band.c0000644000176200001440000000562313766554457021554 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_band.h) contains the * implementation needed for the Fortran initialization of band * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_band.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNBANDLINSOL_INIT(int *code, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_Band(F2C_CVODE_vec, F2C_CVODE_matrix); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_Band(F2C_IDA_vec, F2C_IDA_matrix); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_Band(F2C_KINSOL_vec, F2C_KINSOL_matrix); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_Band(F2C_ARKODE_vec, F2C_ARKODE_matrix); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNMASSBANDLINSOL_INIT(int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_Band(F2C_ARKODE_vec, F2C_ARKODE_mass_matrix); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } StanHeaders/src/sunlinsol/band/F90/0000755000176200001440000000000013766554135016551 5ustar liggesusersStanHeaders/src/sunlinsol/band/F90/fsunlinsol_band.f900000644000176200001440000000667113766554457022272 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS banded matrix using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_band_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_Band(y, A) & bind(C,name='SUNLinSol_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y type(c_ptr), value :: A end function FSUNLinSol_Band ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_Band(LS) & bind(C,name='SUNLinSolFree_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_Band ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_Band(LS) & bind(C,name='SUNLinSolGetType_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_Band integer(c_int) function FSUNLinSolInitialize_Band(LS) & bind(C,name='SUNLinSolInitialize_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_Band integer(c_int) function FSUNLinSolSetup_Band(LS, A) & bind(C,name='SUNLinSolSetup_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_Band integer(c_int) function FSUNLinSolSolve_Band(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_Band integer(c_long) function FSUNLinSolLastFlag_Band(LS) & bind(C,name='SUNLinSolLastFlag_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_Band integer(c_int) function FSUNLinSolSpace_Band(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_Band end interface end module fsunlinsol_band_mod StanHeaders/src/sunlinsol/spbcgs/0000755000176200001440000000000013766554135016570 5ustar liggesusersStanHeaders/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h0000644000176200001440000000610413766554457022506 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_spbcgs.c) contains the * definitions needed for the initialization of SPBCGS * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_SPBCGS_H #define _FSUNLINSOL_SPBCGS_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNSPBCGS_INIT SUNDIALS_F77_FUNC(fsunspbcgsinit, FSUNSPBCGSINIT) #define FSUNSPBCGS_SETPRECTYPE SUNDIALS_F77_FUNC(fsunspbcgssetprectype, FSUNSPBCGSSETPRECTYPE) #define FSUNSPBCGS_SETMAXL SUNDIALS_F77_FUNC(fsunspbcgssetmaxl, FSUNSPBCGSSETMAXL) #define FSUNMASSSPBCGS_INIT SUNDIALS_F77_FUNC(fsunmassspbcgsinit, FSUNMASSSPBCGSINIT) #define FSUNMASSSPBCGS_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmassspbcgssetprectype, FSUNMASSSPBCGSSETPRECTYPE) #define FSUNMASSSPBCGS_SETMAXL SUNDIALS_F77_FUNC(fsunmassspbcgssetmaxl, FSUNMASSSPBCGSSETMAXL) #else #define FSUNSPBCGS_INIT fsunspbcgsinit_ #define FSUNSPBCGS_SETPRECTYPE fsunspbcgssetprectype_ #define FSUNSPBCGS_SETMAXL fsunspbcgssetmaxl_ #define FSUNMASSSPBCGS_INIT fsunmassspbcgsinit_ #define FSUNMASSSPBCGS_SETPRECTYPE fsunmassspbcgssetprectype_ #define FSUNMASSSPBCGS_SETMAXL fsunmassspbcgssetmaxl_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNSPBCGS_INIT - initializes SPBCGS linear solver for main problem * FSUNSPBCGS_SETPRECTYPE - sets the preconditioning type for main problem * FSUNSPBCGS_SETMAXL - sets the max number of iterations for main problem * * FSUNMASSSPBCGS_INIT - initializes SPBCGS linear solver for mass matrix solve * FSUNMASSSPBCGS_SETPRECTYPE - sets the preconditioning type for mass matrix solve * FSUNMASSSPBCGS_SETMAXL - sets the max number of iterations for mass matrix solve */ void FSUNSPBCGS_INIT(int *code, int *pretype, int *maxl, int *ier); void FSUNSPBCGS_SETPRECTYPE(int *code, int *pretype, int *ier); void FSUNSPBCGS_SETMAXL(int *code, int *maxl, int *ier); void FSUNMASSSPBCGS_INIT(int *pretype, int *maxl, int *ier); void FSUNMASSSPBCGS_SETPRECTYPE(int *pretype, int *ier); void FSUNMASSSPBCGS_SETMAXL(int *maxl, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c0000644000176200001440000001123613766554457022503 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_spbcgs.h) contains the * implementation needed for the Fortran initialization of SPBCGS * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_spbcgs.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNSPBCGS_INIT(int *code, int *pretype, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_SPBCGS(F2C_CVODE_vec, *pretype, *maxl); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_SPBCGS(F2C_IDA_vec, *pretype, *maxl); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_SPBCGS(F2C_KINSOL_vec, *pretype, *maxl); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_SPBCGS(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNSPBCGS_SETPRECTYPE(int *code, int *pretype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetPrecType(F2C_CVODE_linsol, *pretype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetPrecType(F2C_IDA_linsol, *pretype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetPrecType(F2C_KINSOL_linsol, *pretype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetPrecType(F2C_ARKODE_linsol, *pretype); break; default: *ier = -1; } } void FSUNSPBCGS_SETMAXL(int *code, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetMaxl(F2C_CVODE_linsol, *maxl); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetMaxl(F2C_IDA_linsol, *maxl); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetMaxl(F2C_KINSOL_linsol, *maxl); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetMaxl(F2C_ARKODE_linsol, *maxl); break; default: *ier = -1; } } void FSUNMASSSPBCGS_INIT(int *pretype, int *maxl, int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_SPBCGS(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSSPBCGS_SETPRECTYPE(int *pretype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetPrecType(F2C_ARKODE_mass_sol, *pretype); } void FSUNMASSSPBCGS_SETMAXL(int *maxl, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPBCGSSetMaxl(F2C_ARKODE_mass_sol, *maxl); } StanHeaders/src/sunlinsol/spbcgs/F90/0000755000176200001440000000000013766554135017126 5ustar liggesusersStanHeaders/src/sunlinsol/spbcgs/F90/fsunlinsol_spbcgs.f900000644000176200001440000001447713766554457023227 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS SPBCGS linear solver using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_spbcgs_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_SPBCGS(y, pretype, maxl) & bind(C,name='SUNLinSol_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y integer(c_int), value :: pretype integer(c_int), value :: maxl end function FSUNLinSol_SPBCGS ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_SPBCGS(LS) & bind(C,name='SUNLinSolFree_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_SPBCGS ! ================================================================= ! Setters ! ================================================================= integer(c_int) function FSUNLinSol_SPBCGSSetPrecType(LS, pretype) & bind(C,name='SUNLinSol_SPBCGSSetPrecType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: pretype end function FSUNLinSol_SPBCGSSetPrecType integer(c_int) function FSUNLinSol_SPTFQMRSetMaxl(LS, maxl) & bind(C,name='SUNLinSol_SPTFQMRSetMaxl') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: maxl end function FSUNLinSol_SPTFQMRSetMaxl ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_SPBCGS(LS) & bind(C,name='SUNLinSolGetType_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_SPBCGS integer(c_int) function FSUNLinSolInitialize_SPBCGS(LS) & bind(C,name='SUNLinSolInitialize_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_SPBCGS integer(c_int) function FSUNLinSolSetATimes_SPBCGS(LS, A_data, ATimes) & bind(C,name='SUNLinSolSetATimes_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A_data type(c_funptr), value :: ATimes end function FSUNLinSolSetATimes_SPBCGS integer(c_int) function FSUNLinSolSetPreconditioner_SPBCGS(LS, & P_data, & Pset, & Psol) & bind(C,name='SUNLinSolSetPreconditioner_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: P_data type(c_funptr), value :: Pset type(c_funptr), value :: Psol end function FSUNLinSolSetPreconditioner_SPBCGS integer(c_int) function FSUNLinSolSetScalingVectors_SPBCGS(LS, s1, s2) & bind(C,name='SUNLinSolSetScalingVectors_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: s1 type(c_ptr), value :: s2 end function FSUNLinSolSetScalingVectors_SPBCGS integer(c_int) function FSUNLinSolSetup_SPBCGS(LS, A) & bind(C,name='SUNLinSolSetup_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_SPBCGS integer(c_int) function FSUNLinSolSolve_SPBCGS(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_SPBCGS integer(c_int) function FSUNLinSolNumIters_SPBCGS(LS) & bind(C,name='SUNLinSolNumIters_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolNumIters_SPBCGS real(c_double) function FSUNLinSolResNorm_SPBCGS(LS) & bind(C,name='SUNLinSolResNorm_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResNorm_SPBCGS type(c_ptr) function FSUNLinSolResid_SPBCGS(LS) & bind(C,name='SUNLinSolResid_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResid_SPBCGS integer(c_long) function FSUNLinSolLastFlag_SPBCGS(LS) & bind(C,name='SUNLinSolLastFlag_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_SPBCGS integer(c_int) function FSUNLinSolSpace_SPBCGS(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_SPBCGS') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_SPBCGS end interface end module fsunlinsol_spbcgs_mod StanHeaders/src/sunlinsol/spbcgs/sunlinsol_spbcgs.c0000644000176200001440000004347213766554457022344 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on sundials_spbcgs.c code, written by Peter Brown and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the SPBCGS implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * SPBCGS solver structure accessibility macros: * ----------------------------------------------------------------- */ #define SPBCGS_CONTENT(S) ( (SUNLinearSolverContent_SPBCGS)(S->content) ) #define PRETYPE(S) ( SPBCGS_CONTENT(S)->pretype ) #define LASTFLAG(S) ( SPBCGS_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNSPBCGS(N_Vector y, int pretype, int maxl) { return(SUNLinSol_SPBCGS(y, pretype, maxl)); } int SUNSPBCGSSetPrecType(SUNLinearSolver S, int pretype) { return(SUNLinSol_SPBCGSSetPrecType(S, pretype)); } int SUNSPBCGSSetMaxl(SUNLinearSolver S, int maxl) { return(SUNLinSol_SPBCGSSetMaxl(S, maxl)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new SPBCGS linear solver */ SUNLinearSolver SUNLinSol_SPBCGS(N_Vector y, int pretype, int maxl) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_SPBCGS content; /* check for legal pretype and maxl values; if illegal use defaults */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; if (maxl <= 0) maxl = SUNSPBCGS_MAXL_DEFAULT; /* check that the supplied N_Vector supports all requisite operations */ if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || (y->ops->nvlinearsum == NULL) || (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_SPBCGS; ops->setatimes = SUNLinSolSetATimes_SPBCGS; ops->setpreconditioner = SUNLinSolSetPreconditioner_SPBCGS; ops->setscalingvectors = SUNLinSolSetScalingVectors_SPBCGS; ops->initialize = SUNLinSolInitialize_SPBCGS; ops->setup = SUNLinSolSetup_SPBCGS; ops->solve = SUNLinSolSolve_SPBCGS; ops->numiters = SUNLinSolNumIters_SPBCGS; ops->resnorm = SUNLinSolResNorm_SPBCGS; ops->resid = SUNLinSolResid_SPBCGS; ops->lastflag = SUNLinSolLastFlag_SPBCGS; ops->space = SUNLinSolSpace_SPBCGS; ops->free = SUNLinSolFree_SPBCGS; /* Create content */ content = NULL; content = (SUNLinearSolverContent_SPBCGS) malloc(sizeof(struct _SUNLinearSolverContent_SPBCGS)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->last_flag = 0; content->maxl = maxl; content->pretype = pretype; content->numiters = 0; content->resnorm = ZERO; content->r_star = N_VClone(y); if (content->r_star == NULL) return(NULL); content->r = N_VClone(y); if (content->r == NULL) return(NULL); content->p = N_VClone(y); if (content->p == NULL) return(NULL); content->q = N_VClone(y); if (content->q == NULL) return(NULL); content->u = N_VClone(y); if (content->u == NULL) return(NULL); content->Ap = N_VClone(y); if (content->Ap == NULL) return(NULL); content->vtemp = N_VClone(y); if (content->vtemp == NULL) return(NULL); content->s1 = NULL; content->s2 = NULL; content->ATimes = NULL; content->ATData = NULL; content->Psetup = NULL; content->Psolve = NULL; content->PData = NULL; /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to set the type of preconditioning for SPBCGS to use */ SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetPrecType(SUNLinearSolver S, int pretype) { /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { return(SUNLS_ILL_INPUT); } /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ PRETYPE(S) = pretype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the maximum number of iterations for SPBCGS to use */ SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetMaxl(SUNLinearSolver S, int maxl) { /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Check for legal pretype */ if (maxl <= 0) maxl = SUNSPBCGS_MAXL_DEFAULT; /* Set pretype */ SPBCGS_CONTENT(S)->maxl = maxl; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_SPBCGS(SUNLinearSolver S) { return(SUNLINEARSOLVER_ITERATIVE); } int SUNLinSolInitialize_SPBCGS(SUNLinearSolver S) { /* ensure valid options */ if (S == NULL) return(SUNLS_MEM_NULL); if ( (PRETYPE(S) != PREC_LEFT) && (PRETYPE(S) != PREC_RIGHT) && (PRETYPE(S) != PREC_BOTH) ) PRETYPE(S) = PREC_NONE; if (SPBCGS_CONTENT(S)->maxl <= 0) SPBCGS_CONTENT(S)->maxl = SUNSPBCGS_MAXL_DEFAULT; /* no additional memory to allocate */ /* return with success */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetATimes_SPBCGS(SUNLinearSolver S, void* ATData, ATimesFn ATimes) { /* set function pointers to integrator-supplied ATimes routine and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPBCGS_CONTENT(S)->ATimes = ATimes; SPBCGS_CONTENT(S)->ATData = ATData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetPreconditioner_SPBCGS(SUNLinearSolver S, void* PData, PSetupFn Psetup, PSolveFn Psolve) { /* set function pointers to integrator-supplied Psetup and PSolve routines and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPBCGS_CONTENT(S)->Psetup = Psetup; SPBCGS_CONTENT(S)->Psolve = Psolve; SPBCGS_CONTENT(S)->PData = PData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetScalingVectors_SPBCGS(SUNLinearSolver S, N_Vector s1, N_Vector s2) { /* set N_Vector pointers to integrator-supplied scaling vectors, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPBCGS_CONTENT(S)->s1 = s1; SPBCGS_CONTENT(S)->s2 = s2; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_SPBCGS(SUNLinearSolver S, SUNMatrix A) { int ier; PSetupFn Psetup; void* PData; /* Set shortcuts to SPBCGS memory structures */ if (S == NULL) return(SUNLS_MEM_NULL); Psetup = SPBCGS_CONTENT(S)->Psetup; PData = SPBCGS_CONTENT(S)->PData; /* no solver-specific setup is required, but if user-supplied Psetup routine exists, call that here */ if (Psetup != NULL) { ier = Psetup(PData); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; return(LASTFLAG(S)); } } /* return with success */ LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSolve_SPBCGS(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype delta) { /* local data and shortcut variables */ realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho; N_Vector r_star, r, p, q, u, Ap, vtemp; booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; int l, l_max, ier; void *A_data, *P_data; N_Vector sx, sb; ATimesFn atimes; PSolveFn psolve; realtype *res_norm; int *nli; /* local variables for fused vector operations */ realtype cv[3]; N_Vector Xv[3]; /* Make local shorcuts to solver variables. */ if (S == NULL) return(SUNLS_MEM_NULL); l_max = SPBCGS_CONTENT(S)->maxl; r_star = SPBCGS_CONTENT(S)->r_star; r = SPBCGS_CONTENT(S)->r; p = SPBCGS_CONTENT(S)->p; q = SPBCGS_CONTENT(S)->q; u = SPBCGS_CONTENT(S)->u; Ap = SPBCGS_CONTENT(S)->Ap; vtemp = SPBCGS_CONTENT(S)->vtemp; sb = SPBCGS_CONTENT(S)->s1; sx = SPBCGS_CONTENT(S)->s2; A_data = SPBCGS_CONTENT(S)->ATData; P_data = SPBCGS_CONTENT(S)->PData; atimes = SPBCGS_CONTENT(S)->ATimes; psolve = SPBCGS_CONTENT(S)->Psolve; nli = &(SPBCGS_CONTENT(S)->numiters); res_norm = &(SPBCGS_CONTENT(S)->resnorm); /* Initialize counters and convergence flag */ *nli = 0; converged = SUNFALSE; /* set booleantype flags for internal solver options */ preOnLeft = ( (PRETYPE(S) == PREC_LEFT) || (PRETYPE(S) == PREC_BOTH) ); preOnRight = ( (PRETYPE(S) == PREC_RIGHT) || (PRETYPE(S) == PREC_BOTH) ); scale_x = (sx != NULL); scale_b = (sb != NULL); /* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); else { ier = atimes(A_data, x, r_star); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } N_VLinearSum(ONE, b, -ONE, r_star, r_star); } /* Apply left preconditioner and b-scaling to r_star = r_0 */ if (preOnLeft) { ier = psolve(P_data, r_star, r, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, r_star, r); if (scale_b) N_VProd(sb, r, r_star); else N_VScale(ONE, r, r_star); /* Initialize beta_denom to the dot product of r0 with r0 */ beta_denom = N_VDotProd(r_star, r_star); /* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and return if small */ *res_norm = r_norm = rho = SUNRsqrt(beta_denom); if (r_norm <= delta) { LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* Copy r_star to r and p */ N_VScale(ONE, r_star, r); N_VScale(ONE, r_star, p); /* Begin main iteration loop */ for(l = 0; l < l_max; l++) { (*nli)++; /* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */ /* Apply x-scaling: vtemp = sx_inv p */ if (scale_x) N_VDiv(p, sx, vtemp); else N_VScale(ONE, p, vtemp); /* Apply right preconditioner: vtemp = P2_inv sx_inv p */ if (preOnRight) { N_VScale(ONE, vtemp, Ap); ier = psolve(P_data, Ap, vtemp, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } /* Apply A: Ap = A P2_inv sx_inv p */ ier = atimes(A_data, vtemp, Ap ); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ if (preOnLeft) { ier = psolve(P_data, Ap, vtemp, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, Ap, vtemp); /* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */ if (scale_b) N_VProd(sb, vtemp, Ap); else N_VScale(ONE, vtemp, Ap); /* Calculate alpha = / */ alpha = ((beta_denom / N_VDotProd(Ap, r_star))); /* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */ N_VLinearSum(ONE, r, -alpha, Ap, q); /* Generate u = A-tilde q */ /* Apply x-scaling: vtemp = sx_inv q */ if (scale_x) N_VDiv(q, sx, vtemp); else N_VScale(ONE, q, vtemp); /* Apply right preconditioner: vtemp = P2_inv sx_inv q */ if (preOnRight) { N_VScale(ONE, vtemp, u); ier = psolve(P_data, u, vtemp, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } /* Apply A: u = A P2_inv sx_inv u */ ier = atimes(A_data, vtemp, u ); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ if (preOnLeft) { ier = psolve(P_data, u, vtemp, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else N_VScale(ONE, u, vtemp); /* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */ if (scale_b) N_VProd(sb, vtemp, u); else N_VScale(ONE, vtemp, u); /* Calculate omega = / */ omega_denom = N_VDotProd(u, u); if (omega_denom == ZERO) omega_denom = ONE; omega = (N_VDotProd(u, q) / omega_denom); /* Update x = x + alpha*p + omega*q */ cv[0] = ONE; Xv[0] = x; cv[1] = alpha; Xv[1] = p; cv[2] = omega; Xv[2] = q; ier = N_VLinearCombination(3, cv, Xv, x); if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); /* Update the residual r = q - omega*u */ N_VLinearSum(ONE, q, -omega, u, r); /* Set rho = norm(r) and check convergence */ *res_norm = rho = SUNRsqrt(N_VDotProd(r, r)); if (rho <= delta) { converged = SUNTRUE; break; } /* Not yet converged, continue iteration */ /* Update beta = / * alpha / omega */ beta_num = N_VDotProd(r, r_star); beta = ((beta_num / beta_denom) * (alpha / omega)); /* Update p = r + beta*(p - omega*Ap) = beta*p - beta*omega*Ap + r */ cv[0] = beta; Xv[0] = p; cv[1] = -alpha*(beta_num / beta_denom); Xv[1] = Ap; cv[2] = ONE; Xv[2] = r; ier = N_VLinearCombination(3, cv, Xv, p); if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); /* udpate beta_denom for next iteration */ beta_denom = beta_num; } /* Main loop finished */ if ((converged == SUNTRUE) || (rho < r_norm)) { /* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */ if (scale_x) N_VDiv(x, sx, x); if (preOnRight) { ier = psolve(P_data, x, vtemp, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } N_VScale(ONE, vtemp, x); } if (converged == SUNTRUE) LASTFLAG(S) = SUNLS_SUCCESS; else LASTFLAG(S) = SUNLS_RES_REDUCED; return(LASTFLAG(S)); } else { LASTFLAG(S) = SUNLS_CONV_FAIL; return(LASTFLAG(S)); } } int SUNLinSolNumIters_SPBCGS(SUNLinearSolver S) { /* return the stored 'numiters' value */ if (S == NULL) return(-1); return (SPBCGS_CONTENT(S)->numiters); } realtype SUNLinSolResNorm_SPBCGS(SUNLinearSolver S) { /* return the stored 'resnorm' value */ if (S == NULL) return(-ONE); return (SPBCGS_CONTENT(S)->resnorm); } N_Vector SUNLinSolResid_SPBCGS(SUNLinearSolver S) { /* return the stored 'r' vector */ return (SPBCGS_CONTENT(S)->r); } long int SUNLinSolLastFlag_SPBCGS(SUNLinearSolver S) { /* return the stored 'last_flag' value */ if (S == NULL) return(-1); return (LASTFLAG(S)); } int SUNLinSolSpace_SPBCGS(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { sunindextype liw1, lrw1; if (SPBCGS_CONTENT(S)->vtemp->ops->nvspace) N_VSpace(SPBCGS_CONTENT(S)->vtemp, &lrw1, &liw1); else lrw1 = liw1 = 0; *lenrwLS = lrw1*9; *leniwLS = liw1*9; return(SUNLS_SUCCESS); } int SUNLinSolFree_SPBCGS(SUNLinearSolver S) { if (S == NULL) return(SUNLS_SUCCESS); /* delete items from within the content structure */ if (SPBCGS_CONTENT(S)->r_star) N_VDestroy(SPBCGS_CONTENT(S)->r_star); if (SPBCGS_CONTENT(S)->r) N_VDestroy(SPBCGS_CONTENT(S)->r); if (SPBCGS_CONTENT(S)->p) N_VDestroy(SPBCGS_CONTENT(S)->p); if (SPBCGS_CONTENT(S)->q) N_VDestroy(SPBCGS_CONTENT(S)->q); if (SPBCGS_CONTENT(S)->u) N_VDestroy(SPBCGS_CONTENT(S)->u); if (SPBCGS_CONTENT(S)->Ap) N_VDestroy(SPBCGS_CONTENT(S)->Ap); if (SPBCGS_CONTENT(S)->vtemp) N_VDestroy(SPBCGS_CONTENT(S)->vtemp); /* delete generic structures */ free(S->content); S->content = NULL; free(S->ops); S->ops = NULL; free(S); S = NULL; return(SUNLS_SUCCESS); } StanHeaders/src/sunlinsol/spgmr/0000755000176200001440000000000013766554135016437 5ustar liggesusersStanHeaders/src/sunlinsol/spgmr/fsunlinsol_spgmr.h0000644000176200001440000000722113766554457022225 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_spgmr.c) contains the * definitions needed for the initialization of SPGMR * linear solver operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNLINSOL_SPGMR_H #define _FSUNLINSOL_SPGMR_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNSPGMR_INIT SUNDIALS_F77_FUNC(fsunspgmrinit, FSUNSPGMRINIT) #define FSUNSPGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunspgmrsetgstype, FSUNSPGMRSETGSTYPE) #define FSUNSPGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunspgmrsetprectype, FSUNSPGMRSETPRECTYPE) #define FSUNSPGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunspgmrsetmaxrs, FSUNSPGMRSETMAXRS) #define FSUNMASSSPGMR_INIT SUNDIALS_F77_FUNC(fsunmassspgmrinit, FSUNMASSSPGMRINIT) #define FSUNMASSSPGMR_SETGSTYPE SUNDIALS_F77_FUNC(fsunmassspgmrsetgstype, FSUNMASSSPGMRSETGSTYPE) #define FSUNMASSSPGMR_SETPRECTYPE SUNDIALS_F77_FUNC(fsunmassspgmrsetprectype, FSUNMASSSPGMRSETPRECTYPE) #define FSUNMASSSPGMR_SETMAXRS SUNDIALS_F77_FUNC(fsunmassspgmrsetmaxrs, FSUNMASSSPGMRSETMAXRS) #else #define FSUNSPGMR_INIT fsunspgmrinit_ #define FSUNSPGMR_SETGSTYPE fsunspgmrsetgstype_ #define FSUNSPGMR_SETPRECTYPE fsunspgmrsetprectype_ #define FSUNSPGMR_SETMAXRS fsunspgmrsetmaxrs_ #define FSUNMASSSPGMR_INIT fsunmassspgmrinit_ #define FSUNMASSSPGMR_SETGSTYPE fsunmassspgmrsetgstype_ #define FSUNMASSSPGMR_SETPRECTYPE fsunmassspgmrsetprectype_ #define FSUNMASSSPGMR_SETMAXRS fsunmassspgmrsetmaxrs_ #endif /* Declarations of global variables */ extern SUNLinearSolver F2C_CVODE_linsol; extern SUNLinearSolver F2C_IDA_linsol; extern SUNLinearSolver F2C_KINSOL_linsol; extern SUNLinearSolver F2C_ARKODE_linsol; extern SUNLinearSolver F2C_ARKODE_mass_sol; /* * Prototypes of exported functions * * FSUNSPGMR_INIT - initializes SPGMR linear solver for main problem * FSUNSPGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for main problem * FSUNSPGMR_SETPRECTYPE - sets the preconditioning type for main problem * FSUNSPGMR_SETMAXRS - sets the maximum number of restarts to allow for main problem * * FSUNMASSSPGMR_INIT - initializes SPGMR linear solver for mass matrix solve * FSUNMASSSPGMR_SETGSTYPE - sets the Gram-Scmidt orthogonalization type for mass matrix solve * FSUNMASSSPGMR_SETPRECTYPE - sets the preconditioning type for mass matrix solve * FSUNMASSSPGMR_SETMAXRS - sets the maximum number of restarts to allow for mass matrix solve */ void FSUNSPGMR_INIT(int *code, int *pretype, int *maxl, int *ier); void FSUNSPGMR_SETGSTYPE(int *code, int *gstype, int *ier); void FSUNSPGMR_SETPRECTYPE(int *code, int *pretype, int *ier); void FSUNSPGMR_SETMAXRS(int *code, int *maxrs, int *ier); void FSUNMASSSPGMR_INIT(int *pretype, int *maxl, int *ier); void FSUNMASSSPGMR_SETGSTYPE(int *gstype, int *ier); void FSUNMASSSPGMR_SETPRECTYPE(int *pretype, int *ier); void FSUNMASSSPGMR_SETMAXRS(int *maxrs, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunlinsol/spgmr/fsunlinsol_spgmr.c0000644000176200001440000001317413766554457022224 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunlinsol_spgmr.h) contains the * implementation needed for the Fortran initialization of SPGMR * linear solver operations. * ----------------------------------------------------------------- */ #include #include #include "fsunlinsol_spgmr.h" /* Define global linsol variables */ SUNLinearSolver F2C_CVODE_linsol; SUNLinearSolver F2C_IDA_linsol; SUNLinearSolver F2C_KINSOL_linsol; SUNLinearSolver F2C_ARKODE_linsol; SUNLinearSolver F2C_ARKODE_mass_sol; /* Declarations of external global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNSPGMR_INIT(int *code, int *pretype, int *maxl, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_linsol) SUNLinSolFree(F2C_CVODE_linsol); F2C_CVODE_linsol = NULL; F2C_CVODE_linsol = SUNLinSol_SPGMR(F2C_CVODE_vec, *pretype, *maxl); if (F2C_CVODE_linsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_linsol) SUNLinSolFree(F2C_IDA_linsol); F2C_IDA_linsol = NULL; F2C_IDA_linsol = SUNLinSol_SPGMR(F2C_IDA_vec, *pretype, *maxl); if (F2C_IDA_linsol == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); F2C_KINSOL_linsol = NULL; F2C_KINSOL_linsol = SUNLinSol_SPGMR(F2C_KINSOL_vec, *pretype, *maxl); if (F2C_KINSOL_linsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_linsol) SUNLinSolFree(F2C_ARKODE_linsol); F2C_ARKODE_linsol = NULL; F2C_ARKODE_linsol = SUNLinSol_SPGMR(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_linsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNSPGMR_SETGSTYPE(int *code, int *gstype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetGSType(F2C_CVODE_linsol, *gstype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetGSType(F2C_IDA_linsol, *gstype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetGSType(F2C_KINSOL_linsol, *gstype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetGSType(F2C_ARKODE_linsol, *gstype); break; default: *ier = -1; } } void FSUNSPGMR_SETPRECTYPE(int *code, int *pretype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetPrecType(F2C_CVODE_linsol, *pretype); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetPrecType(F2C_IDA_linsol, *pretype); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetPrecType(F2C_KINSOL_linsol, *pretype); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetPrecType(F2C_ARKODE_linsol, *pretype); break; default: *ier = -1; } } void FSUNSPGMR_SETMAXRS(int *code, int *maxrs, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_CVODE_linsol, *maxrs); break; case FCMIX_IDA: if (!F2C_IDA_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_IDA_linsol, *maxrs); break; case FCMIX_KINSOL: if (!F2C_KINSOL_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_KINSOL_linsol, *maxrs); break; case FCMIX_ARKODE: if (!F2C_ARKODE_linsol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_ARKODE_linsol, *maxrs); break; default: *ier = -1; } } void FSUNMASSSPGMR_INIT(int *pretype, int *maxl, int *ier) { *ier = 0; if (F2C_ARKODE_mass_sol) SUNLinSolFree(F2C_ARKODE_mass_sol); F2C_ARKODE_mass_sol = NULL; F2C_ARKODE_mass_sol = SUNLinSol_SPGMR(F2C_ARKODE_vec, *pretype, *maxl); if (F2C_ARKODE_mass_sol == NULL) *ier = -1; } void FSUNMASSSPGMR_SETGSTYPE(int *gstype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetGSType(F2C_ARKODE_mass_sol, *gstype); } void FSUNMASSSPGMR_SETPRECTYPE(int *pretype, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetPrecType(F2C_ARKODE_mass_sol, *pretype); } void FSUNMASSSPGMR_SETMAXRS(int *maxrs, int *ier) { *ier = 0; if (!F2C_ARKODE_mass_sol) { *ier = -1; return; } *ier = SUNLinSol_SPGMRSetMaxRestarts(F2C_ARKODE_mass_sol, *maxrs); } StanHeaders/src/sunlinsol/spgmr/sunlinsol_spgmr.c0000644000176200001440000005451313766554457022060 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on sundials_spgmr.c code, written by Scott D. Cohen, * Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the SPGMR implementation of * the SUNLINSOL package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * SPGMR solver structure accessibility macros: * ----------------------------------------------------------------- */ #define SPGMR_CONTENT(S) ( (SUNLinearSolverContent_SPGMR)(S->content) ) #define LASTFLAG(S) ( SPGMR_CONTENT(S)->last_flag ) /* * ----------------------------------------------------------------- * deprecated wrapper functions * ----------------------------------------------------------------- */ SUNLinearSolver SUNSPGMR(N_Vector y, int pretype, int maxl) { return(SUNLinSol_SPGMR(y, pretype, maxl)); } int SUNSPGMRSetPrecType(SUNLinearSolver S, int pretype) { return(SUNLinSol_SPGMRSetPrecType(S, pretype)); } int SUNSPGMRSetGSType(SUNLinearSolver S, int gstype) { return(SUNLinSol_SPGMRSetGSType(S, gstype)); } int SUNSPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) { return(SUNLinSol_SPGMRSetMaxRestarts(S, maxrs)); } /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new SPGMR linear solver */ SUNLinearSolver SUNLinSol_SPGMR(N_Vector y, int pretype, int maxl) { SUNLinearSolver S; SUNLinearSolver_Ops ops; SUNLinearSolverContent_SPGMR content; /* check for legal pretype and maxl values; if illegal use defaults */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; if (maxl <= 0) maxl = SUNSPGMR_MAXL_DEFAULT; /* check that the supplied N_Vector supports all requisite operations */ if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || (y->ops->nvlinearsum == NULL) || (y->ops->nvconst == NULL) || (y->ops->nvprod == NULL) || (y->ops->nvdiv == NULL) || (y->ops->nvscale == NULL) || (y->ops->nvdotprod == NULL) ) return(NULL); /* Create linear solver */ S = NULL; S = (SUNLinearSolver) malloc(sizeof *S); if (S == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNLinearSolver_Ops) malloc(sizeof(struct _generic_SUNLinearSolver_Ops)); if (ops == NULL) { free(S); return(NULL); } /* Attach operations */ ops->gettype = SUNLinSolGetType_SPGMR; ops->setatimes = SUNLinSolSetATimes_SPGMR; ops->setpreconditioner = SUNLinSolSetPreconditioner_SPGMR; ops->setscalingvectors = SUNLinSolSetScalingVectors_SPGMR; ops->initialize = SUNLinSolInitialize_SPGMR; ops->setup = SUNLinSolSetup_SPGMR; ops->solve = SUNLinSolSolve_SPGMR; ops->numiters = SUNLinSolNumIters_SPGMR; ops->resnorm = SUNLinSolResNorm_SPGMR; ops->resid = SUNLinSolResid_SPGMR; ops->lastflag = SUNLinSolLastFlag_SPGMR; ops->space = SUNLinSolSpace_SPGMR; ops->free = SUNLinSolFree_SPGMR; /* Create content */ content = NULL; content = (SUNLinearSolverContent_SPGMR) malloc(sizeof(struct _SUNLinearSolverContent_SPGMR)); if (content == NULL) { free(ops); free(S); return(NULL); } /* Fill content */ content->last_flag = 0; content->maxl = maxl; content->pretype = pretype; content->gstype = SUNSPGMR_GSTYPE_DEFAULT; content->max_restarts = SUNSPGMR_MAXRS_DEFAULT; content->numiters = 0; content->resnorm = ZERO; content->xcor = N_VClone(y); if (content->xcor == NULL) return(NULL); content->vtemp = N_VClone(y); if (content->vtemp == NULL) return(NULL); content->s1 = NULL; content->s2 = NULL; content->ATimes = NULL; content->ATData = NULL; content->Psetup = NULL; content->Psolve = NULL; content->PData = NULL; content->V = NULL; content->Hes = NULL; content->givens = NULL; content->yg = NULL; content->cv = NULL; content->Xv = NULL; /* Attach content and ops */ S->content = content; S->ops = ops; return(S); } /* ---------------------------------------------------------------------------- * Function to set the type of preconditioning for SPGMR to use */ SUNDIALS_EXPORT int SUNLinSol_SPGMRSetPrecType(SUNLinearSolver S, int pretype) { /* Check for legal pretype */ if ((pretype != PREC_NONE) && (pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) { return(SUNLS_ILL_INPUT); } /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ SPGMR_CONTENT(S)->pretype = pretype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the type of Gram-Schmidt orthogonalization for SPGMR to use */ SUNDIALS_EXPORT int SUNLinSol_SPGMRSetGSType(SUNLinearSolver S, int gstype) { /* Check for legal gstype */ if ((gstype != MODIFIED_GS) && (gstype != CLASSICAL_GS)) { return(SUNLS_ILL_INPUT); } /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set pretype */ SPGMR_CONTENT(S)->gstype = gstype; return(SUNLS_SUCCESS); } /* ---------------------------------------------------------------------------- * Function to set the maximum number of GMRES restarts to allow */ SUNDIALS_EXPORT int SUNLinSol_SPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs) { /* Illegal maxrs implies use of default value */ if (maxrs < 0) maxrs = SUNSPGMR_MAXRS_DEFAULT; /* Check for non-NULL SUNLinearSolver */ if (S == NULL) return(SUNLS_MEM_NULL); /* Set max_restarts */ SPGMR_CONTENT(S)->max_restarts = maxrs; return(SUNLS_SUCCESS); } /* * ----------------------------------------------------------------- * implementation of linear solver operations * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType_SPGMR(SUNLinearSolver S) { return(SUNLINEARSOLVER_ITERATIVE); } int SUNLinSolInitialize_SPGMR(SUNLinearSolver S) { int k; SUNLinearSolverContent_SPGMR content; /* set shortcut to SPGMR memory structure */ if (S == NULL) return(SUNLS_MEM_NULL); content = SPGMR_CONTENT(S); /* ensure valid options */ if (content->max_restarts < 0) content->max_restarts = SUNSPGMR_MAXRS_DEFAULT; if ( (content->pretype != PREC_LEFT) && (content->pretype != PREC_RIGHT) && (content->pretype != PREC_BOTH) ) content->pretype = PREC_NONE; /* allocate solver-specific memory (where the size depends on the choice of maxl) here */ /* Krylov subspace vectors */ if (content->V == NULL) { content->V = N_VCloneVectorArray(content->maxl+1, content->vtemp); if (content->V == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* Hessenberg matrix Hes */ if (content->Hes == NULL) { content->Hes = (realtype **) malloc((content->maxl+1)*sizeof(realtype *)); if (content->Hes == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } for (k=0; k<=content->maxl; k++) { content->Hes[k] = NULL; content->Hes[k] = (realtype *) malloc(content->maxl*sizeof(realtype)); if (content->Hes[k] == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } } /* Givens rotation components */ if (content->givens == NULL) { content->givens = (realtype *) malloc(2*content->maxl*sizeof(realtype)); if (content->givens == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* y and g vectors */ if (content->yg == NULL) { content->yg = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); if (content->yg == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* cv vector for fused vector ops */ if (content->cv == NULL) { content->cv = (realtype *) malloc((content->maxl+1)*sizeof(realtype)); if (content->cv == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* Xv vector for fused vector ops */ if (content->Xv == NULL) { content->Xv = (N_Vector *) malloc((content->maxl+1)*sizeof(N_Vector)); if (content->Xv == NULL) { SUNLinSolFree(S); content->last_flag = SUNLS_MEM_FAIL; return(SUNLS_MEM_FAIL); } } /* return with success */ content->last_flag = SUNLS_SUCCESS; return(SUNLS_SUCCESS); } int SUNLinSolSetATimes_SPGMR(SUNLinearSolver S, void* ATData, ATimesFn ATimes) { /* set function pointers to integrator-supplied ATimes routine and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPGMR_CONTENT(S)->ATimes = ATimes; SPGMR_CONTENT(S)->ATData = ATData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetPreconditioner_SPGMR(SUNLinearSolver S, void* PData, PSetupFn Psetup, PSolveFn Psolve) { /* set function pointers to integrator-supplied Psetup and PSolve routines and data, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPGMR_CONTENT(S)->Psetup = Psetup; SPGMR_CONTENT(S)->Psolve = Psolve; SPGMR_CONTENT(S)->PData = PData; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetScalingVectors_SPGMR(SUNLinearSolver S, N_Vector s1, N_Vector s2) { /* set N_Vector pointers to integrator-supplied scaling vectors, and return with success */ if (S == NULL) return(SUNLS_MEM_NULL); SPGMR_CONTENT(S)->s1 = s1; SPGMR_CONTENT(S)->s2 = s2; LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } int SUNLinSolSetup_SPGMR(SUNLinearSolver S, SUNMatrix A) { int ier; PSetupFn Psetup; void* PData; /* Set shortcuts to SPGMR memory structures */ if (S == NULL) return(SUNLS_MEM_NULL); Psetup = SPGMR_CONTENT(S)->Psetup; PData = SPGMR_CONTENT(S)->PData; /* no solver-specific setup is required, but if user-supplied Psetup routine exists, call that here */ if (Psetup != NULL) { ier = Psetup(PData); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSET_FAIL_UNREC : SUNLS_PSET_FAIL_REC; return(LASTFLAG(S)); } } /* return with success */ return(SUNLS_SUCCESS); } int SUNLinSolSolve_SPGMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype delta) { /* local data and shortcut variables */ N_Vector *V, xcor, vtemp, s1, s2; realtype **Hes, *givens, *yg, *res_norm; realtype beta, rotation_product, r_norm, s_product, rho; booleantype preOnLeft, preOnRight, scale2, scale1, converged; int i, j, k, l, l_plus_1, l_max, krydim, ier, ntries, max_restarts, gstype; int *nli; void *A_data, *P_data; ATimesFn atimes; PSolveFn psolve; /* local shortcuts for fused vector operations */ realtype* cv; N_Vector* Xv; /* Initialize some variables */ l_plus_1 = 0; krydim = 0; /* Make local shorcuts to solver variables. */ if (S == NULL) return(SUNLS_MEM_NULL); l_max = SPGMR_CONTENT(S)->maxl; max_restarts = SPGMR_CONTENT(S)->max_restarts; gstype = SPGMR_CONTENT(S)->gstype; V = SPGMR_CONTENT(S)->V; Hes = SPGMR_CONTENT(S)->Hes; givens = SPGMR_CONTENT(S)->givens; xcor = SPGMR_CONTENT(S)->xcor; yg = SPGMR_CONTENT(S)->yg; vtemp = SPGMR_CONTENT(S)->vtemp; s1 = SPGMR_CONTENT(S)->s1; s2 = SPGMR_CONTENT(S)->s2; A_data = SPGMR_CONTENT(S)->ATData; P_data = SPGMR_CONTENT(S)->PData; atimes = SPGMR_CONTENT(S)->ATimes; psolve = SPGMR_CONTENT(S)->Psolve; nli = &(SPGMR_CONTENT(S)->numiters); res_norm = &(SPGMR_CONTENT(S)->resnorm); cv = SPGMR_CONTENT(S)->cv; Xv = SPGMR_CONTENT(S)->Xv; /* Initialize counters and convergence flag */ *nli = 0; converged = SUNFALSE; /* set booleantype flags for internal solver options */ preOnLeft = ( (SPGMR_CONTENT(S)->pretype == PREC_LEFT) || (SPGMR_CONTENT(S)->pretype == PREC_BOTH) ); preOnRight = ( (SPGMR_CONTENT(S)->pretype == PREC_RIGHT) || (SPGMR_CONTENT(S)->pretype == PREC_BOTH) ); scale1 = (s1 != NULL); scale2 = (s2 != NULL); /* Set vtemp and V[0] to initial (unscaled) residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) { N_VScale(ONE, b, vtemp); } else { ier = atimes(A_data, x, vtemp); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_ATIMES_FAIL_UNREC : SUNLS_ATIMES_FAIL_REC; return(LASTFLAG(S)); } N_VLinearSum(ONE, b, -ONE, vtemp, vtemp); } N_VScale(ONE, vtemp, V[0]); /* Apply left preconditioner and left scaling to V[0] = r_0 */ if (preOnLeft) { ier = psolve(P_data, V[0], vtemp, delta, PREC_LEFT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else { N_VScale(ONE, V[0], vtemp); } if (scale1) { N_VProd(s1, vtemp, V[0]); } else { N_VScale(ONE, vtemp, V[0]); } /* Set r_norm = beta to L2 norm of V[0] = s1 P1_inv r_0, and return if small */ *res_norm = r_norm = beta = SUNRsqrt(N_VDotProd(V[0], V[0])); if (r_norm <= delta) { LASTFLAG(S) = SUNLS_SUCCESS; return(LASTFLAG(S)); } /* Initialize rho to avoid compiler warning message */ rho = beta; /* Set xcor = 0 */ N_VConst(ZERO, xcor); /* Begin outer iterations: up to (max_restarts + 1) attempts */ for (ntries=0; ntries<=max_restarts; ntries++) { /* Initialize the Hessenberg matrix Hes and Givens rotation product. Normalize the initial vector V[0] */ for (i=0; i<=l_max; i++) for (j=0; j0; i--) { yg[i] = s_product*givens[2*i-2]; s_product *= givens[2*i-1]; } yg[0] = s_product; /* Scale r_norm and yg */ r_norm *= s_product; for (i=0; i<=krydim; i++) yg[i] *= r_norm; r_norm = SUNRabs(r_norm); /* Multiply yg by V_(krydim+1) to get last residual vector; restart */ for (k=0; k<=krydim; k++) { cv[k] = yg[k]; Xv[k] = V[k]; } ier = N_VLinearCombination(krydim+1, cv, Xv, V[0]); if (ier != SUNLS_SUCCESS) return(SUNLS_VECTOROP_ERR); } /* Failed to converge, even after allowed restarts. If the residual norm was reduced below its initial value, compute and return x anyway. Otherwise return failure flag. */ if (rho < beta) { /* Apply right scaling and right precond.: vtemp = P2_inv s2_inv xcor */ if (scale2) N_VDiv(xcor, s2, xcor); if (preOnRight) { ier = psolve(P_data, xcor, vtemp, delta, PREC_RIGHT); if (ier != 0) { LASTFLAG(S) = (ier < 0) ? SUNLS_PSOLVE_FAIL_UNREC : SUNLS_PSOLVE_FAIL_REC; return(LASTFLAG(S)); } } else { N_VScale(ONE, xcor, vtemp); } /* Add vtemp to initial x to get final solution x, and return */ N_VLinearSum(ONE, x, ONE, vtemp, x); LASTFLAG(S) = SUNLS_RES_REDUCED; return(LASTFLAG(S)); } LASTFLAG(S) = SUNLS_CONV_FAIL; return(LASTFLAG(S)); } int SUNLinSolNumIters_SPGMR(SUNLinearSolver S) { /* return the stored 'numiters' value */ if (S == NULL) return(-1); return (SPGMR_CONTENT(S)->numiters); } realtype SUNLinSolResNorm_SPGMR(SUNLinearSolver S) { /* return the stored 'resnorm' value */ if (S == NULL) return(-ONE); return (SPGMR_CONTENT(S)->resnorm); } N_Vector SUNLinSolResid_SPGMR(SUNLinearSolver S) { /* return the stored 'vtemp' vector */ return (SPGMR_CONTENT(S)->vtemp); } long int SUNLinSolLastFlag_SPGMR(SUNLinearSolver S) { /* return the stored 'last_flag' value */ if (S == NULL) return(-1); return (LASTFLAG(S)); } int SUNLinSolSpace_SPGMR(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { int maxl; sunindextype liw1, lrw1; maxl = SPGMR_CONTENT(S)->maxl; if (SPGMR_CONTENT(S)->vtemp->ops->nvspace) N_VSpace(SPGMR_CONTENT(S)->vtemp, &lrw1, &liw1); else lrw1 = liw1 = 0; *lenrwLS = lrw1*(maxl + 5) + maxl*(maxl + 5) + 2; *leniwLS = liw1*(maxl + 5); return(SUNLS_SUCCESS); } int SUNLinSolFree_SPGMR(SUNLinearSolver S) { int k; if (S == NULL) return(SUNLS_SUCCESS); /* delete items from within the content structure */ if (SPGMR_CONTENT(S)->xcor) N_VDestroy(SPGMR_CONTENT(S)->xcor); if (SPGMR_CONTENT(S)->vtemp) N_VDestroy(SPGMR_CONTENT(S)->vtemp); if (SPGMR_CONTENT(S)->V) N_VDestroyVectorArray(SPGMR_CONTENT(S)->V, SPGMR_CONTENT(S)->maxl+1); if (SPGMR_CONTENT(S)->Hes) { for (k=0; k<=SPGMR_CONTENT(S)->maxl; k++) if (SPGMR_CONTENT(S)->Hes[k]) free(SPGMR_CONTENT(S)->Hes[k]); free(SPGMR_CONTENT(S)->Hes); } if (SPGMR_CONTENT(S)->givens) free(SPGMR_CONTENT(S)->givens); if (SPGMR_CONTENT(S)->yg) free(SPGMR_CONTENT(S)->yg); if (SPGMR_CONTENT(S)->cv) free(SPGMR_CONTENT(S)->cv); if (SPGMR_CONTENT(S)->Xv) free(SPGMR_CONTENT(S)->Xv); /* delete generic structures */ free(S->content); S->content = NULL; free(S->ops); S->ops = NULL; free(S); S = NULL; return(SUNLS_SUCCESS); } StanHeaders/src/sunlinsol/spgmr/F90/0000755000176200001440000000000013766554135016775 5ustar liggesusersStanHeaders/src/sunlinsol/spgmr/F90/fsunlinsol_spgmr.f900000644000176200001440000001512013766554457022727 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS SPGMR linear solver using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunlinsol_spgmr_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNLinSol_SPGMR(y, pretype, maxl) & bind(C,name='SUNLinSol_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y integer(c_int), value :: pretype integer(c_int), value :: maxl end function FSUNLinSol_SPGMR ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNLinSolFree_SPGMR(LS) & bind(C,name='SUNLinSolFree_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end subroutine FSUNLinSolFree_SPGMR ! ================================================================= ! Setters ! ================================================================= integer(c_int) function FSUNLinSol_SPGMRSetPrecType(LS, pretype) & bind(C,name='SUNLinSol_SPGMRSetPrecType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: pretype end function FSUNLinSol_SPGMRSetPrecType integer(c_int) function FSUNLinSol_SPGMRSetGSType(LS, gstype) & bind(C,name='SUNLinSol_SPGMRSetGSType') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: gstype end function FSUNLinSol_SPGMRSetGSType integer(c_int) function FSUNLinSol_SPGMRSetMaxRestarts(LS, maxrs) & bind(C,name='SUNLinSol_SPGMRSetMaxRestarts') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_int), value :: maxrs end function FSUNLinSol_SPGMRSetMaxRestarts ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNLinSolGetType_SPGMR(LS) & bind(C,name='SUNLinSolGetType_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolGetType_SPGMR integer(c_int) function FSUNLinSolInitialize_SPGMR(LS) & bind(C,name='SUNLinSolInitialize_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolInitialize_SPGMR integer(c_int) function FSUNLinSolSetATimes_SPGMR(LS, A_data, ATimes) & bind(C,name='SUNLinSolSetATimes_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A_data type(c_funptr), value :: ATimes end function FSUNLinSolSetATimes_SPGMR integer(c_int) function FSUNLinSolSetPreconditioner_SPGMR(LS, & P_data, & Pset, & Psol) & bind(C,name='SUNLinSolSetPreconditioner_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: P_data type(c_funptr), value :: Pset type(c_funptr), value :: Psol end function FSUNLinSolSetPreconditioner_SPGMR integer(c_int) function FSUNLinSolSetScalingVectors_SPGMR(LS, s1, s2) & bind(C,name='SUNLinSolSetScalingVectors_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: s1 type(c_ptr), value :: s2 end function FSUNLinSolSetScalingVectors_SPGMR integer(c_int) function FSUNLinSolSetup_SPGMR(LS, A) & bind(C,name='SUNLinSolSetup_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A end function FSUNLinSolSetup_SPGMR integer(c_int) function FSUNLinSolSolve_SPGMR(LS, A, x, b, tol) & bind(C,name='SUNLinSolSolve_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: b real(c_double), value :: tol end function FSUNLinSolSolve_SPGMR integer(c_int) function FSUNLinSolNumIters_SPGMR(LS) & bind(C,name='SUNLinSolNumIters_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolNumIters_SPGMR real(c_double) function FSUNLinSolResNorm_SPGMR(LS) & bind(C,name='SUNLinSolResNorm_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResNorm_SPGMR type(c_ptr) function FSUNLinSolResid_SPGMR(LS) & bind(C,name='SUNLinSolResid_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolResid_SPGMR integer(c_long) function FSUNLinSolLastFlag_SPGMR(LS) & bind(C,name='SUNLinSolLastFlag_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS end function FSUNLinSolLastFlag_SPGMR integer(c_int) function FSUNLinSolSpace_SPGMR(LS, lenrwLS, leniwLS) & bind(C,name='SUNLinSolSpace_SPGMR') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: LS integer(c_long) :: lenrwLS integer(c_long) :: leniwLS end function FSUNLinSolSpace_SPGMR end interface end module fsunlinsol_spgmr_mod StanHeaders/src/init.c0000644000176200001440000000066513532026546014366 0ustar liggesusers#include #include #include #include #include static const R_CallMethodDef CallEntries[] = { {NULL, NULL, 0} }; void attribute_visible R_init_StanHeaders(DllInfo *dll) { // next line is necessary to avoid a NOTE from R CMD check R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, TRUE); // necessary for .onLoad() to work } StanHeaders/src/sunmatrix/0000755000176200001440000000000013766554135015313 5ustar liggesusersStanHeaders/src/sunmatrix/dense/0000755000176200001440000000000013766554456016417 5ustar liggesusersStanHeaders/src/sunmatrix/dense/sunmatrix_dense.c0000644000176200001440000002113413766554457021775 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner @ LLNL * Based on code sundials_dense.c by: Scott D. Cohen, * Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the dense implementation of * the SUNMATRIX package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Private function prototypes */ static booleantype SMCompatible_Dense(SUNMatrix A, SUNMatrix B); static booleantype SMCompatible2_Dense(SUNMatrix A, N_Vector x, N_Vector y); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new dense matrix */ SUNMatrix SUNDenseMatrix(sunindextype M, sunindextype N) { SUNMatrix A; SUNMatrix_Ops ops; SUNMatrixContent_Dense content; sunindextype j; /* return with NULL matrix on illegal dimension input */ if ( (M <= 0) || (N <= 0) ) return(NULL); /* Create matrix */ A = NULL; A = (SUNMatrix) malloc(sizeof *A); if (A == NULL) return(NULL); /* Create matrix operation structure */ ops = NULL; ops = (SUNMatrix_Ops) malloc(sizeof(struct _generic_SUNMatrix_Ops)); if (ops == NULL) { free(A); return(NULL); } /* Attach operations */ ops->getid = SUNMatGetID_Dense; ops->clone = SUNMatClone_Dense; ops->destroy = SUNMatDestroy_Dense; ops->zero = SUNMatZero_Dense; ops->copy = SUNMatCopy_Dense; ops->scaleadd = SUNMatScaleAdd_Dense; ops->scaleaddi = SUNMatScaleAddI_Dense; ops->matvec = SUNMatMatvec_Dense; ops->space = SUNMatSpace_Dense; /* Create content */ content = NULL; content = (SUNMatrixContent_Dense) malloc(sizeof(struct _SUNMatrixContent_Dense)); if (content == NULL) { free(ops); free(A); return(NULL); } /* Fill content */ content->M = M; content->N = N; content->ldata = M*N; content->data = NULL; content->data = (realtype *) calloc(M * N, sizeof(realtype)); if (content->data == NULL) { free(content); free(ops); free(A); return(NULL); } content->cols = NULL; content->cols = (realtype **) malloc(N * sizeof(realtype *)); if (content->cols == NULL) { free(content->data); free(content); free(ops); free(A); return(NULL); } for (j=0; jcols[j] = content->data + j * M; /* Attach content and ops */ A->content = content; A->ops = ops; return(A); } /* ---------------------------------------------------------------------------- * Function to print the dense matrix */ void SUNDenseMatrix_Print(SUNMatrix A, FILE* outfile) { sunindextype i, j; /* should not be called unless A is a dense matrix; otherwise return immediately */ if (SUNMatGetID(A) != SUNMATRIX_DENSE) return; /* perform operation */ STAN_SUNDIALS_FPRINTF(outfile,"\n"); for (i=0; icols); SM_CONTENT_D(A)->cols = NULL; free(A->content); A->content = NULL; free(A->ops); A->ops = NULL; free(A); A = NULL; return; } int SUNMatZero_Dense(SUNMatrix A) { sunindextype i; realtype *Adata; /* Perform operation */ Adata = SM_DATA_D(A); for (i=0; i #include #include "fsunmatrix_dense.h" /* Define global matrix variables */ SUNMatrix F2C_CVODE_matrix; SUNMatrix F2C_IDA_matrix; SUNMatrix F2C_KINSOL_matrix; SUNMatrix F2C_ARKODE_matrix; SUNMatrix F2C_ARKODE_mass_matrix; /* Fortran callable interfaces */ void FSUNDENSEMAT_INIT(int *code, long int *M, long int *N, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); F2C_CVODE_matrix = NULL; F2C_CVODE_matrix = SUNDenseMatrix(*M, *N); if (F2C_CVODE_matrix == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix); F2C_IDA_matrix = NULL; F2C_IDA_matrix = SUNDenseMatrix(*M, *N); if (F2C_IDA_matrix == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); F2C_KINSOL_matrix = NULL; F2C_KINSOL_matrix = SUNDenseMatrix(*M, *N); if (F2C_KINSOL_matrix == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); F2C_ARKODE_matrix = NULL; F2C_ARKODE_matrix = SUNDenseMatrix(*M, *N); if (F2C_ARKODE_matrix == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNDENSEMASSMAT_INIT(long int *M, long int *N, int *ier) { *ier = 0; if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); F2C_ARKODE_mass_matrix = NULL; F2C_ARKODE_mass_matrix = SUNDenseMatrix(*M, *N); if (F2C_ARKODE_mass_matrix == NULL) *ier = -1; } StanHeaders/src/sunmatrix/dense/fsunmatrix_dense.h0000644000176200001440000000355213766554457022154 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunmatrix_dense.c) contains the * definitions needed for the initialization of dense * matrix operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNMATRIX_DENSE_H #define _FSUNMATRIX_DENSE_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNDENSEMAT_INIT SUNDIALS_F77_FUNC(fsundensematinit, FSUNDENSEMATINIT) #define FSUNDENSEMASSMAT_INIT SUNDIALS_F77_FUNC(fsundensemassmatinit, FSUNDENSEMASSMATINIT) #else #define FSUNDENSEMAT_INIT fsundensematinit_ #define FSUNDENSEMASSMAT_INIT fsundensemassmatinit_ #endif /* Declarations of global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; /* * Prototypes of exported functions * * FSUNDENSEMAT_INIT - initializes dense matrix operations for main problem * FSUNDENSEMASSMAT_INIT - initializes dense matrix operations for mass matrix solver */ void FSUNDENSEMAT_INIT(int *code, long int *M, long int *N, int *ier); void FSUNDENSEMASSMAT_INIT(long int *M, long int *N, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunmatrix/dense/F90/0000755000176200001440000000000013766554135016747 5ustar liggesusersStanHeaders/src/sunmatrix/dense/F90/fsunmatrix_dense.f900000644000176200001440000001500013766554457022650 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): David J. Gardner @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS dense matrix using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunmatrix_dense_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNDenseMatrix(M, N) & bind(C,name='SUNDenseMatrix') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: M integer(c_long), value :: N end function FSUNDenseMatrix ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNMatDestroy_Dense(A) & bind(C,name='SUNMatDestroy_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end subroutine FSUNMatDestroy_Dense ! ================================================================= ! Other routines ! ================================================================= ! ----------------------------------------------------------------- ! NOT INTERFACED SUNDenseMatrix_Print ! ----------------------------------------------------------------- integer(c_long) function FSUNDenseMatrix_Rows(A) & bind(C,name='SUNDenseMatrix_Rows') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNDenseMatrix_Rows integer(c_long) function FSUNDenseMatrix_Columns(A) & bind(C,name='SUNDenseMatrix_Columns') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNDenseMatrix_Columns integer(c_long) function FSUNDenseMatrix_LData(A) & bind(C,name='SUNDenseMatrix_LData') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNDenseMatrix_LData type(c_ptr) function FSUNDenseMatrix_Data(A) & bind(C,name='SUNDenseMatrix_Data') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNDenseMatrix_Data ! ----------------------------------------------------------------- ! NOT INTERFACED SUNDenseMatrix_Cols ! ----------------------------------------------------------------- type(c_ptr) function FSUNDenseMatrix_Column(A, j) & bind(C,name='SUNDenseMatrix_Column') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A integer(c_long), value :: j end function FSUNDenseMatrix_Column ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNMatGetID_Dense(A) & bind(C,name='SUNMatGetID_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNMatGetID_Dense type(c_ptr) function FSUNMatClone_Dense(A) & bind(C,name='SUNMatClone_Dense') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNMatClone_Dense integer(c_int) function FSUNMatZero_Dense(A) & bind(C,name='SUNMatZero_Dense') use, intrinsic :: iso_c_binding type(c_ptr), value :: A end function FSUNMatZero_Dense integer(c_int) function FSUNMatCopy_Dense(A, B) & bind(C,name='SUNMatCopy_Dense') use, intrinsic :: iso_c_binding type(c_ptr), value :: A type(c_ptr), value :: B end function FSUNMatCopy_Dense integer(c_int) function FSUNMatScaleAdd_Dense(c, A, B) & bind(C,name='SUNMatScaleAdd_Dense') use, intrinsic :: iso_c_binding real(c_double), value :: c type(c_ptr), value :: A type(c_ptr), value :: B end function FSUNMatScaleAdd_Dense integer(c_int) function FSUNMatScaleAddI_Dense(c, A) & bind(C,name='SUNMatScaleAddI_Dense') use, intrinsic :: iso_c_binding real(c_double), value :: c type(c_ptr), value :: A end function FSUNMatScaleAddI_Dense integer(c_int) function FSUNMatMatvec_Dense(A, x, y) & bind(C,name='SUNMatMatvec_Dense') use, intrinsic :: iso_c_binding type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: y end function FSUNMatMatvec_Dense integer(c_int) function FSUNMatSpace_Dense(A, lenrw, leniw) & bind(C,name='SUNMatSpace_Dense') use, intrinsic :: iso_c_binding type(c_ptr), value :: A integer(c_long) :: lenrw integer(c_long) :: leniw end function FSUNMatSpace_Dense end interface contains ! ================================================================ ! Helpful routines ! ================================================================ ! ---------------------------------------------------------------- ! FSUNMatGetData_Dense ! ! Extracts data array from a SUNDIALS Dense Matrix ! ---------------------------------------------------------------- subroutine FSUNMatGetData_Dense(A, f_array) !======= Inclusions =========== use, intrinsic :: iso_c_binding !======= Declarations ========= implicit none ! calling variables type(c_ptr) :: A real(c_double), pointer :: f_array(:,:) ! internal variables type(c_ptr) :: c_array integer(c_long) :: M, N !======= Internals ============ ! get data pointer from N_Vector c_array = FSUNDenseMatrix_Data(A) ! get matrix size M = FSUNDenseMatrix_Rows(A) N = FSUNDenseMatrix_Columns(A) ! convert and reshape 1D data array call c_f_pointer(c_array, f_array, (/M,N/)) end subroutine FSUNMatGetData_Dense end module fsunmatrix_dense_mod StanHeaders/src/sunmatrix/band/0000755000176200001440000000000013766554456016225 5ustar liggesusersStanHeaders/src/sunmatrix/band/fsunmatrix_band.h0000644000176200001440000000356213766554457021571 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunmatrix_band.c) contains the * definitions needed for the initialization of band * matrix operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FSUNMATRIX_BAND_H #define _FSUNMATRIX_BAND_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNBANDMAT_INIT SUNDIALS_F77_FUNC(fsunbandmatinit, FSUNBANDMATINIT) #define FSUNBANDMASSMAT_INIT SUNDIALS_F77_FUNC(fsunbandmassmatinit, FSUNBANDMASSMATINIT) #else #define FSUNBANDMAT_INIT fsunbandmatinit_ #define FSUNBANDMASSMAT_INIT fsunbandmassmatinit_ #endif /* Declarations of global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; /* * Prototypes of exported functions * * FSUNBANDMAT_INIT - initializes band matrix operations for main problem * FSUNBANDMASSMAT_INIT - initializes band matrix operations for mass matrix solve */ void FSUNBANDMAT_INIT(int *code, long int *N, long int *mu, long int *ml, int *ier); void FSUNBANDMASSMAT_INIT(long int *N, long int *mu, long int *ml, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunmatrix/band/fsunmatrix_band.c0000644000176200001440000000456013766554457021563 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunmatrix_band.h) contains the * implementation needed for the Fortran initialization of band * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fsunmatrix_band.h" /* Define global matrix variables */ SUNMatrix F2C_CVODE_matrix; SUNMatrix F2C_IDA_matrix; SUNMatrix F2C_KINSOL_matrix; SUNMatrix F2C_ARKODE_matrix; SUNMatrix F2C_ARKODE_mass_matrix; /* Fortran callable interfaces */ void FSUNBANDMAT_INIT(int *code, long int *N, long int *mu, long int *ml, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); F2C_CVODE_matrix = NULL; F2C_CVODE_matrix = SUNBandMatrix(*N, *mu, *ml); if (F2C_CVODE_matrix == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix); F2C_IDA_matrix = NULL; F2C_IDA_matrix = SUNBandMatrix(*N, *mu, *ml); if (F2C_IDA_matrix == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); F2C_KINSOL_matrix = NULL; F2C_KINSOL_matrix = SUNBandMatrix(*N, *mu, *ml); if (F2C_KINSOL_matrix == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); F2C_ARKODE_matrix = NULL; F2C_ARKODE_matrix = SUNBandMatrix(*N, *mu, *ml); if (F2C_ARKODE_matrix == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNBANDMASSMAT_INIT(long int *N, long int *mu, long int *ml, int *ier) { *ier = 0; if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); F2C_ARKODE_mass_matrix = NULL; F2C_ARKODE_mass_matrix = SUNBandMatrix(*N, *mu, *ml); if (F2C_ARKODE_mass_matrix == NULL) *ier = -1; } StanHeaders/src/sunmatrix/band/sunmatrix_band.c0000644000176200001440000003137013766554457021414 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner @ LLNL * Based on code sundials_band.c by: Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the band implementation of * the SUNMATRIX package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Private function prototypes */ static booleantype SMCompatible_Band(SUNMatrix A, SUNMatrix B); static booleantype SMCompatible2_Band(SUNMatrix A, N_Vector x, N_Vector y); static int SMScaleAddNew_Band(realtype c, SUNMatrix A, SUNMatrix B); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Function to create a new band matrix with default storage upper bandwidth */ SUNMatrix SUNBandMatrix(sunindextype N, sunindextype mu, sunindextype ml) { return (SUNBandMatrixStorage(N, mu, ml, mu+ml)); } /* ---------------------------------------------------------------------------- * Function to create a new band matrix with specified storage upper bandwidth */ SUNMatrix SUNBandMatrixStorage(sunindextype N, sunindextype mu, sunindextype ml, sunindextype smu) { SUNMatrix A; SUNMatrix_Ops ops; SUNMatrixContent_Band content; sunindextype j, colSize; /* return with NULL matrix on illegal dimension input */ if ( (N <= 0) || (smu < 0) || (ml < 0) ) return(NULL); /* Create matrix */ A = NULL; A = (SUNMatrix) malloc(sizeof *A); if (A == NULL) return(NULL); /* Create matrix operation structure */ ops = NULL; ops = (SUNMatrix_Ops) malloc(sizeof(struct _generic_SUNMatrix_Ops)); if (ops == NULL) { free(A); return(NULL); } /* Attach operations */ ops->getid = SUNMatGetID_Band; ops->clone = SUNMatClone_Band; ops->destroy = SUNMatDestroy_Band; ops->zero = SUNMatZero_Band; ops->copy = SUNMatCopy_Band; ops->scaleadd = SUNMatScaleAdd_Band; ops->scaleaddi = SUNMatScaleAddI_Band; ops->matvec = SUNMatMatvec_Band; ops->space = SUNMatSpace_Band; /* Create content */ content = NULL; content = (SUNMatrixContent_Band) malloc(sizeof(struct _SUNMatrixContent_Band)); if (content == NULL) { free(ops); free(A); return(NULL); } /* Fill content */ colSize = smu + ml + 1; content->M = N; content->N = N; content->mu = mu; content->ml = ml; content->s_mu = smu; content->ldim = colSize; content->ldata = N * colSize; content->data = NULL; content->data = (realtype *) calloc(N * colSize, sizeof(realtype)); if (content->data == NULL) { free(content); free(ops); free(A); return(NULL); } content->cols = NULL; content->cols = (realtype **) malloc(N * sizeof(realtype *)); if (content->cols == NULL) { free(content->data); free(content); free(ops); free(A); return(NULL); } for (j=0; jcols[j] = content->data + j * colSize; /* Attach content and ops */ A->content = content; A->ops = ops; return(A); } /* ---------------------------------------------------------------------------- * Function to print the band matrix */ void SUNBandMatrix_Print(SUNMatrix A, FILE* outfile) { sunindextype i, j, start, finish; /* should not be called unless A is a band matrix; otherwise return immediately */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return; /* perform operation */ STAN_SUNDIALS_FPRINTF(outfile,"\n"); for (i=0; iops) free(A->ops); A->ops = NULL; if (A->content == NULL) { free(A); A = NULL; return; } if (SM_DATA_B(A)) free(SM_DATA_B(A)); SM_DATA_B(A) = NULL; if (SM_COLS_B(A)) free(SM_COLS_B(A)); SM_COLS_B(A) = NULL; if (A->content) free(A->content); A->content = NULL; free(A); A = NULL; return; } int SUNMatZero_Band(SUNMatrix A) { sunindextype i; realtype *Adata; /* Verify that A is a band matrix */ if (SUNMatGetID(A) != SUNMATRIX_BAND) return 1; /* Perform operation */ Adata = SM_DATA_B(A); for (i=0; i SM_UBAND_B(B)) || (SM_LBAND_B(A) > SM_LBAND_B(B)) ) { ml = SUNMAX(SM_LBAND_B(B),SM_LBAND_B(A)); mu = SUNMAX(SM_UBAND_B(B),SM_UBAND_B(A)); smu = SUNMAX(SM_SUBAND_B(B),SM_SUBAND_B(A)); colSize = smu + ml + 1; SM_CONTENT_B(B)->mu = mu; SM_CONTENT_B(B)->ml = ml; SM_CONTENT_B(B)->s_mu = smu; SM_CONTENT_B(B)->ldim = colSize; SM_CONTENT_B(B)->ldata = SM_COLUMNS_B(B) * colSize; SM_CONTENT_B(B)->data = (realtype *) realloc(SM_CONTENT_B(B)->data, SM_COLUMNS_B(B) * colSize*sizeof(realtype)); for (j=0; jcols[j] = SM_CONTENT_B(B)->data + j * colSize; } /* Perform operation */ if (SUNMatZero_Band(B) != 0) return 1; for (j=0; j SM_UBAND_B(A)) || (SM_LBAND_B(B) > SM_LBAND_B(A)) ) { return SMScaleAddNew_Band(c,A,B); } /* Otherwise, perform operation in-place */ for (j=0; jcontent); A->content = NULL; A->content = C->content; C->content = NULL; SUNMatDestroy_Band(C); return 0; } StanHeaders/src/sunmatrix/band/F90/0000755000176200001440000000000013766554135016555 5ustar liggesusersStanHeaders/src/sunmatrix/band/F90/fsunmatrix_band.f900000644000176200001440000001642413766554457022277 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): David J. Gardner @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS band matrix using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunmatrix_band_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNBandMatrix(N, mu, ml, smu) & bind(C,name='SUNBandMatrix') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: N integer(c_long), value :: mu integer(c_long), value :: ml integer(c_long), value :: smu end function FSUNBandMatrix ! ================================================================= ! Destructors ! ================================================================= subroutine FSUNMatDestroy_Band(A) & bind(C,name='SUNMatDestroy_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end subroutine FSUNMatDestroy_Band ! ================================================================= ! Other routines ! ================================================================= ! ----------------------------------------------------------------- ! NOT INTERFACED SUNBandMatrix_Print ! ----------------------------------------------------------------- integer(c_long) function FSUNBandMatrix_Rows(A) & bind(C,name='SUNBandMatrix_Rows') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_Rows integer(c_long) function FSUNBandMatrix_Columns(A) & bind(C,name='SUNBandMatrix_Columns') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_Columns integer(c_long) function FSUNBandMatrix_LowerBandwidth(A) & bind(C,name='SUNBandMatrix_LowerBandwidth') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_LowerBandwidth integer(c_long) function FSUNBandMatrix_UpperBandwidth(A) & bind(C,name='SUNBandMatrix_UpperBandwidth') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_UpperBandwidth integer(c_long) function FSUNBandMatrix_StoredUpperBandwidth(A) & bind(C,name='SUNBandMatrix_StoredUpperBandwidth') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_StoredUpperBandwidth integer(c_long) function FSUNBandMatrix_LDim(A) & bind(C,name='SUNBandMatrix_LDim') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_LDim type(c_ptr) function FSUNBandMatrix_Data(A) & bind(C,name='SUNBandMatrix_Data') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNBandMatrix_Data ! ----------------------------------------------------------------- ! NOT INTERFACED SUNBandMatrix_Cols ! ----------------------------------------------------------------- type(c_ptr) function FSUNBandMatrix_Column(A, j) & bind(C,name='SUNBandMatrix_Column') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A integer(c_long), value :: j end function FSUNBandMatrix_Column ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNMatGetID_Band(A) & bind(C,name='SUNMatGetID_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNMatGetID_Band type(c_ptr) function FSUNMatClone_Band(A) & bind(C,name='SUNMatClone_Band') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: A end function FSUNMatClone_Band integer(c_int) function FSUNMatZero_Band(A) & bind(C,name='SUNMatZero_Band') use, intrinsic :: iso_c_binding type(c_ptr), value :: A end function FSUNMatZero_Band integer(c_int) function FSUNMatCopy_Band(A, B) & bind(C,name='SUNMatCopy_Band') use, intrinsic :: iso_c_binding type(c_ptr), value :: A type(c_ptr), value :: B end function FSUNMatCopy_Band integer(c_int) function FSUNMatScaleAdd_Band(c, A, B) & bind(C,name='SUNMatScaleAdd_Band') use, intrinsic :: iso_c_binding real(c_double), value :: c type(c_ptr), value :: A type(c_ptr), value :: B end function FSUNMatScaleAdd_Band integer(c_int) function FSUNMatScaleAddI_Band(c, A) & bind(C,name='SUNMatScaleAddI_Band') use, intrinsic :: iso_c_binding real(c_double), value :: c type(c_ptr), value :: A end function FSUNMatScaleAddI_Band integer(c_int) function FSUNMatMatvec_Band(A, x, y) & bind(C,name='SUNMatMatvec_Band') use, intrinsic :: iso_c_binding type(c_ptr), value :: A type(c_ptr), value :: x type(c_ptr), value :: y end function FSUNMatMatvec_Band integer(c_int) function FSUNMatSpace_Band(A, lenrw, leniw) & bind(C,name='SUNMatSpace_Band') use, intrinsic :: iso_c_binding type(c_ptr), value :: A integer(c_long) :: lenrw integer(c_long) :: leniw end function FSUNMatSpace_Band end interface contains ! ================================================================ ! Helpful routines ! ================================================================ ! ---------------------------------------------------------------- ! FSUNMatGetData_Band ! ! Extracts data array from a SUNDIALS Band Matrix ! ---------------------------------------------------------------- subroutine FSUNMatGetData_Band(A, f_array) !======= Inclusions =========== use, intrinsic :: iso_c_binding !======= Declarations ========= implicit none ! calling variables type(c_ptr) :: A real(c_double), pointer :: f_array(:) ! internal variables type(c_ptr) :: c_array integer(c_long) :: ldim !======= Internals ============ ! get data pointer from N_Vector c_array = FSUNBandMatrix_Data(A) ! get length of the data array ldim = FSUNBandMatrix_LDim(A) ! convert 1D data array call c_f_pointer(c_array, f_array, (/ldim/)) end subroutine FSUNMatGetData_Band end module fsunmatrix_band_mod StanHeaders/src/sunmatrix/sparse/0000755000176200001440000000000013766554135016610 5ustar liggesusersStanHeaders/src/sunmatrix/sparse/fsunmatrix_sparse.c0000644000176200001440000000475113766554457022547 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of fsunmatrix_sparse.h) contains the * implementation needed for the Fortran initialization of sparse * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fsunmatrix_sparse.h" /* Define global matrix variables */ SUNMatrix F2C_CVODE_matrix; SUNMatrix F2C_IDA_matrix; SUNMatrix F2C_KINSOL_matrix; SUNMatrix F2C_ARKODE_matrix; SUNMatrix F2C_ARKODE_mass_matrix; /* Fortran callable interfaces */ void FSUNSPARSEMAT_INIT(int *code, long int *M, long int *N, long int *NNZ, int *sparsetype, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_matrix) SUNMatDestroy(F2C_CVODE_matrix); F2C_CVODE_matrix = NULL; F2C_CVODE_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype); if (F2C_CVODE_matrix == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_matrix) SUNMatDestroy(F2C_IDA_matrix); F2C_IDA_matrix = NULL; F2C_IDA_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype); if (F2C_IDA_matrix == NULL) *ier = -1; break; case FCMIX_KINSOL: if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); F2C_KINSOL_matrix = NULL; F2C_KINSOL_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype); if (F2C_KINSOL_matrix == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_matrix) SUNMatDestroy(F2C_ARKODE_matrix); F2C_ARKODE_matrix = NULL; F2C_ARKODE_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype); if (F2C_ARKODE_matrix == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNSPARSEMASSMAT_INIT(long int *M, long int *N, long int *NNZ, int *sparsetype, int *ier) { *ier = 0; if (F2C_ARKODE_mass_matrix) SUNMatDestroy(F2C_ARKODE_mass_matrix); F2C_ARKODE_mass_matrix = NULL; F2C_ARKODE_mass_matrix = SUNSparseMatrix(*M, *N, *NNZ, *sparsetype); if (F2C_ARKODE_mass_matrix == NULL) *ier = -1; } StanHeaders/src/sunmatrix/sparse/sunmatrix_sparse.c0000644000176200001440000007530213766554457022401 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner @ LLNL * Based on code sundials_sparse.c by: Carol Woodward and * Slaven Peles @ LLNL, and Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the sparse implementation of * the SUNMATRIX package. * ----------------------------------------------------------------- */ #include #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Private function prototypes */ static booleantype SMCompatible_Sparse(SUNMatrix A, SUNMatrix B); static booleantype SMCompatible2_Sparse(SUNMatrix A, N_Vector x, N_Vector y); int Matvec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y); int Matvec_SparseCSR(SUNMatrix A, N_Vector x, N_Vector y); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* * ================================================================== * Private function prototypes (functions working on SlsMat) * ================================================================== */ /* ---------------------------------------------------------------------------- * Function to create a new sparse matrix */ SUNMatrix SUNSparseMatrix(sunindextype M, sunindextype N, sunindextype NNZ, int sparsetype) { SUNMatrix A; SUNMatrix_Ops ops; SUNMatrixContent_Sparse content; /* return with NULL matrix on illegal input */ if ( (M <= 0) || (N <= 0) || (NNZ < 0) ) return(NULL); if ( (sparsetype != CSC_MAT) && (sparsetype != CSR_MAT) ) return(NULL); /* Create matrix */ A = NULL; A = (SUNMatrix) malloc(sizeof *A); if (A == NULL) return(NULL); /* Create matrix operation structure */ ops = NULL; ops = (SUNMatrix_Ops) malloc(sizeof(struct _generic_SUNMatrix_Ops)); if (ops == NULL) { free(A); return(NULL); } /* Attach operations */ ops->getid = SUNMatGetID_Sparse; ops->clone = SUNMatClone_Sparse; ops->destroy = SUNMatDestroy_Sparse; ops->zero = SUNMatZero_Sparse; ops->copy = SUNMatCopy_Sparse; ops->scaleadd = SUNMatScaleAdd_Sparse; ops->scaleaddi = SUNMatScaleAddI_Sparse; ops->matvec = SUNMatMatvec_Sparse; ops->space = SUNMatSpace_Sparse; /* Create content */ content = NULL; content = (SUNMatrixContent_Sparse) malloc(sizeof(struct _SUNMatrixContent_Sparse)); if (content == NULL) { free(ops); free(A); return(NULL); } /* Fill content */ content->sparsetype = sparsetype; content->M = M; content->N = N; content->NNZ = NNZ; switch(sparsetype){ case CSC_MAT: content->NP = N; content->rowvals = &(content->indexvals); content->colptrs = &(content->indexptrs); /* CSR indices */ content->colvals = NULL; content->rowptrs = NULL; break; case CSR_MAT: content->NP = M; content->colvals = &(content->indexvals); content->rowptrs = &(content->indexptrs); /* CSC indices */ content->rowvals = NULL; content->colptrs = NULL; } content->data = (realtype *) calloc(NNZ, sizeof(realtype)); if (content->data == NULL) { free(content); free(ops); free(A); return(NULL); } content->indexvals = (sunindextype *) calloc(NNZ, sizeof(sunindextype)); if (content->indexvals == NULL) { free(content->data); free(content); free(ops); free(A); return(NULL); } content->indexptrs = (sunindextype *) calloc((content->NP + 1), sizeof(sunindextype)); if (content->indexptrs == NULL) { free(content->indexvals); free(content->data); free(content); free(ops); free(A); return(NULL); } content->indexptrs[content->NP] = 0; /* Attach content and ops */ A->content = content; A->ops = ops; return(A); } /* ---------------------------------------------------------------------------- * Function to create a new sparse matrix from an existing dense matrix * by copying all nonzero values into the sparse matrix structure. Returns NULL * if the request for matrix storage cannot be satisfied. */ SUNMatrix SUNSparseFromDenseMatrix(SUNMatrix Ad, realtype droptol, int sparsetype) { sunindextype i, j, nnz; sunindextype M, N; SUNMatrix As; /* check for legal sparsetype, droptol and input matrix type */ if ( (sparsetype != CSR_MAT) && (sparsetype != CSC_MAT) ) return NULL; if ( droptol < ZERO ) return NULL; if (SUNMatGetID(Ad) != SUNMATRIX_DENSE) return NULL; /* set size of new matrix */ M = SM_ROWS_D(Ad); N = SM_COLUMNS_D(Ad); /* determine total number of nonzeros */ nnz = 0; for (j=0; j droptol); /* allocate sparse matrix */ As = SUNSparseMatrix(M, N, nnz, sparsetype); if (As == NULL) return NULL; /* copy nonzeros from Ad into As, based on CSR/CSC type */ nnz = 0; if (sparsetype == CSC_MAT) { for (j=0; j droptol ) { (SM_INDEXVALS_S(As))[nnz] = i; (SM_DATA_S(As))[nnz++] = SM_ELEMENT_D(Ad,i,j); } } } (SM_INDEXPTRS_S(As))[N] = nnz; } else { /* CSR_MAT */ for (i=0; i droptol ) { (SM_INDEXVALS_S(As))[nnz] = j; (SM_DATA_S(As))[nnz++] = SM_ELEMENT_D(Ad,i,j); } } } (SM_INDEXPTRS_S(As))[M] = nnz; } return(As); } /* ---------------------------------------------------------------------------- * Function to create a new sparse matrix from an existing band matrix * by copying all nonzero values into the sparse matrix structure. Returns NULL * if the request for matrix storage cannot be satisfied. */ SUNMatrix SUNSparseFromBandMatrix(SUNMatrix Ad, realtype droptol, int sparsetype) { sunindextype i, j, nnz; sunindextype M, N; SUNMatrix As; /* check for legal sparsetype, droptol and input matrix type */ if ( (sparsetype != CSR_MAT) && (sparsetype != CSC_MAT) ) return NULL; if ( droptol < ZERO ) return NULL; if (SUNMatGetID(Ad) != SUNMATRIX_BAND) return NULL; /* set size of new matrix */ M = SM_ROWS_B(Ad); N = SM_COLUMNS_B(Ad); /* determine total number of nonzeros */ nnz = 0; for (j=0; j droptol); /* allocate sparse matrix */ As = SUNSparseMatrix(M, N, nnz, sparsetype); if (As == NULL) return NULL; /* copy nonzeros from Ad into As, based on CSR/CSC type */ nnz = 0; if (sparsetype == CSC_MAT) { for (j=0; j droptol ) { (SM_INDEXVALS_S(As))[nnz] = i; (SM_DATA_S(As))[nnz++] = SM_ELEMENT_B(Ad,i,j); } } } (SM_INDEXPTRS_S(As))[N] = nnz; } else { /* CSR_MAT */ for (i=0; i droptol ) { (SM_INDEXVALS_S(As))[nnz] = j; (SM_DATA_S(As))[nnz++] = SM_ELEMENT_B(Ad,i,j); } } } (SM_INDEXPTRS_S(As))[M] = nnz; } return(As); } /* ---------------------------------------------------------------------------- * Function to reallocate internal sparse matrix storage arrays so that the * resulting sparse matrix holds indexptrs[NP] nonzeros. Returns 0 on success * and 1 on failure (e.g. if A does not have sparse type, or if nnz is negative) */ int SUNSparseMatrix_Realloc(SUNMatrix A) { sunindextype nzmax; /* check for valid matrix type */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return 1; /* get total number of nonzeros (return with failure if illegal) */ nzmax = (SM_INDEXPTRS_S(A))[SM_NP_S(A)]; if (nzmax < 0) return 1; /* perform reallocation */ SM_INDEXVALS_S(A) = (sunindextype *) realloc(SM_INDEXVALS_S(A), nzmax*sizeof(sunindextype)); SM_DATA_S(A) = (realtype *) realloc(SM_DATA_S(A), nzmax*sizeof(realtype)); SM_NNZ_S(A) = nzmax; return 0; } /* ---------------------------------------------------------------------------- * Function to reallocate internal sparse matrix storage arrays so that the * resulting sparse matrix has storage for a specified number of nonzeros. * Returns 0 on success and 1 on failure (e.g. if A does not have sparse type, * or if nnz is negative) */ int SUNSparseMatrix_Reallocate(SUNMatrix A, sunindextype NNZ) { /* check for valid matrix type */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return 1; /* check for valid nnz */ if (NNZ < 0) return 1; /* perform reallocation */ SM_INDEXVALS_S(A) = (sunindextype *) realloc(SM_INDEXVALS_S(A), NNZ*sizeof(sunindextype)); SM_DATA_S(A) = (realtype *) realloc(SM_DATA_S(A), NNZ*sizeof(realtype)); SM_NNZ_S(A) = NNZ; return 0; } /* ---------------------------------------------------------------------------- * Function to print the sparse matrix */ void SUNSparseMatrix_Print(SUNMatrix A, FILE* outfile) { sunindextype i, j; char *matrixtype; char *indexname; /* should not be called unless A is a sparse matrix; otherwise return immediately */ if (SUNMatGetID(A) != SUNMATRIX_SPARSE) return; /* perform operation */ if (SM_SPARSETYPE_S(A) == CSC_MAT) { indexname = (char*) "col"; matrixtype = (char*) "CSC"; } else { indexname = (char*) "row"; matrixtype = (char*) "CSR"; } STAN_SUNDIALS_FPRINTF(outfile, "\n"); STAN_SUNDIALS_FPRINTF(outfile, "%ld by %ld %s matrix, NNZ: %ld \n", (long int) SM_ROWS_S(A), (long int) SM_COLUMNS_S(A), matrixtype, (long int) SM_NNZ_S(A)); for (j=0; jrowvals = NULL; SM_CONTENT_S(A)->colvals = NULL; } if (SM_INDEXPTRS_S(A)) { free(SM_INDEXPTRS_S(A)); SM_INDEXPTRS_S(A) = NULL; SM_CONTENT_S(A)->colptrs = NULL; SM_CONTENT_S(A)->rowptrs = NULL; } free(A->content); A->content = NULL; free(A->ops); A->ops = NULL; free(A); A = NULL; return; } int SUNMatZero_Sparse(SUNMatrix A) { sunindextype i; /* Perform operation */ for (i=0; i (SM_NNZ_S(A) - Ap[N])) newmat = SUNTRUE; /* perform operation based on existing/necessary structure */ /* case 1: A already contains a diagonal */ if (newvals == 0) { /* iterate through columns, adding 1.0 to diagonal */ for (j=0; j < SUNMIN(M,N); j++) for (i=Ap[j]; i=0; j--) { /* clear out temporary arrays for this column (row) */ for (i=0; i=0; i--) { if ( w[i] > 0 ) { Ai[--nz] = i; Ax[nz] = x[i]; } } /* store ptr past this col (row) from orig A, update value for new A */ cend = Ap[j]; Ap[j] = nz; } /* clean up */ free(w); free(x); /* case 3: A must be reallocated with sufficient storage */ } else { /* create work arrays for nonzero indices and values */ w = (sunindextype *) malloc(M * sizeof(sunindextype)); x = (realtype *) malloc(M * sizeof(realtype)); /* create new matrix for sum */ C = SUNSparseMatrix(SM_ROWS_S(A), SM_COLUMNS_S(A), Ap[N] + newvals, SM_SPARSETYPE_S(A)); /* access data from CSR structures (return if failure) */ Cp = Ci = NULL; Cx = NULL; if (SM_INDEXPTRS_S(C)) Cp = SM_INDEXPTRS_S(C); else return (-1); if (SM_INDEXVALS_S(C)) Ci = SM_INDEXVALS_S(C); else return (-1); if (SM_DATA_S(C)) Cx = SM_DATA_S(C); else return (-1); /* initialize total nonzero count */ nz = 0; /* iterate through columns (rows for CSR) */ for (j=0; j 0 ) { Ci[nz] = i; Cx[nz++] = x[i]; } } } /* indicate end of data */ Cp[N] = nz; /* update A's structure with C's values; nullify C's pointers */ SM_NNZ_S(A) = SM_NNZ_S(C); if (SM_DATA_S(A)) free(SM_DATA_S(A)); SM_DATA_S(A) = SM_DATA_S(C); SM_DATA_S(C) = NULL; if (SM_INDEXVALS_S(A)) free(SM_INDEXVALS_S(A)); SM_INDEXVALS_S(A) = SM_INDEXVALS_S(C); SM_INDEXVALS_S(C) = NULL; if (SM_INDEXPTRS_S(A)) free(SM_INDEXPTRS_S(A)); SM_INDEXPTRS_S(A) = SM_INDEXPTRS_S(C); SM_INDEXPTRS_S(C) = NULL; /* clean up */ SUNMatDestroy_Sparse(C); free(w); free(x); } return 0; } int SUNMatScaleAdd_Sparse(realtype c, SUNMatrix A, SUNMatrix B) { sunindextype j, i, p, nz, newvals, M, N, cend; booleantype newmat; sunindextype *w, *Ap, *Ai, *Bp, *Bi, *Cp, *Ci; realtype *x, *Ax, *Bx, *Cx; SUNMatrix C; /* Verify that A and B are compatible */ if (!SMCompatible_Sparse(A, B)) return 1; /* store shortcuts to matrix dimensions (M is inner dimension, N is outer) */ if (SM_SPARSETYPE_S(A) == CSC_MAT) { M = SM_ROWS_S(A); N = SM_COLUMNS_S(A); } else { M = SM_COLUMNS_S(A); N = SM_ROWS_S(A); } /* access data arrays from A and B (return if failure) */ Ap = Ai = Bp = Bi = NULL; Ax = Bx = NULL; if (SM_INDEXPTRS_S(A)) Ap = SM_INDEXPTRS_S(A); else return(-1); if (SM_INDEXVALS_S(A)) Ai = SM_INDEXVALS_S(A); else return(-1); if (SM_DATA_S(A)) Ax = SM_DATA_S(A); else return(-1); if (SM_INDEXPTRS_S(B)) Bp = SM_INDEXPTRS_S(B); else return(-1); if (SM_INDEXVALS_S(B)) Bi = SM_INDEXVALS_S(B); else return(-1); if (SM_DATA_S(B)) Bx = SM_DATA_S(B); else return(-1); /* create work arrays for row indices and nonzero column values */ w = (sunindextype *) malloc(M * sizeof(sunindextype)); x = (realtype *) malloc(M * sizeof(realtype)); /* determine if A already contains the sparsity pattern of B */ newvals = 0; for (j=0; j (SM_NNZ_S(A) - Ap[N])) newmat = SUNTRUE; /* perform operation based on existing/necessary structure */ /* case 1: A already contains sparsity pattern of B */ if (newvals == 0) { /* iterate through columns, adding matrices */ for (j=0; j=0; j--) { /* clear out temporary arrays for this column (row) */ for (i=0; i=0; i--) { if ( w[i] > 0 ) { Ai[--nz] = i; Ax[nz] = x[i]; } } /* store ptr past this col (row) from orig A, update value for new A */ cend = Ap[j]; Ap[j] = nz; } /* case 3: A must be reallocated with sufficient storage */ } else { /* create new matrix for sum */ C = SUNSparseMatrix(SM_ROWS_S(A), SM_COLUMNS_S(A), Ap[N] + newvals, SM_SPARSETYPE_S(A)); /* access data from CSR structures (return if failure) */ Cp = Ci = NULL; Cx = NULL; if (SM_INDEXPTRS_S(C)) Cp = SM_INDEXPTRS_S(C); else return(-1); if (SM_INDEXVALS_S(C)) Ci = SM_INDEXVALS_S(C); else return(-1); if (SM_DATA_S(C)) Cx = SM_DATA_S(C); else return(-1); /* initialize total nonzero count */ nz = 0; /* iterate through columns (rows) */ for (j=0; j 0 ) { Ci[nz] = i; Cx[nz++] = x[i]; } } } /* indicate end of data */ Cp[N] = nz; /* update A's structure with C's values; nullify C's pointers */ SM_NNZ_S(A) = SM_NNZ_S(C); free(SM_DATA_S(A)); SM_DATA_S(A) = SM_DATA_S(C); SM_DATA_S(C) = NULL; free(SM_INDEXVALS_S(A)); SM_INDEXVALS_S(A) = SM_INDEXVALS_S(C); SM_INDEXVALS_S(C) = NULL; free(SM_INDEXPTRS_S(A)); SM_INDEXPTRS_S(A) = SM_INDEXPTRS_S(C); SM_INDEXPTRS_S(C) = NULL; /* clean up */ SUNMatDestroy_Sparse(C); } /* clean up */ free(w); free(x); /* return success */ return(0); } int SUNMatMatvec_Sparse(SUNMatrix A, N_Vector x, N_Vector y) { /* Verify that A, x and y are compatible */ if (!SMCompatible2_Sparse(A, x, y)) return 1; /* Perform operation */ if(SM_SPARSETYPE_S(A) == CSC_MAT) return Matvec_SparseCSC(A, x, y); else return Matvec_SparseCSR(A, x, y); } int SUNMatSpace_Sparse(SUNMatrix A, long int *lenrw, long int *leniw) { *lenrw = SM_NNZ_S(A); *leniw = 10 + SM_NP_S(A) + SM_NNZ_S(A); return 0; } /* * ================================================================= * private functions * ================================================================= */ /* ----------------------------------------------------------------- * Function to check compatibility of two sparse SUNMatrix objects */ static booleantype SMCompatible_Sparse(SUNMatrix A, SUNMatrix B) { /* both matrices must be sparse */ if ( (SUNMatGetID(A) != SUNMATRIX_SPARSE) || (SUNMatGetID(B) != SUNMATRIX_SPARSE) ) return SUNFALSE; /* both matrices must have the same shape and sparsity type */ if (SUNSparseMatrix_Rows(A) != SUNSparseMatrix_Rows(B)) return SUNFALSE; if (SUNSparseMatrix_Columns(A) != SUNSparseMatrix_Columns(B)) return SUNFALSE; if (SM_SPARSETYPE_S(A) != SM_SPARSETYPE_S(B)) return SUNFALSE; return SUNTRUE; } /* ----------------------------------------------------------------- * Function to check compatibility of a SUNMatrix object with two * N_Vectors (A*x = b) */ static booleantype SMCompatible2_Sparse(SUNMatrix A, N_Vector x, N_Vector y) { /* vectors must be one of {SERIAL, OPENMP, PTHREADS} */ if ( (N_VGetVectorID(x) != SUNDIALS_NVEC_SERIAL) && (N_VGetVectorID(x) != SUNDIALS_NVEC_OPENMP) && (N_VGetVectorID(x) != SUNDIALS_NVEC_PTHREADS) ) return SUNFALSE; /* Optimally we would verify that the dimensions of A, x and y agree, but since there is no generic 'length' routine for N_Vectors we cannot */ return SUNTRUE; } /* ----------------------------------------------------------------- * Computes y=A*x, where A is a CSC SUNMatrix_Sparse of dimension MxN, x is a * compatible N_Vector object of length N, and y is a compatible * N_Vector object of length M. * * Returns 0 if successful, 1 if unsuccessful (failed memory access, or both * x and y are the same vector). */ int Matvec_SparseCSC(SUNMatrix A, N_Vector x, N_Vector y) { sunindextype i, j; sunindextype *Ap, *Ai; realtype *Ax, *xd, *yd; /* access data from CSC structure (return if failure) */ Ap = SM_INDEXPTRS_S(A); Ai = SM_INDEXVALS_S(A); Ax = SM_DATA_S(A); if ((Ap == NULL) || (Ai == NULL) || (Ax == NULL)) return 1; /* access vector data (return if failure) */ xd = N_VGetArrayPointer(x); yd = N_VGetArrayPointer(y); if ((xd == NULL) || (yd == NULL) || (xd == yd) ) return 1; /* initialize result */ for (i=0; i #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNSPARSEMAT_INIT SUNDIALS_F77_FUNC(fsunsparsematinit, FSUNSPARSEMATINIT) #define FSUNSPARSEMASSMAT_INIT SUNDIALS_F77_FUNC(fsunsparsemassmatinit, FSUNSPARSEMASSMATINIT) #else #define FSUNSPARSEMAT_INIT fsunsparsematinit_ #define FSUNSPARSEMASSMAT_INIT fsunsparsemassmatinit_ #endif /* Declarations of global variables */ extern SUNMatrix F2C_CVODE_matrix; extern SUNMatrix F2C_IDA_matrix; extern SUNMatrix F2C_KINSOL_matrix; extern SUNMatrix F2C_ARKODE_matrix; extern SUNMatrix F2C_ARKODE_mass_matrix; /* * Prototypes of exported functions * * FSUNSPARSEMAT_INIT - initializes sparse matrix operations for main problem * FSUNSPARSEMASSMAT_INIT - initializes sparse matrix operations for mass matrix solve */ void FSUNSPARSEMAT_INIT(int *code, long int *M, long int *N, long int *NNZ, int *sparsetype, int *ier); void FSUNSPARSEMASSMAT_INIT(long int *M, long int *N, long int *NNZ, int *sparsetype, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/nvector/0000755000176200001440000000000013766554135014741 5ustar liggesusersStanHeaders/src/nvector/cuda/0000755000176200001440000000000013766554135015655 5ustar liggesusersStanHeaders/src/nvector/cuda/nvector_cuda.cu0000644000176200001440000007500413766554457020677 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles, and Cody J. Balos @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a MPI+CUDA implementation * of the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) extern "C" { using namespace suncudavec; /* * Type definitions */ typedef suncudavec::Vector vector_type; /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Cuda(N_Vector v) { return SUNDIALS_NVEC_CUDA; } N_Vector N_VNewEmpty_Cuda() { N_Vector v; N_Vector_Ops ops; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Cuda; ops->nvclone = N_VClone_Cuda; ops->nvcloneempty = N_VCloneEmpty_Cuda; ops->nvdestroy = N_VDestroy_Cuda; ops->nvspace = N_VSpace_Cuda; ops->nvgetarraypointer = NULL; ops->nvsetarraypointer = NULL; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_Cuda; ops->nvconst = N_VConst_Cuda; ops->nvprod = N_VProd_Cuda; ops->nvdiv = N_VDiv_Cuda; ops->nvscale = N_VScale_Cuda; ops->nvabs = N_VAbs_Cuda; ops->nvinv = N_VInv_Cuda; ops->nvaddconst = N_VAddConst_Cuda; ops->nvdotprod = N_VDotProd_Cuda; ops->nvmaxnorm = N_VMaxNorm_Cuda; ops->nvwrmsnormmask = N_VWrmsNormMask_Cuda; ops->nvwrmsnorm = N_VWrmsNorm_Cuda; ops->nvmin = N_VMin_Cuda; ops->nvwl2norm = N_VWL2Norm_Cuda; ops->nvl1norm = N_VL1Norm_Cuda; ops->nvcompare = N_VCompare_Cuda; ops->nvinvtest = N_VInvTest_Cuda; ops->nvconstrmask = N_VConstrMask_Cuda; ops->nvminquotient = N_VMinQuotient_Cuda; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Attach ops and set content to NULL */ v->content = NULL; v->ops = ops; return(v); } #if SUNDIALS_MPI_ENABLED N_Vector N_VNew_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); v->content = new vector_type(comm, local_length, global_length); return(v); } N_Vector N_VNewManaged_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); /* create suncudavec::Vector with managed memory */ v->content = new vector_type(comm, local_length, global_length, true); return(v); } N_Vector N_VMake_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length, realtype *h_vdata, realtype *d_vdata) { N_Vector v; if (h_vdata == NULL || d_vdata == NULL) return(NULL); v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); /* create suncudavec::Vector using the user-provided data arrays */ v->content = new vector_type(comm, local_length, global_length, false, false, h_vdata, d_vdata); return(v); } N_Vector N_VMakeManaged_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length, realtype *vdata) { N_Vector v; if (vdata == NULL) return(NULL); v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); /* create suncudavec::Vector with managed memory using the user-provided data arrays */ v->content = new vector_type(comm, local_length, global_length, true, false, vdata, vdata); return(v); } #else N_Vector N_VNew_Cuda(sunindextype length) { N_Vector v; v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); v->content = new vector_type(length); return(v); } N_Vector N_VNewManaged_Cuda(sunindextype length) { N_Vector v; v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); /* create suncudavec::Vector with managed memory */ v->content = new vector_type(length, true); return(v); } N_Vector N_VMake_Cuda(sunindextype length, realtype *h_vdata, realtype *d_vdata) { N_Vector v; if (h_vdata == NULL || d_vdata == NULL) return(NULL); v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); /* create suncudavec::Vector using the user-provided data arrays */ v->content = new vector_type(length, false, false, h_vdata, d_vdata); return(v); } N_Vector N_VMakeManaged_Cuda(sunindextype length, realtype *vdata) { N_Vector v; if (vdata == NULL) return(NULL); v = NULL; v = N_VNewEmpty_Cuda(); if (v == NULL) return(NULL); /* create suncudavec::Vector with managed memory using the user-provided data arrays */ v->content = new vector_type(length, true, false, vdata, vdata); return(v); } #endif /* ----------------------------------------------------------------- * Function to return the global length of the vector. */ sunindextype N_VGetLength_Cuda(N_Vector v) { vector_type* xd = static_cast(v->content); return (xd->sizeGlobal()); } #if SUNDIALS_MPI_ENABLED /* ----------------------------------------------------------------- * Function to return the local length of the vector. */ sunindextype N_VGetLocalLength_Cuda(N_Vector v) { vector_type* xd = static_cast(v->content); return (xd->size()); } /* ----------------------------------------------------------------- * Function to return the MPI communicator for the vector. */ MPI_Comm N_VGetMPIComm_Cuda(N_Vector v) { vector_type* xd = static_cast(v->content); return (xd->comm()); } #endif /* ---------------------------------------------------------------------------- * Return pointer to the raw host data */ realtype *N_VGetHostArrayPointer_Cuda(N_Vector x) { vector_type* xv = static_cast(x->content); return (xv->host()); } /* ---------------------------------------------------------------------------- * Return pointer to the raw device data */ realtype *N_VGetDeviceArrayPointer_Cuda(N_Vector x) { vector_type* xv = static_cast(x->content); return (xv->device()); } /* ---------------------------------------------------------------------------- * Return a flag indicating if the memory for the vector data is managed */ booleantype N_VIsManagedMemory_Cuda(N_Vector x) { vector_type* xv = static_cast(x->content); return (xv->isManaged()); } /* * ---------------------------------------------------------------------------- * Sets the cudaStream_t to use for execution of the CUDA kernels. */ void N_VSetCudaStream_Cuda(N_Vector x, cudaStream_t *stream) { vector_type* xv = static_cast(x->content); xv->partStream().setStream(*stream); xv->partReduce().setStream(*stream); } /* ---------------------------------------------------------------------------- * Copy vector data to the device */ void N_VCopyToDevice_Cuda(N_Vector x) { vector_type* xv = static_cast(x->content); xv->copyToDev(); } /* ---------------------------------------------------------------------------- * Copy vector data from the device to the host */ void N_VCopyFromDevice_Cuda(N_Vector x) { vector_type* xv = static_cast(x->content); xv->copyFromDev(); } /* ---------------------------------------------------------------------------- * Function to print the a CUDA-based vector to stdout */ void N_VPrint_Cuda(N_Vector x) { N_VPrintFile_Cuda(x, stdout); } /* ---------------------------------------------------------------------------- * Function to print the a CUDA-based vector to outfile */ void N_VPrintFile_Cuda(N_Vector x, FILE *outfile) { sunindextype i; vector_type* xd = static_cast(x->content); for (i = 0; i < xd->size(); i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) fprintf(outfile, "%35.32Lg\n", xd->host()[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) fprintf(outfile, "%19.16g\n", xd->host()[i]); #else fprintf(outfile, "%11.8g\n", xd->host()[i]); #endif } fprintf(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Cuda(N_Vector w) { N_Vector v; N_Vector_Ops ops; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ v->content = NULL; v->ops = ops; return(v); } N_Vector N_VClone_Cuda(N_Vector w) { N_Vector v; vector_type* wdat = static_cast(w->content); vector_type* vdat = new vector_type(*wdat); v = NULL; v = N_VCloneEmpty_Cuda(w); if (v == NULL) return(NULL); v->content = vdat; return(v); } void N_VDestroy_Cuda(N_Vector v) { vector_type* x = static_cast(v->content); if (x != NULL) { delete x; v->content = NULL; } free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Cuda(N_Vector X, sunindextype *lrw, sunindextype *liw) { int npes; vector_type* x = static_cast(X->content); SUNMPI_Comm_size(x->comm(), &npes); *lrw = x->sizeGlobal(); *liw = 2*npes; } void N_VConst_Cuda(realtype a, N_Vector X) { vector_type *xvec = static_cast(X->content); setConst(a, *xvec); } void N_VLinearSum_Cuda(realtype a, N_Vector X, realtype b, N_Vector Y, N_Vector Z) { const vector_type *xvec = static_cast(X->content); const vector_type *yvec = static_cast(Y->content); vector_type *zvec = static_cast(Z->content); linearSum(a, *xvec, b, *yvec, *zvec); } void N_VProd_Cuda(N_Vector X, N_Vector Y, N_Vector Z) { const vector_type *xvec = static_cast(X->content); const vector_type *yvec = static_cast(Y->content); vector_type *zvec = static_cast(Z->content); prod(*xvec, *yvec, *zvec); } void N_VDiv_Cuda(N_Vector X, N_Vector Y, N_Vector Z) { const vector_type *xvec = static_cast(X->content); const vector_type *yvec = static_cast(Y->content); vector_type *zvec = static_cast(Z->content); div(*xvec, *yvec, *zvec); } void N_VScale_Cuda(realtype a, N_Vector X, N_Vector Z) { const vector_type *xvec = static_cast(X->content); vector_type *zvec = static_cast(Z->content); scale(a, *xvec, *zvec); } void N_VAbs_Cuda(N_Vector X, N_Vector Z) { const vector_type *xvec = static_cast(X->content); vector_type *zvec = static_cast(Z->content); absVal(*xvec, *zvec); } void N_VInv_Cuda(N_Vector X, N_Vector Z) { const vector_type *xvec = static_cast(X->content); vector_type *zvec = static_cast(Z->content); inv(*xvec, *zvec); } void N_VAddConst_Cuda(N_Vector X, realtype b, N_Vector Z) { const vector_type *xvec = static_cast(X->content); vector_type *zvec = static_cast(Z->content); addConst(b, *xvec, *zvec); } realtype N_VDotProd_Cuda(N_Vector X, N_Vector Y) { const vector_type *xvec = static_cast(X->content); const vector_type *yvec = static_cast(Y->content); SUNMPI_Comm comm = xvec->comm(); realtype sum = dotProd(*xvec, *yvec); realtype gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return gsum; } realtype N_VMaxNorm_Cuda(N_Vector X) { const vector_type *xvec = static_cast(X->content); SUNMPI_Comm comm = xvec->comm(); realtype locmax = maxNorm(*xvec); realtype globmax = SUNMPI_Allreduce_scalar(locmax, 2, comm); return globmax; } realtype N_VWrmsNorm_Cuda(N_Vector X, N_Vector W) { const vector_type *xvec = static_cast(X->content); const vector_type *wvec = static_cast(W->content); const sunindextype Nglob = xvec->sizeGlobal(); SUNMPI_Comm comm = xvec->comm(); realtype sum = wL2NormSquare(*xvec, *wvec); realtype gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return std::sqrt(gsum/Nglob); } realtype N_VWrmsNormMask_Cuda(N_Vector X, N_Vector W, N_Vector Id) { const vector_type *xvec = static_cast(X->content); const vector_type *wvec = static_cast(W->content); const vector_type *ivec = static_cast(Id->content); const sunindextype Nglob = xvec->sizeGlobal(); SUNMPI_Comm comm = xvec->comm(); realtype sum = wL2NormSquareMask(*xvec, *wvec, *ivec); realtype gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return std::sqrt(gsum/Nglob); } realtype N_VMin_Cuda(N_Vector X) { const vector_type *xvec = static_cast(X->content); SUNMPI_Comm comm = xvec->comm(); realtype locmin = findMin(*xvec); realtype globmin = SUNMPI_Allreduce_scalar(locmin, 3, comm); return globmin; } realtype N_VWL2Norm_Cuda(N_Vector X, N_Vector W) { const vector_type *xvec = static_cast(X->content); const vector_type *wvec = static_cast(W->content); SUNMPI_Comm comm = xvec->comm(); realtype sum = wL2NormSquare(*xvec, *wvec); realtype gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return std::sqrt(gsum); } realtype N_VL1Norm_Cuda(N_Vector X) { const vector_type *xvec = static_cast(X->content); SUNMPI_Comm comm = xvec->comm(); realtype sum = L1Norm(*xvec); realtype gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return gsum; } void N_VCompare_Cuda(realtype c, N_Vector X, N_Vector Z) { const vector_type *xvec = static_cast(X->content); vector_type *zvec = static_cast(Z->content); compare(c, *xvec, *zvec); } booleantype N_VInvTest_Cuda(N_Vector X, N_Vector Z) { const vector_type *xvec = static_cast(X->content); vector_type *zvec = static_cast(Z->content); SUNMPI_Comm comm = xvec->comm(); realtype locmin = invTest(*xvec, *zvec); realtype globmin = SUNMPI_Allreduce_scalar(locmin, 3, comm); return (globmin < HALF); } /* * Creates mask for variables violating constraints */ booleantype N_VConstrMask_Cuda(N_Vector C, N_Vector X, N_Vector M) { const vector_type *cvec = static_cast(C->content); const vector_type *xvec = static_cast(X->content); vector_type *mvec = static_cast(M->content); SUNMPI_Comm comm = xvec->comm(); realtype locsum = constrMask(*cvec, *xvec, *mvec); realtype globsum = SUNMPI_Allreduce_scalar(locsum, 1, comm); return (globsum < HALF); } realtype N_VMinQuotient_Cuda(N_Vector num, N_Vector denom) { const vector_type *numvec = static_cast(num->content); const vector_type *denvec = static_cast(denom->content); SUNMPI_Comm comm = numvec->comm(); realtype locmin = minQuotient(*numvec, *denvec); realtype globmin = SUNMPI_Allreduce_scalar(locmin, 3, comm); return globmin; } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_Cuda(int nvec, realtype* c, N_Vector* X, N_Vector Z) { cudaError_t err; vector_type** Xv; vector_type* Zv; Zv = static_cast(Z->content); Xv = new vector_type*[nvec]; for (int i=0; i(X[i]->content); err = linearCombination(nvec, c, Xv, Zv); delete[] Xv; return err == cudaSuccess ? 0 : -1; } int N_VScaleAddMulti_Cuda(int nvec, realtype* c, N_Vector X, N_Vector* Y, N_Vector* Z) { cudaError_t err; vector_type* Xv; vector_type** Yv; vector_type** Zv; Xv = static_cast(X->content); Yv = new vector_type*[nvec]; for (int i=0; i(Y[i]->content); Zv = new vector_type*[nvec]; for (int i=0; i(Z[i]->content); err = scaleAddMulti(nvec, c, Xv, Yv, Zv); delete[] Yv; delete[] Zv; return err == cudaSuccess ? 0 : -1; } int N_VDotProdMulti_Cuda(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods) { cudaError_t err; SUNMPI_Comm comm; vector_type* Xv; vector_type** Yv; Xv = static_cast(x->content); comm = Xv->comm(); Yv = new vector_type*[nvec]; for (int i=0; i(Y[i]->content); err = dotProdMulti(nvec, Xv, Yv, dotprods); delete[] Yv; SUNMPI_Allreduce(dotprods, nvec, 1, comm); return err == cudaSuccess ? 0 : -1; } /* * ----------------------------------------------------------------------------- * vector array operations * ----------------------------------------------------------------------------- */ int N_VLinearSumVectorArray_Cuda(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z) { cudaError_t err; vector_type** Xv; vector_type** Yv; vector_type** Zv; Xv = new vector_type*[nvec]; for (int i=0; i(X[i]->content); Yv = new vector_type*[nvec]; for (int i=0; i(Y[i]->content); Zv = new vector_type*[nvec]; for (int i=0; i(Z[i]->content); err = linearSumVectorArray(nvec, a, Xv, b, Yv, Zv); delete[] Xv; delete[] Yv; delete[] Zv; return err == cudaSuccess ? 0 : -1; } int N_VScaleVectorArray_Cuda(int nvec, realtype* c, N_Vector* X, N_Vector* Z) { cudaError_t err; vector_type** Xv; vector_type** Zv; Xv = new vector_type*[nvec]; for (int i=0; i(X[i]->content); Zv = new vector_type*[nvec]; for (int i=0; i(Z[i]->content); err = scaleVectorArray(nvec, c, Xv, Zv); delete[] Xv; delete[] Zv; return err == cudaSuccess ? 0 : -1; } int N_VConstVectorArray_Cuda(int nvec, realtype c, N_Vector* Z) { cudaError_t err; vector_type** Zv; Zv = new vector_type*[nvec]; for (int i=0; i(Z[i]->content); err = constVectorArray(nvec, c, Zv); delete[] Zv; return err == cudaSuccess ? 0 : -1; } int N_VWrmsNormVectorArray_Cuda(int nvec, N_Vector* X, N_Vector* W, realtype* norms) { cudaError_t err; const vector_type* xvec = static_cast(X[0]->content); vector_type** Xv; vector_type** Wv; SUNMPI_Comm comm = xvec->comm(); sunindextype N = xvec->sizeGlobal(); Xv = new vector_type*[nvec]; for (int k=0; k(X[k]->content); Wv = new vector_type*[nvec]; for (int k=0; k(W[k]->content); err = wL2NormSquareVectorArray(nvec, Xv, Wv, norms); delete[] Xv; delete[] Wv; SUNMPI_Allreduce(norms, nvec, 1, comm); for (int k=0; k(X[0]->content); vector_type** Xv; vector_type** Wv; vector_type* IDv; SUNMPI_Comm comm = xvec->comm(); sunindextype N = xvec->sizeGlobal(); Xv = new vector_type*[nvec]; for (int k=0; k(X[k]->content); Wv = new vector_type*[nvec]; for (int k=0; k(W[k]->content); IDv = static_cast(id->content); err = wL2NormSquareMaskVectorArray(nvec, Xv, Wv, IDv, norms); delete[] Xv; delete[] Wv; SUNMPI_Allreduce(norms, nvec, 1, comm); for (int k=0; k(X[k]->content); Yv = new vector_type*[nsum*nvec]; for (int k=0; k(Y[j][k]->content); Zv = new vector_type*[nsum*nvec]; for (int k=0; k(Z[j][k]->content); err = scaleAddMultiVectorArray(nvec, nsum, c, Xv, Yv, Zv); delete[] Xv; delete[] Yv; delete[] Zv; return err == cudaSuccess ? 0 : -1; } int N_VLinearCombinationVectorArray_Cuda(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z) { cudaError_t err; vector_type** Xv; vector_type** Zv; Xv = new vector_type*[nsum*nvec]; for (int k=0; k(X[j][k]->content); Zv = new vector_type*[nvec]; for (int k=0; k(Z[k]->content); err = linearCombinationVectorArray(nvec, nsum, c, Xv, Zv); delete[] Xv; delete[] Zv; return err == cudaSuccess ? 0 : -1; } /* * ----------------------------------------------------------------- * Enable / Disable fused and vector array operations * ----------------------------------------------------------------- */ int N_VEnableFusedOps_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_Cuda; v->ops->nvscaleaddmulti = N_VScaleAddMulti_Cuda; v->ops->nvdotprodmulti = N_VDotProdMulti_Cuda; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Cuda; v->ops->nvscalevectorarray = N_VScaleVectorArray_Cuda; v->ops->nvconstvectorarray = N_VConstVectorArray_Cuda; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Cuda; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Cuda; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Cuda; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Cuda; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_Cuda; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_Cuda; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_Cuda; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Cuda; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_Cuda; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_Cuda; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Cuda; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Cuda; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Cuda; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_Cuda(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Cuda; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } } // extern "C" StanHeaders/src/nvector/parallel/0000755000176200001440000000000013766554135016535 5ustar liggesusersStanHeaders/src/nvector/parallel/fnvector_parallel.c0000644000176200001440000001054213766554457022414 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_parallel.h) contains the * implementation needed for the Fortran initialization of parallel * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fnvector_parallel.h" /* Define global vector variables */ N_Vector F2C_CVODE_vec; N_Vector F2C_CVODE_vecQ; N_Vector *F2C_CVODE_vecS; N_Vector F2C_CVODE_vecB; N_Vector F2C_CVODE_vecQB; N_Vector F2C_IDA_vec; N_Vector F2C_IDA_vecQ; N_Vector *F2C_IDA_vecS; N_Vector F2C_IDA_vecB; N_Vector F2C_IDA_vecQB; N_Vector F2C_KINSOL_vec; N_Vector F2C_ARKODE_vec; #ifndef SUNDIALS_MPI_COMM_F2C #define MPI_Fint int #endif /* Fortran callable interfaces */ void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vec = NULL; F2C_CVODE_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_CVODE_vec == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vec = NULL; F2C_IDA_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_IDA_vec == NULL) *ier = -1; break; case FCMIX_KINSOL: F2C_KINSOL_vec = NULL; F2C_KINSOL_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_KINSOL_vec == NULL) *ier = -1; break; case FCMIX_ARKODE: F2C_ARKODE_vec = NULL; F2C_ARKODE_vec = N_VNewEmpty_Parallel(F2C_comm, *L, *N); if (F2C_ARKODE_vec == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQ = NULL; F2C_CVODE_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); if (F2C_CVODE_vecQ == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQ = NULL; F2C_IDA_vecQ = N_VNewEmpty_Parallel(F2C_comm, *Lq, *Nq); if (F2C_IDA_vecQ == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecB = NULL; F2C_CVODE_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); if (F2C_CVODE_vecB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecB = NULL; F2C_IDA_vecB = N_VNewEmpty_Parallel(F2C_comm, *LB, *NB); if (F2C_IDA_vecB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier) { MPI_Comm F2C_comm; #ifdef SUNDIALS_MPI_COMM_F2C F2C_comm = MPI_Comm_f2c(*comm); #else F2C_comm = MPI_COMM_WORLD; #endif *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQB = NULL; F2C_CVODE_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); if (F2C_CVODE_vecQB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQB = NULL; F2C_IDA_vecQB = N_VNewEmpty_Parallel(F2C_comm, *LqB, *NqB); if (F2C_IDA_vecQB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITP_S(int *code, int *Ns, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecS = NULL; F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_CVODE_vec); if (F2C_CVODE_vecS == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecS = NULL; F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Parallel(*Ns, F2C_IDA_vec); if (F2C_IDA_vecS == NULL) *ier = -1; break; default: *ier = -1; } } StanHeaders/src/nvector/parallel/fnvector_parallel.h0000644000176200001440000000551213766554457022422 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_parallel.c) contains the * definitions needed for the initialization of parallel * vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_PARALLEL_H #define _FNVECTOR_PARALLEL_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FNV_INITP SUNDIALS_F77_FUNC(fnvinitp, FNVINITP) #else #define FNV_INITP fnvinitp_ #endif #if defined(SUNDIALS_F77_FUNC_) #define FNV_INITP_Q SUNDIALS_F77_FUNC_(fnvinitp_q, FNVINITP_Q) #define FNV_INITP_S SUNDIALS_F77_FUNC_(fnvinitp_s, FNVINITP_S) #define FNV_INITP_B SUNDIALS_F77_FUNC_(fnvinitp_b, FNVINITP_B) #define FNV_INITP_QB SUNDIALS_F77_FUNC_(fnvinitp_qb, FNVINITP_QB) #else #define FNV_INITP_Q fnvinitp_q_ #define FNV_INITP_S fnvinitp_s_ #define FNV_INITP_B fnvinitp_b_ #define FNV_INITP_QB fnvinitp_qb_ #endif /* Declarations of global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_CVODE_vecQ; extern N_Vector *F2C_CVODE_vecS; extern N_Vector F2C_CVODE_vecB; extern N_Vector F2C_CVODE_vecQB; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_IDA_vecQ; extern N_Vector *F2C_IDA_vecS; extern N_Vector F2C_IDA_vecB; extern N_Vector F2C_IDA_vecQB; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* * Prototypes of exported functions * * FNV_INITP - initializes parallel vector operations for main problem * FNV_INITP_Q - initializes parallel vector operations for quadratures * FNV_INITP_S - initializes parallel vector operations for sensitivities * FNV_INITP_B - initializes parallel vector operations for adjoint problem * FNV_INITP_QB - initializes parallel vector operations for adjoint quadratures * */ #ifndef SUNDIALS_MPI_COMM_F2C #define MPI_Fint int #endif void FNV_INITP(MPI_Fint *comm, int *code, long int *L, long int *N, int *ier); void FNV_INITP_Q(MPI_Fint *comm, int *code, long int *Lq, long int *Nq, int *ier); void FNV_INITP_B(MPI_Fint *comm, int *code, long int *LB, long int *NB, int *ier); void FNV_INITP_QB(MPI_Fint *comm, int *code, long int *LqB, long int *NqB, int *ier); void FNV_INITP_S(int *code, int *Ns, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/nvector/parallel/nvector_parallel.c0000644000176200001440000014461613766554457022260 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a parallel MPI implementation * of the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Private functions for special cases of vector operations */ static void VCopy_Parallel(N_Vector x, N_Vector z); /* z=x */ static void VSum_Parallel(N_Vector x, N_Vector y, N_Vector z); /* z=x+y */ static void VDiff_Parallel(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VNeg_Parallel(N_Vector x, N_Vector z); /* z=-x */ static void VScaleSum_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x+y) */ static void VScaleDiff_Parallel(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VLin1_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin2_Parallel(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void Vaxpy_Parallel(realtype a, N_Vector x, N_Vector y); /* y <- ax+y */ static void VScaleBy_Parallel(realtype a, N_Vector x); /* x <- ax */ /* Private functions for special cases of vector array operations */ static int VSumVectorArray_Parallel(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X+Y */ static int VDiffVectorArray_Parallel(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X-Y */ static int VScaleSumVectorArray_Parallel(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X+Y) */ static int VScaleDiffVectorArray_Parallel(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X-Y) */ static int VLin1VectorArray_Parallel(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX+Y */ static int VLin2VectorArray_Parallel(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX-Y */ static int VaxpyVectorArray_Parallel(int nvec, realtype a, N_Vector* X, N_Vector* Y); /* Y <- aX+Y */ /* Error Message */ #define BAD_N1 "N_VNew_Parallel -- Sum of local vector lengths differs from " #define BAD_N2 "input global length. \n\n" #define BAD_N BAD_N1 BAD_N2 /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Parallel(N_Vector v) { return SUNDIALS_NVEC_PARALLEL; } /* ---------------------------------------------------------------- * Function to create a new parallel vector with empty data array */ N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Parallel content; sunindextype n, Nsum; /* Compute global length as sum of local lengths */ n = local_length; MPI_Allreduce(&n, &Nsum, 1, PVEC_INTEGER_MPI_TYPE, MPI_SUM, comm); if (Nsum != global_length) { STAN_SUNDIALS_FPRINTF(stderr, BAD_N); return(NULL); } /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Parallel; ops->nvclone = N_VClone_Parallel; ops->nvcloneempty = N_VCloneEmpty_Parallel; ops->nvdestroy = N_VDestroy_Parallel; ops->nvspace = N_VSpace_Parallel; ops->nvgetarraypointer = N_VGetArrayPointer_Parallel; ops->nvsetarraypointer = N_VSetArrayPointer_Parallel; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_Parallel; ops->nvconst = N_VConst_Parallel; ops->nvprod = N_VProd_Parallel; ops->nvdiv = N_VDiv_Parallel; ops->nvscale = N_VScale_Parallel; ops->nvabs = N_VAbs_Parallel; ops->nvinv = N_VInv_Parallel; ops->nvaddconst = N_VAddConst_Parallel; ops->nvdotprod = N_VDotProd_Parallel; ops->nvmaxnorm = N_VMaxNorm_Parallel; ops->nvwrmsnormmask = N_VWrmsNormMask_Parallel; ops->nvwrmsnorm = N_VWrmsNorm_Parallel; ops->nvmin = N_VMin_Parallel; ops->nvwl2norm = N_VWL2Norm_Parallel; ops->nvl1norm = N_VL1Norm_Parallel; ops->nvcompare = N_VCompare_Parallel; ops->nvinvtest = N_VInvTest_Parallel; ops->nvconstrmask = N_VConstrMask_Parallel; ops->nvminquotient = N_VMinQuotient_Parallel; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = local_length; content->global_length = global_length; content->comm = comm; content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------- * Function to create a new parallel vector */ N_Vector N_VNew_Parallel(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; realtype *data; v = NULL; v = N_VNewEmpty_Parallel(comm, local_length, global_length); if (v == NULL) return(NULL); /* Create data */ if(local_length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(local_length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } /* Attach data */ NV_OWN_DATA_P(v) = SUNTRUE; NV_DATA_P(v) = data; } return(v); } /* ---------------------------------------------------------------- * Function to create a parallel N_Vector with user data component */ N_Vector N_VMake_Parallel(MPI_Comm comm, sunindextype local_length, sunindextype global_length, realtype *v_data) { N_Vector v; v = NULL; v = N_VNewEmpty_Parallel(comm, local_length, global_length); if (v == NULL) return(NULL); if (local_length > 0) { /* Attach data */ NV_OWN_DATA_P(v) = SUNFALSE; NV_DATA_P(v) = v_data; } return(v); } /* ---------------------------------------------------------------- * Function to create an array of new parallel vectors. */ N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_Parallel(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Parallel(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to create an array of new parallel vectors with empty * (NULL) data array. */ N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_Parallel(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Parallel(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_Parallel */ void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_Parallel(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------- * Function to return global vector length */ sunindextype N_VGetLength_Parallel(N_Vector v) { return NV_GLOBLENGTH_P(v); } /* ---------------------------------------------------------------- * Function to return local vector length */ sunindextype N_VGetLocalLength_Parallel(N_Vector v) { return NV_LOCLENGTH_P(v); } /* ---------------------------------------------------------------- * Function to print the local data in a parallel vector to stdout */ void N_VPrint_Parallel(N_Vector x) { N_VPrintFile_Parallel(x, stdout); } /* ---------------------------------------------------------------- * Function to print the local data in a parallel vector to outfile */ void N_VPrintFile_Parallel(N_Vector x, FILE* outfile) { sunindextype i, N; realtype *xd; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%g\n", xd[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%g\n", xd[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Parallel(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Parallel content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_Parallel) malloc(sizeof(struct _N_VectorContent_Parallel)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = NV_LOCLENGTH_P(w); content->global_length = NV_GLOBLENGTH_P(w); content->comm = NV_COMM_P(w); content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } N_Vector N_VClone_Parallel(N_Vector w) { N_Vector v; realtype *data; sunindextype local_length; v = NULL; v = N_VCloneEmpty_Parallel(w); if (v == NULL) return(NULL); local_length = NV_LOCLENGTH_P(w); /* Create data */ if(local_length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(local_length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Parallel(v); return(NULL); } /* Attach data */ NV_OWN_DATA_P(v) = SUNTRUE; NV_DATA_P(v) = data; } return(v); } void N_VDestroy_Parallel(N_Vector v) { if ((NV_OWN_DATA_P(v) == SUNTRUE) && (NV_DATA_P(v) != NULL)) { free(NV_DATA_P(v)); NV_DATA_P(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Parallel(N_Vector v, sunindextype *lrw, sunindextype *liw) { MPI_Comm comm; int npes; comm = NV_COMM_P(v); MPI_Comm_size(comm, &npes); *lrw = NV_GLOBLENGTH_P(v); *liw = 2*npes; return; } realtype *N_VGetArrayPointer_Parallel(N_Vector v) { return((realtype *) NV_DATA_P(v)); } void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v) { if (NV_LOCLENGTH_P(v) > 0) NV_DATA_P(v) = v_data; return; } void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { sunindextype i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; xd = yd = zd = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_Parallel(a, x, y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_Parallel(b, y, x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_Parallel(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_Parallel(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_Parallel(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_Parallel(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_Parallel(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_Parallel(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+(b*yd[i]); return; } void N_VConst_Parallel(realtype c, N_Vector z) { sunindextype i, N; realtype *zd; zd = NULL; N = NV_LOCLENGTH_P(z); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = c; return; } void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]*yd[i]; return; } void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]/yd[i]; return; } void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_Parallel(c, x); return; } if (c == ONE) { VCopy_Parallel(x, z); } else if (c == -ONE) { VNeg_Parallel(x, z); } else { N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = c*xd[i]; } return; } void N_VAbs_Parallel(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = SUNRabs(xd[i]); return; } void N_VInv_Parallel(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = ONE/xd[i]; return; } void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); for (i = 0; i < N; i++) zd[i] = xd[i]+b; return; } realtype N_VDotProd_Parallel(N_Vector x, N_Vector y) { sunindextype i, N; realtype sum, *xd, *yd, gsum; MPI_Comm comm; sum = ZERO; xd = yd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); yd = NV_DATA_P(y); comm = NV_COMM_P(x); for (i = 0; i < N; i++) sum += xd[i]*yd[i]; gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(gsum); } realtype N_VMaxNorm_Parallel(N_Vector x) { sunindextype i, N; realtype max, *xd, gmax; MPI_Comm comm; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); comm = NV_COMM_P(x); max = ZERO; for (i = 0; i < N; i++) { if (SUNRabs(xd[i]) > max) max = SUNRabs(xd[i]); } gmax = SUNMPI_Allreduce_scalar(max, 2, comm); return(gmax); } realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w) { sunindextype i, N, N_global; realtype sum, prodi, *xd, *wd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = NULL; N = NV_LOCLENGTH_P(x); N_global = NV_GLOBLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); comm = NV_COMM_P(x); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(SUNRsqrt(gsum/N_global)); } realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id) { sunindextype i, N, N_global; realtype sum, prodi, *xd, *wd, *idd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = idd = NULL; N = NV_LOCLENGTH_P(x); N_global = NV_GLOBLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); idd = NV_DATA_P(id); comm = NV_COMM_P(x); for (i = 0; i < N; i++) { if (idd[i] > ZERO) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } } gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(SUNRsqrt(gsum/N_global)); } realtype N_VMin_Parallel(N_Vector x) { sunindextype i, N; realtype min, *xd, gmin; MPI_Comm comm; xd = NULL; N = NV_LOCLENGTH_P(x); comm = NV_COMM_P(x); min = BIG_REAL; if (N > 0) { xd = NV_DATA_P(x); min = xd[0]; for (i = 1; i < N; i++) { if (xd[i] < min) min = xd[i]; } } gmin = SUNMPI_Allreduce_scalar(min, 3, comm); return(gmin); } realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, prodi, *xd, *wd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); wd = NV_DATA_P(w); comm = NV_COMM_P(x); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(SUNRsqrt(gsum)); } realtype N_VL1Norm_Parallel(N_Vector x) { sunindextype i, N; realtype sum, gsum, *xd; MPI_Comm comm; sum = ZERO; xd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); comm = NV_COMM_P(x); for (i = 0; i= c) ? ONE : ZERO; } return; } booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd, val, gval; MPI_Comm comm; xd = zd = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); zd = NV_DATA_P(z); comm = NV_COMM_P(x); val = ONE; for (i = 0; i < N; i++) { if (xd[i] == ZERO) val = ZERO; else zd[i] = ONE/xd[i]; } gval = SUNMPI_Allreduce_scalar(val, 3, comm); if (gval == ZERO) return(SUNFALSE); else return(SUNTRUE); } booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m) { sunindextype i, N; realtype temp; realtype *cd, *xd, *md; booleantype test; MPI_Comm comm; cd = xd = md = NULL; N = NV_LOCLENGTH_P(x); xd = NV_DATA_P(x); cd = NV_DATA_P(c); md = NV_DATA_P(m); comm = NV_COMM_P(x); temp = ZERO; for (i = 0; i < N; i++) { md[i] = ZERO; /* Continue if no constraints were set for the variable */ if (cd[i] == ZERO) continue; /* Check if a set constraint has been violated */ test = (SUNRabs(cd[i]) > ONEPT5 && xd[i]*cd[i] <= ZERO) || (SUNRabs(cd[i]) > HALF && xd[i]*cd[i] < ZERO); if (test) { temp = md[i] = ONE; } } /* Find max temp across all MPI ranks */ temp = SUNMPI_Allreduce_scalar(temp, 2, comm); /* Return false if any constraint was violated */ return (temp == ONE) ? SUNFALSE : SUNTRUE; } realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom) { booleantype notEvenOnce; sunindextype i, N; realtype *nd, *dd, min; MPI_Comm comm; nd = dd = NULL; N = NV_LOCLENGTH_P(num); nd = NV_DATA_P(num); dd = NV_DATA_P(denom); comm = NV_COMM_P(num); notEvenOnce = SUNTRUE; min = BIG_REAL; for (i = 0; i < N; i++) { if (dd[i] == ZERO) continue; else { if (!notEvenOnce) min = SUNMIN(min, nd[i]/dd[i]); else { min = nd[i]/dd[i]; notEvenOnce = SUNFALSE; } } } return(SUNMPI_Allreduce_scalar(min, 3, comm)); } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_Parallel(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i; sunindextype j, N; realtype* zd=NULL; realtype* xd=NULL; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_Parallel(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_Parallel(c[0], X[0], c[1], X[1], z); return(0); } /* get vector length and data array */ N = NV_LOCLENGTH_P(z); zd = NV_DATA_P(z); /* * X[0] += c[i]*X[i], i = 1,...,nvec-1 */ if ((X[0] == z) && (c[0] == ONE)) { for (i=1; i ZERO) nrm[i] += SUNSQR(xd[j] * wd[j]); } } SUNMPI_Allreduce(nrm, nvec, 1, comm); for (i=0; i 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_Parallel(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length */ N = NV_LOCLENGTH_P(X[0]); /* * Y[i][j] += a[i] * x[j] */ if (Y == Z) { for (i=0; i 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_Parallel; v->ops->nvscaleaddmulti = N_VScaleAddMulti_Parallel; v->ops->nvdotprodmulti = N_VDotProdMulti_Parallel; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Parallel; v->ops->nvscalevectorarray = N_VScaleVectorArray_Parallel; v->ops->nvconstvectorarray = N_VConstVectorArray_Parallel; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Parallel; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Parallel; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Parallel; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Parallel; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_Parallel; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_Parallel; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_Parallel; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Parallel; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_Parallel; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_Parallel; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Parallel; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Parallel; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Parallel; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_Parallel(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Parallel; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/nvector/trilinos/0000755000176200001440000000000013766554135016604 5ustar liggesusersStanHeaders/src/nvector/trilinos/nvector_trilinos.cpp0000644000176200001440000003500313766554457022723 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * * Based on N_Vector_Parallel by Scott D. Cohen, Alan C. Hindmarsh, * Radu Serban, and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a Trilinos implementation * of the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* * ----------------------------------------------------------------- * using statements * ----------------------------------------------------------------- */ using Teuchos::Comm; using Teuchos::RCP; using Teuchos::rcp; using Teuchos::outArg; using Teuchos::REDUCE_SUM; using Teuchos::reduceAll; /* * ----------------------------------------------------------------- * type definitions * ----------------------------------------------------------------- */ typedef Sundials::TpetraVectorInterface::vector_type vector_type; /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Trilinos(N_Vector v) { return SUNDIALS_NVEC_TRILINOS; } /* ---------------------------------------------------------------- * Function to create a new Trilinos vector with empty data array */ N_Vector N_VNewEmpty_Trilinos() { N_Vector v; N_Vector_Ops ops; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Trilinos; ops->nvclone = N_VClone_Trilinos; ops->nvcloneempty = N_VCloneEmpty_Trilinos; ops->nvdestroy = N_VDestroy_Trilinos; ops->nvspace = N_VSpace_Trilinos; ops->nvgetarraypointer = NULL; ops->nvsetarraypointer = NULL; ops->nvlinearsum = N_VLinearSum_Trilinos; ops->nvconst = N_VConst_Trilinos; ops->nvprod = N_VProd_Trilinos; ops->nvdiv = N_VDiv_Trilinos; ops->nvscale = N_VScale_Trilinos; ops->nvabs = N_VAbs_Trilinos; ops->nvinv = N_VInv_Trilinos; ops->nvaddconst = N_VAddConst_Trilinos; ops->nvdotprod = N_VDotProd_Trilinos; ops->nvmaxnorm = N_VMaxNorm_Trilinos; ops->nvwrmsnorm = N_VWrmsNorm_Trilinos; ops->nvwrmsnormmask = N_VWrmsNormMask_Trilinos; ops->nvmin = N_VMin_Trilinos; ops->nvwl2norm = N_VWL2Norm_Trilinos; ops->nvl1norm = N_VL1Norm_Trilinos; ops->nvcompare = N_VCompare_Trilinos; ops->nvinvtest = N_VInvTest_Trilinos; ops->nvconstrmask = N_VConstrMask_Trilinos; ops->nvminquotient = N_VMinQuotient_Trilinos; /* fused vector operations */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Attach ops and set content to NULL */ v->content = NULL; v->ops = ops; return(v); } /* ---------------------------------------------------------------- * Function to create an N_Vector attachment to Tpetra vector. * void* argument is to allow for calling this method from C code. * */ N_Vector N_VMake_Trilinos(Teuchos::RCP vec) { N_Vector v = NULL; // Create an N_Vector with operators attached and empty content v = N_VNewEmpty_Trilinos(); if (v == NULL) return(NULL); // Create vector content using a pointer to Tpetra vector v->content = new Sundials::TpetraVectorInterface(vec); if (v->content == NULL) { free(v->ops); free(v); return NULL; } return(v); } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Trilinos(N_Vector w) { N_Vector v; N_Vector_Ops ops; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Attach ops and set content to NULL */ v->content = NULL; v->ops = ops; return(v); } N_Vector N_VClone_Trilinos(N_Vector w) { N_Vector v = N_VCloneEmpty_Trilinos(w); if (v == NULL) return(NULL); // Get raw pointer to Tpetra vector Teuchos::RCP wvec = N_VGetVector_Trilinos(w); // Clone wvec and get raw pointer to the clone Teuchos::RCP tvec = Teuchos::rcp(new vector_type(*wvec, Teuchos::Copy)); // Create vector content using the raw pointer to the cloned Tpetra vector v->content = new Sundials::TpetraVectorInterface(tvec); if (v->content == NULL) { free(v->ops); free(v); return NULL; } return(v); } void N_VDestroy_Trilinos(N_Vector v) { if(v->content != NULL) { Sundials::TpetraVectorInterface* iface = reinterpret_cast(v->content); // iface was created with 'new', so use 'delete' to destroy it. delete iface; v->content = NULL; } free(v->ops); v->ops = NULL; free(v); v = NULL; } void N_VSpace_Trilinos(N_Vector x, sunindextype *lrw, sunindextype *liw) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); const Teuchos::RCP >& comm = xv->getMap()->getComm(); int npes = comm->getSize(); *lrw = xv->getGlobalLength(); *liw = 2*npes; } /* * Linear combination of two vectors: z = a*x + b*y */ void N_VLinearSum_Trilinos(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP yv = N_VGetVector_Trilinos(y); Teuchos::RCP zv = N_VGetVector_Trilinos(z); if (x == z) { zv->update(b, *yv, a); } else if (y == z) { zv->update(a, *xv, b); } else { zv->update(a, *xv, b, *yv, ZERO); } } /* * Set all vector elements to a constant: z[i] = c */ void N_VConst_Trilinos(realtype c, N_Vector z) { using namespace Sundials; Teuchos::RCP zv = N_VGetVector_Trilinos(z); zv->putScalar(c); } /* * Elementwise multiply vectors: z[i] = x[i]*y[i] */ void N_VProd_Trilinos(N_Vector x, N_Vector y, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP yv = N_VGetVector_Trilinos(y); Teuchos::RCP zv = N_VGetVector_Trilinos(z); zv->elementWiseMultiply(ONE, *xv, *yv, ZERO); } /* * Elementwise divide vectors: z[i] = x[i]/y[i] */ void N_VDiv_Trilinos(N_Vector x, N_Vector y, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP yv = N_VGetVector_Trilinos(y); Teuchos::RCP zv = N_VGetVector_Trilinos(z); TpetraVector::elementWiseDivide(*xv, *yv, *zv); } /* * Scale vector: z = c*x */ void N_VScale_Trilinos(realtype c, N_Vector x, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP zv = N_VGetVector_Trilinos(z); zv->scale(c, *xv); } /* * Elementwise absolute value: z[i] = |x[i]| */ void N_VAbs_Trilinos(N_Vector x, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP zv = N_VGetVector_Trilinos(z); zv->abs(*xv); } /* * Elementwise inverse: z[i] = 1/x[i] */ void N_VInv_Trilinos(N_Vector x, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP zv = N_VGetVector_Trilinos(z); zv->reciprocal(*xv); } /* * Add constant: z = x + b */ void N_VAddConst_Trilinos(N_Vector x, realtype b, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP zv = N_VGetVector_Trilinos(z); TpetraVector::addConst(*xv, b, *zv); } /* * Scalar product of vectors x and y */ realtype N_VDotProd_Trilinos(N_Vector x, N_Vector y) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP yv = N_VGetVector_Trilinos(y); return xv->dot(*yv); } /* * Max norm (L infinity) of vector x */ realtype N_VMaxNorm_Trilinos(N_Vector x) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); return xv->normInf(); } /* * Weighted RMS norm */ realtype N_VWrmsNorm_Trilinos(N_Vector x, N_Vector w) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP wv = N_VGetVector_Trilinos(w); return TpetraVector::normWrms(*xv, *wv); } /* * Masked weighted RMS norm */ realtype N_VWrmsNormMask_Trilinos(N_Vector x, N_Vector w, N_Vector id) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP wv = N_VGetVector_Trilinos(w); Teuchos::RCP idv = N_VGetVector_Trilinos(id); return TpetraVector::normWrmsMask(*xv, *wv, *idv); } /* * Returns minimum vector element */ realtype N_VMin_Trilinos(N_Vector x) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); return TpetraVector::minElement(*xv); } /* * Weighted L2 norm */ realtype N_VWL2Norm_Trilinos(N_Vector x, N_Vector w) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP wv = N_VGetVector_Trilinos(w); return TpetraVector::normWL2(*xv, *wv); } /* * L1 norm */ realtype N_VL1Norm_Trilinos(N_Vector x) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); return xv->norm1(); } /* * Elementwise z[i] = |x[i]| >= c ? 1 : 0 */ void N_VCompare_Trilinos(realtype c, N_Vector x, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP zv = N_VGetVector_Trilinos(z); TpetraVector::compare(c, *xv, *zv); } /* * Elementwise inverse with zero checking: z[i] = 1/x[i], x[i] != 0 */ booleantype N_VInvTest_Trilinos(N_Vector x, N_Vector z) { using namespace Sundials; Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP zv = N_VGetVector_Trilinos(z); return TpetraVector::invTest(*xv, *zv) ? SUNTRUE : SUNFALSE; } /* * Checks constraint violations for vector x. Constraints are defined in * vector c, and constrain violation flags are stored in vector m. */ booleantype N_VConstrMask_Trilinos(N_Vector c, N_Vector x, N_Vector m) { using namespace Sundials; Teuchos::RCP cv = N_VGetVector_Trilinos(c); Teuchos::RCP xv = N_VGetVector_Trilinos(x); Teuchos::RCP mv = N_VGetVector_Trilinos(m); return TpetraVector::constraintMask(*cv, *xv, *mv) ? SUNTRUE : SUNFALSE; } /* * Find minimum quotient: minq = min ( num[i]/denom[i]), denom[i] != 0. */ realtype N_VMinQuotient_Trilinos(N_Vector num, N_Vector denom) { using namespace Sundials; Teuchos::RCP numv = N_VGetVector_Trilinos(num); Teuchos::RCP denv = N_VGetVector_Trilinos(denom); return TpetraVector::minQuotient(*numv, *denv); } StanHeaders/src/nvector/serial/0000755000176200001440000000000013766554456016226 5ustar liggesusersStanHeaders/src/nvector/serial/fnvector_serial.c0000644000176200001440000000677413766554457021576 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_serial.h) contains the * implementation needed for the Fortran initialization of serial * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fnvector_serial.h" /* Define global vector variables */ N_Vector F2C_CVODE_vec; N_Vector F2C_CVODE_vecQ; N_Vector *F2C_CVODE_vecS; N_Vector F2C_CVODE_vecB; N_Vector F2C_CVODE_vecQB; N_Vector F2C_IDA_vec; N_Vector F2C_IDA_vecQ; N_Vector *F2C_IDA_vecS; N_Vector F2C_IDA_vecB; N_Vector F2C_IDA_vecQB; N_Vector F2C_KINSOL_vec; N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FNV_INITS(int *code, long int *N, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vec = NULL; F2C_CVODE_vec = N_VNewEmpty_Serial(*N); if (F2C_CVODE_vec == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vec = NULL; F2C_IDA_vec = N_VNewEmpty_Serial(*N); if (F2C_IDA_vec == NULL) *ier = -1; break; case FCMIX_KINSOL: F2C_KINSOL_vec = NULL; F2C_KINSOL_vec = N_VNewEmpty_Serial(*N); if (F2C_KINSOL_vec == NULL) *ier = -1; break; case FCMIX_ARKODE: F2C_ARKODE_vec = NULL; F2C_ARKODE_vec = N_VNewEmpty_Serial(*N); if (F2C_ARKODE_vec == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_Q(int *code, long int *Nq, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQ = NULL; F2C_CVODE_vecQ = N_VNewEmpty_Serial(*Nq); if (F2C_CVODE_vecQ == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQ = NULL; F2C_IDA_vecQ = N_VNewEmpty_Serial(*Nq); if (F2C_IDA_vecQ == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_B(int *code, long int *NB, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecB = NULL; F2C_CVODE_vecB = N_VNewEmpty_Serial(*NB); if (F2C_CVODE_vecB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecB = NULL; F2C_IDA_vecB = N_VNewEmpty_Serial(*NB); if (F2C_IDA_vecB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_QB(int *code, long int *NqB, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQB = NULL; F2C_CVODE_vecQB = N_VNewEmpty_Serial(*NqB); if (F2C_CVODE_vecQB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQB = NULL; F2C_IDA_vecQB = N_VNewEmpty_Serial(*NqB); if (F2C_IDA_vecQB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITS_S(int *code, int *Ns, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecS = NULL; F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_CVODE_vec); if (F2C_CVODE_vecS == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecS = NULL; F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Serial(*Ns, F2C_IDA_vec); if (F2C_IDA_vecS == NULL) *ier = -1; break; default: *ier = -1; } } StanHeaders/src/nvector/serial/nvector_serial.c0000644000176200001440000013564213766554457021425 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a serial implementation * of the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Private functions for special cases of vector operations */ static void VCopy_Serial(N_Vector x, N_Vector z); /* z=x */ static void VSum_Serial(N_Vector x, N_Vector y, N_Vector z); /* z=x+y */ static void VDiff_Serial(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VNeg_Serial(N_Vector x, N_Vector z); /* z=-x */ static void VScaleSum_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x+y) */ static void VScaleDiff_Serial(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VLin1_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin2_Serial(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void Vaxpy_Serial(realtype a, N_Vector x, N_Vector y); /* y <- ax+y */ static void VScaleBy_Serial(realtype a, N_Vector x); /* x <- ax */ /* Private functions for special cases of vector array operations */ static int VSumVectorArray_Serial(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X+Y */ static int VDiffVectorArray_Serial(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X-Y */ static int VScaleSumVectorArray_Serial(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X+Y) */ static int VScaleDiffVectorArray_Serial(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X-Y) */ static int VLin1VectorArray_Serial(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX+Y */ static int VLin2VectorArray_Serial(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX-Y */ static int VaxpyVectorArray_Serial(int nvec, realtype a, N_Vector* X, N_Vector* Y); /* Y <- aX+Y */ /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Serial(N_Vector v) { return SUNDIALS_NVEC_SERIAL; } /* ---------------------------------------------------------------------------- * Function to create a new empty serial vector */ N_Vector N_VNewEmpty_Serial(sunindextype length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Serial content; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Serial; ops->nvclone = N_VClone_Serial; ops->nvcloneempty = N_VCloneEmpty_Serial; ops->nvdestroy = N_VDestroy_Serial; ops->nvspace = N_VSpace_Serial; ops->nvgetarraypointer = N_VGetArrayPointer_Serial; ops->nvsetarraypointer = N_VSetArrayPointer_Serial; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_Serial; ops->nvconst = N_VConst_Serial; ops->nvprod = N_VProd_Serial; ops->nvdiv = N_VDiv_Serial; ops->nvscale = N_VScale_Serial; ops->nvabs = N_VAbs_Serial; ops->nvinv = N_VInv_Serial; ops->nvaddconst = N_VAddConst_Serial; ops->nvdotprod = N_VDotProd_Serial; ops->nvmaxnorm = N_VMaxNorm_Serial; ops->nvwrmsnormmask = N_VWrmsNormMask_Serial; ops->nvwrmsnorm = N_VWrmsNorm_Serial; ops->nvmin = N_VMin_Serial; ops->nvwl2norm = N_VWL2Norm_Serial; ops->nvl1norm = N_VL1Norm_Serial; ops->nvcompare = N_VCompare_Serial; ops->nvinvtest = N_VInvTest_Serial; ops->nvconstrmask = N_VConstrMask_Serial; ops->nvminquotient = N_VMinQuotient_Serial; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = length; content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Function to create a new serial vector */ N_Vector N_VNew_Serial(sunindextype length) { N_Vector v; realtype *data; v = NULL; v = N_VNewEmpty_Serial(length); if (v == NULL) return(NULL); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } /* Attach data */ NV_OWN_DATA_S(v) = SUNTRUE; NV_DATA_S(v) = data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create a serial N_Vector with user data component */ N_Vector N_VMake_Serial(sunindextype length, realtype *v_data) { N_Vector v; v = NULL; v = N_VNewEmpty_Serial(length); if (v == NULL) return(NULL); if (length > 0) { /* Attach data */ NV_OWN_DATA_S(v) = SUNFALSE; NV_DATA_S(v) = v_data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create an array of new serial vectors. */ N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_Serial(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Serial(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to create an array of new serial vectors with NULL data array. */ N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_Serial(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Serial(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_Serial */ void N_VDestroyVectorArray_Serial(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_Serial(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------------------- * Function to return number of vector elements */ sunindextype N_VGetLength_Serial(N_Vector v) { return NV_LENGTH_S(v); } /* ---------------------------------------------------------------------------- * Function to print the a serial vector to stdout */ void N_VPrint_Serial(N_Vector x) { N_VPrintFile_Serial(x, stdout); } /* ---------------------------------------------------------------------------- * Function to print the a serial vector to outfile */ void N_VPrintFile_Serial(N_Vector x, FILE* outfile) { sunindextype i, N; realtype *xd; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%35.32Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%19.16g\n", xd[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Serial(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Serial content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_Serial) malloc(sizeof(struct _N_VectorContent_Serial)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = NV_LENGTH_S(w); content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } N_Vector N_VClone_Serial(N_Vector w) { N_Vector v; realtype *data; sunindextype length; v = NULL; v = N_VCloneEmpty_Serial(w); if (v == NULL) return(NULL); length = NV_LENGTH_S(w); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Serial(v); return(NULL); } /* Attach data */ NV_OWN_DATA_S(v) = SUNTRUE; NV_DATA_S(v) = data; } return(v); } void N_VDestroy_Serial(N_Vector v) { if (NV_OWN_DATA_S(v) == SUNTRUE) { free(NV_DATA_S(v)); NV_DATA_S(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Serial(N_Vector v, sunindextype *lrw, sunindextype *liw) { *lrw = NV_LENGTH_S(v); *liw = 1; return; } realtype *N_VGetArrayPointer_Serial(N_Vector v) { return((realtype *) NV_DATA_S(v)); } void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v) { if (NV_LENGTH_S(v) > 0) NV_DATA_S(v) = v_data; return; } void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { sunindextype i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; xd = yd = zd = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_Serial(a,x,y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_Serial(b,y,x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_Serial(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_Serial(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_Serial(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_Serial(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_Serial(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_Serial(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+(b*yd[i]); return; } void N_VConst_Serial(realtype c, N_Vector z) { sunindextype i, N; realtype *zd; zd = NULL; N = NV_LENGTH_S(z); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = c; return; } void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]*yd[i]; return; } void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]/yd[i]; return; } void N_VScale_Serial(realtype c, N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_Serial(c, x); return; } if (c == ONE) { VCopy_Serial(x, z); } else if (c == -ONE) { VNeg_Serial(x, z); } else { N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = c*xd[i]; } return; } void N_VAbs_Serial(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = SUNRabs(xd[i]); return; } void N_VInv_Serial(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = ONE/xd[i]; return; } void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); for (i = 0; i < N; i++) zd[i] = xd[i]+b; return; } realtype N_VDotProd_Serial(N_Vector x, N_Vector y) { sunindextype i, N; realtype sum, *xd, *yd; sum = ZERO; xd = yd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); yd = NV_DATA_S(y); for (i = 0; i < N; i++) sum += xd[i]*yd[i]; return(sum); } realtype N_VMaxNorm_Serial(N_Vector x) { sunindextype i, N; realtype max, *xd; max = ZERO; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i < N; i++) { if (SUNRabs(xd[i]) > max) max = SUNRabs(xd[i]); } return(max); } realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, prodi, *xd, *wd; sum = ZERO; xd = wd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); wd = NV_DATA_S(w); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } return(SUNRsqrt(sum/N)); } realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id) { sunindextype i, N; realtype sum, prodi, *xd, *wd, *idd; sum = ZERO; xd = wd = idd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); wd = NV_DATA_S(w); idd = NV_DATA_S(id); for (i = 0; i < N; i++) { if (idd[i] > ZERO) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } } return(SUNRsqrt(sum / N)); } realtype N_VMin_Serial(N_Vector x) { sunindextype i, N; realtype min, *xd; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); min = xd[0]; for (i = 1; i < N; i++) { if (xd[i] < min) min = xd[i]; } return(min); } realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, prodi, *xd, *wd; sum = ZERO; xd = wd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); wd = NV_DATA_S(w); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } return(SUNRsqrt(sum)); } realtype N_VL1Norm_Serial(N_Vector x) { sunindextype i, N; realtype sum, *xd; sum = ZERO; xd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); for (i = 0; i= c) ? ONE : ZERO; } return; } booleantype N_VInvTest_Serial(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; booleantype no_zero_found; xd = zd = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); zd = NV_DATA_S(z); no_zero_found = SUNTRUE; for (i = 0; i < N; i++) { if (xd[i] == ZERO) no_zero_found = SUNFALSE; else zd[i] = ONE/xd[i]; } return no_zero_found; } booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m) { sunindextype i, N; realtype temp; realtype *cd, *xd, *md; booleantype test; cd = xd = md = NULL; N = NV_LENGTH_S(x); xd = NV_DATA_S(x); cd = NV_DATA_S(c); md = NV_DATA_S(m); temp = ZERO; for (i = 0; i < N; i++) { md[i] = ZERO; /* Continue if no constraints were set for the variable */ if (cd[i] == ZERO) continue; /* Check if a set constraint has been violated */ test = (SUNRabs(cd[i]) > ONEPT5 && xd[i]*cd[i] <= ZERO) || (SUNRabs(cd[i]) > HALF && xd[i]*cd[i] < ZERO); if (test) { temp = md[i] = ONE; } } /* Return false if any constraint was violated */ return (temp == ONE) ? SUNFALSE : SUNTRUE; } realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom) { booleantype notEvenOnce; sunindextype i, N; realtype *nd, *dd, min; nd = dd = NULL; N = NV_LENGTH_S(num); nd = NV_DATA_S(num); dd = NV_DATA_S(denom); notEvenOnce = SUNTRUE; min = BIG_REAL; for (i = 0; i < N; i++) { if (dd[i] == ZERO) continue; else { if (!notEvenOnce) min = SUNMIN(min, nd[i]/dd[i]); else { min = nd[i]/dd[i]; notEvenOnce = SUNFALSE; } } } return(min); } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_Serial(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i; sunindextype j, N; realtype* zd=NULL; realtype* xd=NULL; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_Serial(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_Serial(c[0], X[0], c[1], X[1], z); return(0); } /* get vector length and data array */ N = NV_LENGTH_S(z); zd = NV_DATA_S(z); /* * X[0] += c[i]*X[i], i = 1,...,nvec-1 */ if ((X[0] == z) && (c[0] == ONE)) { for (i=1; i ZERO) nrm[i] += SUNSQR(xd[j] * wd[j]); } nrm[i] = SUNRsqrt(nrm[i]/N); } return(0); } int N_VScaleAddMultiVectorArray_Serial(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z) { int i, j; sunindextype k, N; realtype* xd=NULL; realtype* yd=NULL; realtype* zd=NULL; int retval; N_Vector* YY; N_Vector* ZZ; /* invalid number of vectors */ if (nvec < 1) return(-1); if (nsum < 1) return(-1); /* --------------------------- * Special cases for nvec == 1 * --------------------------- */ if (nvec == 1) { /* should have called N_VLinearSum */ if (nsum == 1) { N_VLinearSum_Serial(a[0], X[0], ONE, Y[0][0], Z[0][0]); return(0); } /* should have called N_VScaleAddMulti */ YY = (N_Vector *) malloc(nsum * sizeof(N_Vector)); ZZ = (N_Vector *) malloc(nsum * sizeof(N_Vector)); for (j=0; j 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_Serial(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length */ N = NV_LENGTH_S(X[0]); /* * Y[i][j] += a[i] * x[j] */ if (Y == Z) { for (i=0; i 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_Serial; v->ops->nvscaleaddmulti = N_VScaleAddMulti_Serial; v->ops->nvdotprodmulti = N_VDotProdMulti_Serial; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Serial; v->ops->nvscalevectorarray = N_VScaleVectorArray_Serial; v->ops->nvconstvectorarray = N_VConstVectorArray_Serial; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Serial; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Serial; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Serial; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Serial; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_Serial; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_Serial; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_Serial; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Serial; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_Serial; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_Serial; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Serial; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Serial; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Serial; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_Serial(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Serial; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/nvector/serial/fnvector_serial.h0000644000176200001440000000520513766554457021567 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_serial.h) contains the * definitions needed for the initialization of serial * vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_SERIAL_H #define _FNVECTOR_SERIAL_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FNV_INITS SUNDIALS_F77_FUNC(fnvinits, FNVINITS) #else #define FNV_INITS fnvinits_ #endif #if defined(SUNDIALS_F77_FUNC_) #define FNV_INITS_Q SUNDIALS_F77_FUNC_(fnvinits_q, FNVINITS_Q) #define FNV_INITS_S SUNDIALS_F77_FUNC_(fnvinits_s, FNVINITS_S) #define FNV_INITS_B SUNDIALS_F77_FUNC_(fnvinits_b, FNVINITS_B) #define FNV_INITS_QB SUNDIALS_F77_FUNC_(fnvinits_qb, FNVINITS_QB) #else #define FNV_INITS_Q fnvinits_q_ #define FNV_INITS_S fnvinits_s_ #define FNV_INITS_B fnvinits_b_ #define FNV_INITS_QB fnvinits_qb_ #endif /* Declarations of global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_CVODE_vecQ; extern N_Vector *F2C_CVODE_vecS; extern N_Vector F2C_CVODE_vecB; extern N_Vector F2C_CVODE_vecQB; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_IDA_vecQ; extern N_Vector *F2C_IDA_vecS; extern N_Vector F2C_IDA_vecB; extern N_Vector F2C_IDA_vecQB; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* * Prototypes of exported functions * * FNV_INITS - initializes serial vector operations for main problem * FNV_INITS_Q - initializes serial vector operations for quadratures * FNV_INITS_S - initializes serial vector operations for sensitivities * FNV_INITS_B - initializes serial vector operations for adjoint problem * FNV_INITS_QB - initializes serial vector operations for adjoint quadratures * */ void FNV_INITS(int *code, long int *neq, int *ier); void FNV_INITS_Q(int *code, long int *Nq, int *ier); void FNV_INITS_S(int *code, int *Ns, int *ier); void FNV_INITS_B(int *code, long int *NB, int *ier); void FNV_INITS_QB(int *code, long int *NqB, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/nvector/serial/F90/0000755000176200001440000000000013766554135016556 5ustar liggesusersStanHeaders/src/nvector/serial/F90/fnvector_serial.f900000644000176200001440000004145013766554457022276 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): David J. Gardner @ LLNL ! Daniel R. Reynolds @ SMU ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS serial NVector using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fnvector_serial_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= ! ----------------------------------------------------------------- ! N_VNew_Serial ! ----------------------------------------------------------------- type(c_ptr) function FN_VNew_Serial(vec_length) & bind(C,name='N_VNew_Serial') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: vec_length end function FN_VNew_Serial ! ----------------------------------------------------------------- ! N_VNewEmpty_Serial ! ----------------------------------------------------------------- type(c_ptr) function FN_VNewEmpty_Serial(vec_length) & bind(C,name='N_VNewEmpty_Serial') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: vec_length end function FN_VNewEmpty_Serial ! ----------------------------------------------------------------- ! N_VMake_Serial ! ----------------------------------------------------------------- type(c_ptr) function FN_VMake_Serial(length, v_data) & bind(C,name='N_VMake_Serial') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: length real(c_double) :: v_data(length) end function FN_VMake_Serial ! ----------------------------------------------------------------- ! N_VCloneVectorArray_Serial: NOT INTERFACED ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- ! N_VCloneVectorArrayEmpty_Serial: NOT INTERFACED ! ----------------------------------------------------------------- ! ================================================================= ! Destructors ! ================================================================= ! ----------------------------------------------------------------- ! N_VDestroy_Serial ! ----------------------------------------------------------------- subroutine FN_VDestroy_Serial(v) & bind(C,name='N_VDestroy_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end subroutine FN_VDestroy_Serial ! ----------------------------------------------------------------- ! N_VDestroyVectorArray_Serial: NOT INTERFACED ! ----------------------------------------------------------------- ! ================================================================= ! Other routines ! ================================================================= ! ----------------------------------------------------------------- ! N_VGetLength_Serial ! ----------------------------------------------------------------- integer(c_long) function FN_VGetLength_Serial(v) & bind(C,name='N_VGetLength_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end function FN_VGetLength_Serial ! ----------------------------------------------------------------- ! N_VPrint_Serial ! ----------------------------------------------------------------- subroutine FN_VPrint_Serial(v) & bind(C,name='N_VPrint_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end subroutine FN_VPrint_Serial ! ----------------------------------------------------------------- ! NOT INTERFACED: N_VPrintFile_Serial ! ----------------------------------------------------------------- ! ================================================================= ! Operations ! ================================================================= ! ----------------------------------------------------------------- ! N_VGetVectorID_Serial ! ----------------------------------------------------------------- integer(c_int) function FN_VGetVectorID_Serial(v) & bind(C,name='N_VGetVectorID_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end function FN_VGetVectorID_Serial ! ----------------------------------------------------------------- ! N_VCloneEmpty_Serial ! ----------------------------------------------------------------- type(c_ptr) function FN_VCloneEmpty_Serial(w) & bind(C,name='N_VCloneEmpty_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: w end function FN_VCloneEmpty_Serial ! ----------------------------------------------------------------- ! N_VClone_Serial ! ----------------------------------------------------------------- type(c_ptr) function FN_VClone_Serial(w) & bind(C,name='N_VClone_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: w end function FN_VClone_Serial ! ----------------------------------------------------------------- ! N_VSpace_Serial ! ----------------------------------------------------------------- subroutine FN_VSpace_Serial(v, lrw, liw) & bind(C,name='N_VSpace_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v integer(c_long) :: lrw integer(c_long) :: liw end subroutine FN_VSpace_Serial ! ----------------------------------------------------------------- ! N_VGetArrayPointer_Serial ! ----------------------------------------------------------------- type(c_ptr) function FN_VGetArrayPointer_Serial(vec) & bind(C,name='N_VGetArrayPointer_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: vec end function FN_VGetArrayPointer_Serial ! ----------------------------------------------------------------- ! N_VSetArrayPointer_Serial ! ----------------------------------------------------------------- subroutine FN_VSetArrayPointer_Serial(v_data, v) & bind(C,name='N_VSetArrayPointer_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v_data type(c_ptr), value :: v end subroutine FN_VSetArrayPointer_Serial ! ----------------------------------------------------------------- ! N_VLinearSum_Serial ! ----------------------------------------------------------------- subroutine FN_VLinearSum_Serial(a, x, b, y, z) & bind(C,name='N_VLinearSum_Serial') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: a type(c_ptr), value :: x real(c_double), value :: b type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VLinearSum_Serial ! ----------------------------------------------------------------- ! N_VConst_Serial ! ----------------------------------------------------------------- subroutine FN_VConst_Serial(c, z) & bind(C,name='N_VConst_Serial') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: z end subroutine FN_VConst_Serial ! ----------------------------------------------------------------- ! N_VProd_Serial ! ----------------------------------------------------------------- subroutine FN_VProd_Serial(x, y, z) & bind(C,name='N_VProd_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VProd_Serial ! ----------------------------------------------------------------- ! N_VDiv_Serial ! ----------------------------------------------------------------- subroutine FN_VDiv_Serial(x, y, z) & bind(C,name='N_VDiv_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VDiv_Serial ! ----------------------------------------------------------------- ! N_VScale_Serial ! ----------------------------------------------------------------- subroutine FN_VScale_Serial(c, x, z) & bind(C,name='N_VScale_Serial') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VScale_Serial ! ----------------------------------------------------------------- ! N_VAbs_Serial ! ----------------------------------------------------------------- subroutine FN_VAbs_Serial(x, z) & bind(C,name='N_VAbs_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VAbs_Serial ! ----------------------------------------------------------------- ! N_VInv_Serial ! ----------------------------------------------------------------- subroutine FN_VInv_Serial(x, z) & bind(C,name='N_VInv_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VInv_Serial ! ----------------------------------------------------------------- ! N_VAddConst ! ----------------------------------------------------------------- subroutine FN_VAddConst_Serial(x, b, z) & bind(C,name='N_VAddConst_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x real(c_double), value :: b type(c_ptr), value :: z end subroutine FN_VAddConst_Serial ! ----------------------------------------------------------------- ! N_VDotProd_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VDotProd_Serial(x, y) & bind(C,name='N_VDotProd_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y end function FN_VDotProd_Serial ! ----------------------------------------------------------------- ! N_VMaxNorm_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VMaxNorm_Serial(x) & bind(C,name='N_VMaxNorm_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VMaxNorm_Serial ! ----------------------------------------------------------------- ! N_VWrmsNorm_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VWrmsNorm_Serial(x, w) & bind(C,name='N_VWrmsNorm_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w end function FN_VWrmsNorm_Serial ! ----------------------------------------------------------------- ! N_VWrmsNormMask_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VWrmsNormMask_Serial(x, w, id) & bind(C,name='N_VWrmsNormMask_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w type(c_ptr), value :: id end function FN_VWrmsNormMask_Serial ! ----------------------------------------------------------------- ! N_VMin_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VMin_Serial(x) & bind(C,name='N_VMin_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VMin_Serial ! ----------------------------------------------------------------- ! N_VWL2Norm_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VWL2Norm_Serial(x, w) & bind(C,name='N_VWL2Norm_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w end function FN_VWL2Norm_Serial ! ----------------------------------------------------------------- ! N_VL1Norm_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VL1Norm_Serial(x) & bind(C,name='N_VL1Norm_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VL1Norm_Serial ! ----------------------------------------------------------------- ! N_VCompare_Serial ! ----------------------------------------------------------------- subroutine FN_VCompare_Serial(c, x, z) & bind(C,name='N_VCompare_Serial') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VCompare_Serial ! ----------------------------------------------------------------- ! N_VInvTest_Serial ! ----------------------------------------------------------------- integer(c_int) function FN_VInvTest_Serial(x, z) & bind(C,name='N_VInvTest_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end function FN_VInvTest_Serial ! ----------------------------------------------------------------- ! N_VConstrMask_Serial ! ----------------------------------------------------------------- integer(c_int) function FN_VConstrMask_Serial(c, x, m) & bind(C,name='N_VConstrMask_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: c type(c_ptr), value :: x type(c_ptr), value :: m end function FN_VConstrMask_Serial ! ----------------------------------------------------------------- ! N_VMinQuotient_Serial ! ----------------------------------------------------------------- real(c_double) function FN_VMinQuotient_Serial(num, denom) & bind(C,name='N_VMinQuotient_Serial') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: num type(c_ptr), value :: denom end function FN_VMinQuotient_Serial ! ================================================================ ! Fused vector operations: NOT INTERFACED ! ================================================================ ! ================================================================ ! Vector array operations: NOT INTERFACED ! ================================================================ end interface contains ! ================================================================ ! Helpful routines ! ================================================================ ! ---------------------------------------------------------------- ! FN_VGetData_Serial ! ! Extracts data array from a serial SUNDIALS N_Vector ! ---------------------------------------------------------------- subroutine FN_VGetData_Serial(vec, f_array) !======= Inclusions =========== use, intrinsic :: iso_c_binding !======= Declarations ========= implicit none ! calling variables type(c_ptr) :: vec integer(c_long) :: length real(c_double), pointer :: f_array(:) ! C pointer for N_Vector interal data array type(c_ptr) :: c_array !======= Internals ============ ! get data pointer from N_Vector c_array = FN_VGetArrayPointer_Serial(vec) ! get vector length length = FN_VGetLength_Serial(vec) ! convert c pointer to f pointer call c_f_pointer(c_array, f_array, (/length/)) end subroutine FN_VGetData_Serial end module fnvector_serial_mod StanHeaders/src/nvector/pthreads/0000755000176200001440000000000013766554135016553 5ustar liggesusersStanHeaders/src/nvector/pthreads/fnvector_pthreads.h0000644000176200001440000000542613766554457022462 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Steven Smith @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_pthreads.h) contains the * definitions needed for the initialization of pthreads * vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_PTHREADS_H #define _FNVECTOR_PTHREADS_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FNV_INITPTS SUNDIALS_F77_FUNC(fnvinitpts, FNVINITPTS) #else #define FNV_INITPTS fnvinitpts_ #endif #if defined(SUNDIALS_F77_FUNC_) #define FNV_INITPTS_Q SUNDIALS_F77_FUNC_(fnvinitpts_q, FNVINITPTS_Q) #define FNV_INITPTS_S SUNDIALS_F77_FUNC_(fnvinitpts_s, FNVINITPTS_S) #define FNV_INITPTS_B SUNDIALS_F77_FUNC_(fnvinitpts_b, FNVINITPTS_B) #define FNV_INITPTS_QB SUNDIALS_F77_FUNC_(fnvinitpts_qb, FNVINITPTS_QB) #else #define FNV_INITPTS_Q fnvinitpts_q_ #define FNV_INITPTS_S fnvinitpts_s_ #define FNV_INITPTS_B fnvinitpts_b_ #define FNV_INITPTS_QB fnvinitpts_qb_ #endif /* Declarations of global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_CVODE_vecQ; extern N_Vector *F2C_CVODE_vecS; extern N_Vector F2C_CVODE_vecB; extern N_Vector F2C_CVODE_vecQB; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_IDA_vecQ; extern N_Vector *F2C_IDA_vecS; extern N_Vector F2C_IDA_vecB; extern N_Vector F2C_IDA_vecQB; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* * Prototypes of exported functions * * FNV_INITPTS - initializes pthreads vector operations for main problem * FNV_INITPTS_Q - initializes pthreads vector operations for quadratures * FNV_INITPTS_S - initializes pthreads vector operations for sensitivities * FNV_INITPTS_B - initializes pthreads vector operations for adjoint problem * FNV_INITPTS_QB - initializes pthreads vector operations for adjoint quadratures * */ void FNV_INITPTS(int *code, long int *neq, int *num_threads, int *ier); void FNV_INITPTS_Q(int *code, long int *Nq, int *num_threads, int *ier); void FNV_INITPTS_S(int *code, int *Ns, int *ier); void FNV_INITPTS_B(int *code, long int *NB, int *num_threads, int *ier); void FNV_INITPTS_QB(int *code, long int *NqB, int *num_threads, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/nvector/pthreads/nvector_pthreads.c0000644000176200001440000042110113766554457022277 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------- * Acknowledgements: This NVECTOR module is based on the NVECTOR * Serial module by Scott D. Cohen, Alan C. * Hindmarsh, Radu Serban, and Aaron Collier * @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a POSIX Threads (Pthreads) * implementation of the NVECTOR package using a LOCAL array of * structures to pass data to threads. * -----------------------------------------------------------------*/ #include #include #include #include #include /* define NAN */ #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Private functions for special cases of vector operations */ static void VCopy_Pthreads(N_Vector x, N_Vector z); /* z=x */ static void VSum_Pthreads(N_Vector x, N_Vector y, N_Vector z); /* z=x+y */ static void VDiff_Pthreads(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VNeg_Pthreads(N_Vector x, N_Vector z); /* z=-x */ static void VScaleSum_Pthreads(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x+y) */ static void VScaleDiff_Pthreads(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VLin1_Pthreads(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin2_Pthreads(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void Vaxpy_Pthreads(realtype a, N_Vector x, N_Vector y); /* y <- ax+y */ static void VScaleBy_Pthreads(realtype a, N_Vector x); /* x <- ax */ /* Private functions for special cases of vector array operations */ static int VSumVectorArray_Pthreads(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X+Y */ static int VDiffVectorArray_Pthreads(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X-Y */ static int VScaleSumVectorArray_Pthreads(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X+Y) */ static int VScaleDiffVectorArray_Pthreads(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X-Y) */ static int VLin1VectorArray_Pthreads(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX+Y */ static int VLin2VectorArray_Pthreads(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX-Y */ static int VaxpyVectorArray_Pthreads(int nvec, realtype a, N_Vector* X, N_Vector* Y); /* Y <- aX+Y */ /* Pthread companion functions for vector operations */ static void *N_VLinearSum_PT(void *thread_data); static void *N_VConst_PT(void *thread_data); static void *N_VProd_PT(void *thread_data); static void *N_VDiv_PT(void *thread_data); static void *N_VScale_PT(void *thread_data); static void *N_VAbs_PT(void *thread_data); static void *N_VInv_PT(void *thread_data); static void *N_VAddConst_PT(void *thread_data); static void *N_VCompare_PT(void *thread_data); static void *N_VDotProd_PT(void *thread_data); static void *N_VMaxNorm_PT(void *thread_data); static void *N_VWrmsNorm_PT(void *thread_data); static void *N_VMin_PT(void *thread_data); static void *N_VWL2Norm_PT(void *thread_data); static void *N_VL1Norm_PT(void *thread_data); static void *N_VInvTest_PT(void *thread_data); static void *N_VWrmsNormMask_PT(void *thread_data); static void *N_VConstrMask_PT(void *thread_data); static void *N_VMinQuotient_PT(void *thread_data); /* Pthread companion functions special cases of vector operations */ static void *VCopy_PT(void *thread_data); static void *VSum_PT(void *thread_data); static void *VDiff_PT(void *thread_data); static void *VNeg_PT(void *thread_data); static void *VScaleSum_PT(void *thread_data); static void *VScaleDiff_PT(void *thread_data); static void *VLin1_PT(void *thread_data); static void *VLin2_PT(void *thread_data); static void *VScaleBy_PT(void *thread_data); static void *Vaxpy_PT(void *thread_data); /* Pthread companion functions for fused vector operations */ static void *N_VLinearCombination_PT(void *thread_data); static void *N_VScaleAddMulti_PT(void *thread_data); static void *N_VDotProdMulti_PT(void *thread_data); /* Pthread companion functions for vector array operations */ static void *N_VLinearSumVectorArray_PT(void *thread_data); static void *N_VScaleVectorArray_PT(void *thread_data); static void *N_VConstVectorArray_PT(void *thread_data); static void *N_VWrmsNormVectorArray_PT(void *thread_data); static void *N_VWrmsNormMaskVectorArray_PT(void *thread_data); static void *N_VScaleAddMultiVectorArray_PT(void *thread_data); static void *N_VLinearCombinationVectorArray_PT(void *thread_data); /* Pthread companion functions special cases of vector array operations */ static void *VSumVectorArray_PT(void *thread_data); static void *VDiffVectorArray_PT(void *thread_data); static void *VScaleSumVectorArray_PT(void *thread_data); static void *VScaleDiffVectorArray_PT(void *thread_data); static void *VLin1VectorArray_PT(void *thread_data); static void *VLin2VectorArray_PT(void *thread_data); static void *VaxpyVectorArray_PT(void *thread_data); /* Function to determine loop values for threads */ static void N_VSplitLoop(int myid, int *nthreads, sunindextype *N, sunindextype *start, sunindextype *end); /* Function to initialize thread data */ static void N_VInitThreadData(Pthreads_Data *thread_data); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Pthreads(N_Vector v) { return SUNDIALS_NVEC_PTHREADS; } /* ---------------------------------------------------------------------------- * Function to create a new empty vector */ N_Vector N_VNewEmpty_Pthreads(sunindextype length, int num_threads) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Pthreads content; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Pthreads; ops->nvclone = N_VClone_Pthreads; ops->nvcloneempty = N_VCloneEmpty_Pthreads; ops->nvdestroy = N_VDestroy_Pthreads; ops->nvspace = N_VSpace_Pthreads; ops->nvgetarraypointer = N_VGetArrayPointer_Pthreads; ops->nvsetarraypointer = N_VSetArrayPointer_Pthreads; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_Pthreads; ops->nvconst = N_VConst_Pthreads; ops->nvprod = N_VProd_Pthreads; ops->nvdiv = N_VDiv_Pthreads; ops->nvscale = N_VScale_Pthreads; ops->nvabs = N_VAbs_Pthreads; ops->nvinv = N_VInv_Pthreads; ops->nvaddconst = N_VAddConst_Pthreads; ops->nvdotprod = N_VDotProd_Pthreads; ops->nvmaxnorm = N_VMaxNorm_Pthreads; ops->nvwrmsnormmask = N_VWrmsNormMask_Pthreads; ops->nvwrmsnorm = N_VWrmsNorm_Pthreads; ops->nvmin = N_VMin_Pthreads; ops->nvwl2norm = N_VWL2Norm_Pthreads; ops->nvl1norm = N_VL1Norm_Pthreads; ops->nvcompare = N_VCompare_Pthreads; ops->nvinvtest = N_VInvTest_Pthreads; ops->nvconstrmask = N_VConstrMask_Pthreads; ops->nvminquotient = N_VMinQuotient_Pthreads; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_Pthreads) malloc(sizeof(struct _N_VectorContent_Pthreads)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = length; content->num_threads = num_threads; content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Function to create a new vector */ N_Vector N_VNew_Pthreads(sunindextype length, int num_threads) { N_Vector v; realtype *data; v = NULL; v = N_VNewEmpty_Pthreads(length, num_threads); if (v == NULL) return(NULL); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Pthreads(v); return(NULL); } /* Attach data */ NV_OWN_DATA_PT(v) = SUNTRUE; NV_DATA_PT(v) = data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create a vector with user data component */ N_Vector N_VMake_Pthreads(sunindextype length, int num_threads, realtype *v_data) { N_Vector v; v = NULL; v = N_VNewEmpty_Pthreads(length, num_threads); if (v == NULL) return(NULL); if (length > 0) { /* Attach data */ NV_OWN_DATA_PT(v) = SUNFALSE; NV_DATA_PT(v) = v_data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create an array of new vectors. */ N_Vector *N_VCloneVectorArray_Pthreads(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_Pthreads(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Pthreads(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to create an array of new vectors with NULL data array. */ N_Vector *N_VCloneVectorArrayEmpty_Pthreads(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_Pthreads(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Pthreads(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_Pthreads */ void N_VDestroyVectorArray_Pthreads(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_Pthreads(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------------------- * Function to return number of vector elements */ sunindextype N_VGetLength_Pthreads(N_Vector v) { return NV_LENGTH_PT(v); } /* ---------------------------------------------------------------------------- * Function to print a vector to stdout */ void N_VPrint_Pthreads(N_Vector x) { N_VPrintFile_Pthreads(x, stdout); } /* ---------------------------------------------------------------------------- * Function to print a vector to outfile */ void N_VPrintFile_Pthreads(N_Vector x, FILE *outfile) { sunindextype i, N; realtype *xd; xd = NULL; N = NV_LENGTH_PT(x); xd = NV_DATA_PT(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%11.8Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Create new vector from existing vector without attaching data */ N_Vector N_VCloneEmpty_Pthreads(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Pthreads content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_Pthreads) malloc(sizeof(struct _N_VectorContent_Pthreads)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = NV_LENGTH_PT(w); content->num_threads = NV_NUM_THREADS_PT(w); content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Create new vector from existing vector and attach data */ N_Vector N_VClone_Pthreads(N_Vector w) { N_Vector v; realtype *data; sunindextype length; v = NULL; v = N_VCloneEmpty_Pthreads(w); if (v == NULL) return(NULL); length = NV_LENGTH_PT(w); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_Pthreads(v); return(NULL); } /* Attach data */ NV_OWN_DATA_PT(v) = SUNTRUE; NV_DATA_PT(v) = data; } return(v); } /* ---------------------------------------------------------------------------- * Destroy vector and free vector memory */ void N_VDestroy_Pthreads(N_Vector v) { if (NV_OWN_DATA_PT(v) == SUNTRUE) { free(NV_DATA_PT(v)); NV_DATA_PT(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } /* ---------------------------------------------------------------------------- * Get storage requirement for vector */ void N_VSpace_Pthreads(N_Vector v, sunindextype *lrw, sunindextype *liw) { *lrw = NV_LENGTH_PT(v); *liw = 1; return; } /* ---------------------------------------------------------------------------- * Get vector data pointer */ realtype *N_VGetArrayPointer_Pthreads(N_Vector v) { return((realtype *) NV_DATA_PT(v)); } /* ---------------------------------------------------------------------------- * Set vector data pointer */ void N_VSetArrayPointer_Pthreads(realtype *v_data, N_Vector v) { if (NV_LENGTH_PT(v) > 0) NV_DATA_PT(v) = v_data; return; } /* ---------------------------------------------------------------------------- * Compute linear sum z[i] = a*x[i]+b*y[i] */ void N_VLinearSum_Pthreads(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; realtype c; N_Vector v1, v2; booleantype test; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_Pthreads(a,x,y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_Pthreads(b,y,x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_Pthreads(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_Pthreads(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_Pthreads(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_Pthreads(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_Pthreads(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_Pthreads(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = (pthread_t *) malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; b = my_data->c2; xd = my_data->v1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute linear sum */ for (i = start; i < end; i++){ zd[i] = (a*xd[i])+(b*yd[i]); } /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Assigns constant value to all vector elements, z[i] = c */ void N_VConst_Pthreads(realtype c, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(z); nthreads = NV_NUM_THREADS_PT(z); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; zd = my_data->v1; start = my_data->start; end = my_data->end; /* assign constant values */ for (i = start; i < end; i++) zd[i] = c; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute componentwise product z[i] = x[i]*y[i] */ void N_VProd_Pthreads(N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute componentwise product */ for (i = start; i < end; i++) zd[i] = xd[i]*yd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute componentwise division z[i] = x[i]/y[i] */ void N_VDiv_Pthreads(N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute componentwise division */ for (i = start; i < end; i++) zd[i] = xd[i]/yd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute scaler multiplication z[i] = c*x[i] */ void N_VScale_Pthreads(realtype c, N_Vector x, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_Pthreads(c, x); return; } if (c == ONE) { VCopy_Pthreads(x, z); } else if (c == -ONE) { VNeg_Pthreads(x, z); } else { /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* compute scaler multiplication */ for (i = start; i < end; i++) zd[i] = c*xd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute absolute value of vector components z[i] = SUNRabs(x[i]) */ void N_VAbs_Pthreads(N_Vector x, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* compute absolute value of components */ for (i = start; i < end; i++) zd[i] = SUNRabs(xd[i]); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute componentwise inverse z[i] = 1 / x[i] */ void N_VInv_Pthreads(N_Vector x, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* compute componentwise inverse */ for (i = start; i < end; i++) zd[i] = ONE/xd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute componentwise addition of a scaler to a vector z[i] = x[i] + b */ void N_VAddConst_Pthreads(N_Vector x, realtype b, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* compute componentwise constant addition */ for (i = start; i < end; i++) zd[i] = xd[i] + b; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Computes the dot product of two vectors, a = sum(x[i]*y[i]) */ realtype N_VDotProd_Pthreads(N_Vector x, N_Vector y) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype sum = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; yd = my_data->v2; global_sum = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* compute dot product */ local_sum = ZERO; for (i = start; i < end; i++) local_sum += xd[i] * yd[i]; /* update global sum */ pthread_mutex_lock(global_mutex); *global_sum += local_sum; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Computes max norm of the vector */ realtype N_VMaxNorm_Pthreads(N_Vector x) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype max = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; global_max = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* find local max */ local_max = ZERO; for (i = start; i < end; i++) if (SUNRabs(xd[i]) > local_max) local_max = SUNRabs(xd[i]); /* update global max */ pthread_mutex_lock(global_mutex); if (local_max > *global_max) { *global_max = local_max; } pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Computes weighted root mean square norm of a vector */ realtype N_VWrmsNorm_Pthreads(N_Vector x, N_Vector w) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype sum = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; wd = my_data->v2; global_sum = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* compute wrms norm */ local_sum = ZERO; for (i = start; i < end; i++) local_sum += SUNSQR(xd[i] * wd[i]); /* update global sum */ pthread_mutex_lock(global_mutex); *global_sum += local_sum; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Computes weighted root mean square norm of a masked vector */ realtype N_VWrmsNormMask_Pthreads(N_Vector x, N_Vector w, N_Vector id) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype sum = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; wd = my_data->v2; idd = my_data->v3; global_sum = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* compute wrms norm with mask */ local_sum = ZERO; for (i = start; i < end; i++) { if (idd[i] > ZERO) local_sum += SUNSQR(xd[i]*wd[i]); } /* update global sum */ pthread_mutex_lock(global_mutex); *global_sum += local_sum; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Finds the minimun component of a vector */ realtype N_VMin_Pthreads(N_Vector x) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype min; /* initialize global min */ min = NV_Ith_PT(x,0); /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; global_min = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* find local min */ local_min = *global_min; for (i = start; i < end; i++) { if (xd[i] < local_min) local_min = xd[i]; } /* update global min */ pthread_mutex_lock(global_mutex); if (local_min < *global_min) *global_min = local_min; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Computes weighted L2 norm of a vector */ realtype N_VWL2Norm_Pthreads(N_Vector x, N_Vector w) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype sum = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; wd = my_data->v2; global_sum = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* compute WL2 norm */ local_sum = ZERO; for (i = start; i < end; i++) local_sum += SUNSQR(xd[i]*wd[i]); /* update global sum */ pthread_mutex_lock(global_mutex); *global_sum += local_sum; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Computes L1 norm of a vector */ realtype N_VL1Norm_Pthreads(N_Vector x) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype sum = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; global_sum = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* compute L1 norm */ local_sum = ZERO; for (i = start; i < end; i++) local_sum += SUNRabs(xd[i]); /* update global sum */ pthread_mutex_lock(global_mutex); *global_sum += local_sum; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compare vector component values to a scaler */ void N_VCompare_Pthreads(realtype c, N_Vector x, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* compare component to scaler */ for (i = start; i < end; i++) zd[i] = (SUNRabs(xd[i]) >= c) ? ONE : ZERO; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute componentwise inverse z[i] = ONE/x[i] and check if x[i] == ZERO */ booleantype N_VInvTest_Pthreads(N_Vector x, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; realtype val = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; i ZERO) return (SUNFALSE); else return (SUNTRUE); } /* ---------------------------------------------------------------------------- * Pthread companion function to N_VInvTest */ static void *N_VInvTest_PT(void *thread_data) { sunindextype i, start, end; realtype *xd, *zd; realtype local_val, *global_val; Pthreads_Data *my_data; /* extract thread data */ my_data = (Pthreads_Data *) thread_data; xd = my_data->v1; zd = my_data->v2; global_val = my_data->global_val; start = my_data->start; end = my_data->end; /* compute inverse with check for divide by ZERO */ local_val = ZERO; for (i = start; i < end; i++) { if (xd[i] == ZERO) local_val = ONE; else zd[i] = ONE/xd[i]; } /* update global val */ if (local_val > ZERO) { *global_val = local_val; } /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute constraint mask of a vector */ booleantype N_VConstrMask_Pthreads(N_Vector c, N_Vector x, N_Vector m) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; realtype val = ZERO; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; i ZERO) return(SUNFALSE); else return(SUNTRUE); } /* ---------------------------------------------------------------------------- * Pthread companion function to N_VConstrMask */ static void *N_VConstrMask_PT(void *thread_data) { sunindextype i, start, end; realtype *cd, *xd, *md; realtype local_val, *global_val; Pthreads_Data *my_data; /* extract thread data */ my_data = (Pthreads_Data *) thread_data; cd = my_data->v1; xd = my_data->v2; md = my_data->v3; global_val = my_data->global_val; start = my_data->start; end = my_data->end; /* compute constraint mask */ local_val = ZERO; for (i = start; i < end; i++) { md[i] = ZERO; /* Continue if no constraints were set for the variable */ if (cd[i] == ZERO) continue; /* Check if a set constraint has been violated */ if ((SUNRabs(cd[i]) > ONEPT5 && xd[i]*cd[i] <= ZERO) || (SUNRabs(cd[i]) > HALF && xd[i]*cd[i] < ZERO)) { local_val = md[i] = ONE; } } /* update global val */ if (local_val > ZERO) { *global_val = local_val; } /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute minimum componentwise quotient */ realtype N_VMinQuotient_Pthreads(N_Vector num, N_Vector denom) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; realtype min = BIG_REAL; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(num); nthreads = NV_NUM_THREADS_PT(num); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* lock for reduction */ pthread_mutex_init(&global_mutex, NULL); for (i=0; iv1; dd = my_data->v2; global_min = my_data->global_val; global_mutex = my_data->global_mutex; start = my_data->start; end = my_data->end; /* compute minimum quotient */ local_min = BIG_REAL; for (i = start; i < end; i++) { if (dd[i] == ZERO) continue; local_min = SUNMIN(local_min, nd[i]/dd[i]); } /* update global min */ pthread_mutex_lock(global_mutex); if (local_min < *global_min) *global_min = local_min; pthread_mutex_unlock(global_mutex); /* exit */ pthread_exit(NULL); } /* * ----------------------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------------------- */ /* ----------------------------------------------------------------------------- * Compute the linear combination z = c[i]*X[i] */ int N_VLinearCombination_Pthreads(int nvec, realtype* c, N_Vector* X, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_Pthreads(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_Pthreads(c[0], X[0], c[1], X[1], z); return(0); } /* get vector length and data array */ N = NV_LENGTH_PT(z); nthreads = NV_NUM_THREADS_PT(z); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; istart; end = my_data->end; c = my_data->cvals; zd = NV_DATA_PT(my_data->x1); /* * X[0] += c[i]*X[i], i = 1,...,nvec-1 */ if ((my_data->Y1[0] == my_data->x1) && (c[0] == ONE)) { for (i=1; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); for (j=start; jY1[0] == my_data->x1)) { for (j=start; jnvec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); for (j=start; jY1[0]); for (j=start; jnvec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); for (j=start; jstart; end = my_data->end; a = my_data->cvals; xd = NV_DATA_PT(my_data->x1); /* * Y[i][j] += a[i] * x[j] */ if (my_data->Y1 == my_data->Y2) { for (i=0; invec; i++) { yd = NV_DATA_PT(my_data->Y1[i]); for (j=start; jnvec; i++) { yd = NV_DATA_PT(my_data->Y1[i]); zd = NV_DATA_PT(my_data->Y2[i]); for (j=start; jstart; end = my_data->end; lock = my_data->global_mutex; xd = NV_DATA_PT(my_data->x1); dotprods = my_data->cvals; /* compute multiple dot products */ for (i=0; invec; i++) { yd = NV_DATA_PT(my_data->Y1[i]); sum = ZERO; for (j=start; jstart; end = my_data->end; a = my_data->c1; b = my_data->c2; /* compute linear sum for each vector pair in vector arrays */ for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; c = my_data->cvals; /* * X[i] *= c[i] */ if (my_data->Y1 == my_data->Y2) { for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); for (j=start; jnvec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); zd = NV_DATA_PT(my_data->Y2[i]); for (j=start; jstart; end = my_data->end; /* set each vector in the vector array to a constant */ for (i=0; invec; i++) { zd = NV_DATA_PT(my_data->Y1[i]); for (j=start; jc1; } } /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute the weighted root mean square norm of multiple vectors */ int N_VWrmsNormVectorArray_Pthreads(int nvec, N_Vector* X, N_Vector* W, realtype* nrm) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; pthread_mutex_t global_mutex; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VWrmsNorm */ if (nvec == 1) { nrm[0] = N_VWrmsNorm_Pthreads(X[0], W[0]); return(0); } /* initialize output array */ for (i=0; istart; end = my_data->end; lock = my_data->global_mutex; nrm = my_data->cvals; /* compute the WRMS norm for each vector in the vector array */ for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); wd = NV_DATA_PT(my_data->Y2[i]); sum = ZERO; for (j=start; jstart; end = my_data->end; lock = my_data->global_mutex; nrm = my_data->cvals; idd = NV_DATA_PT(my_data->x1); /* compute the WRMS norm for each vector in the vector array */ for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); wd = NV_DATA_PT(my_data->Y2[i]); sum = ZERO; for (j=start; j ZERO) sum += SUNSQR(xd[j] * wd[j]); } /* update global sum */ pthread_mutex_lock(lock); nrm[i] += sum; pthread_mutex_unlock(lock); } /* exit */ pthread_exit(NULL); } /* ----------------------------------------------------------------------------- * Scale and add a vector to multiple vectors Z = Y + a*X */ int N_VScaleAddMultiVectorArray_Pthreads(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z) { sunindextype N; int i, j, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; int retval; N_Vector* YY; N_Vector* ZZ; /* invalid number of vectors */ if (nvec < 1) return(-1); if (nsum < 1) return(-1); /* --------------------------- * Special cases for nvec == 1 * --------------------------- */ if (nvec == 1) { /* should have called N_VLinearSum */ if (nsum == 1) { N_VLinearSum_Pthreads(a[0], X[0], ONE, Y[0][0], Z[0][0]); return(0); } /* should have called N_VScaleAddMulti */ YY = (N_Vector *) malloc(nsum * sizeof(N_Vector)); ZZ = (N_Vector *) malloc(nsum * sizeof(N_Vector)); for (j=0; j 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_Pthreads(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length and data array */ N = NV_LENGTH_PT(X[0]); nthreads = NV_NUM_THREADS_PT(X[0]); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; istart; end = my_data->end; a = my_data->cvals; /* * Y[i][j] += a[i] * x[j] */ if (my_data->ZZ1 == my_data->ZZ2) { for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); for (j=0; jnsum; j++){ yd = NV_DATA_PT(my_data->ZZ1[j][i]); for (k=start; knvec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); for (j=0; jnsum; j++){ yd = NV_DATA_PT(my_data->ZZ1[j][i]); zd = NV_DATA_PT(my_data->ZZ2[j][i]); for (k=start; k 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jstart; end = my_data->end; c = my_data->cvals; /* * X[0][j] += c[i]*X[i][j], i = 1,...,nvec-1 */ if ((my_data->ZZ1[0] == my_data->Y1) && (c[0] == ONE)) { for (j=0; jnvec; j++) { zd = NV_DATA_PT(my_data->Y1[j]); for (i=1; insum; i++) { xd = NV_DATA_PT(my_data->ZZ1[i][j]); for (k=start; kZZ1[0] == my_data->Y1) { for (j=0; jnvec; j++) { zd = NV_DATA_PT(my_data->Y1[j]); for (k=start; knsum; i++) { xd = NV_DATA_PT(my_data->ZZ1[i][j]); for (k=start; knvec; j++) { xd = NV_DATA_PT(my_data->ZZ1[0][j]); zd = NV_DATA_PT(my_data->Y1[j]); for (k=start; knsum; i++) { xd = NV_DATA_PT(my_data->ZZ1[i][j]); for (k=start; kv1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* copy vector components */ for (i = start; i < end; i++) zd[i] = xd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute vector sum */ static void VSum_Pthreads(N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute vector sum */ for (i = start; i < end; i++) zd[i] = xd[i] + yd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute vector difference */ static void VDiff_Pthreads(N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute vector difference */ for (i = start; i < end; i++) zd[i] = xd[i] - yd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute the negative of a vector */ static void VNeg_Pthreads(N_Vector x, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; iv1; zd = my_data->v2; start = my_data->start; end = my_data->end; /* compute negative of vector */ for (i = start; i < end; i++) zd[i] = -xd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute scaled vector sum */ static void VScaleSum_Pthreads(realtype c, N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute scaled vector sum */ for (i = start; i < end; i++) zd[i] = c*(xd[i] + yd[i]); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute scaled vector difference */ static void VScaleDiff_Pthreads(realtype c, N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute scaled vector difference */ for (i = start; i < end; i++) zd[i] = c*(xd[i] - yd[i]); /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute vector sum z[i] = a*x[i]+y[i] */ static void VLin1_Pthreads(realtype a, N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute vector sum */ for (i = start; i < end; i++) zd[i] = (a*xd[i]) + yd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute vector difference z[i] = a*x[i]-y[i] */ static void VLin2_Pthreads(realtype a, N_Vector x, N_Vector y, N_Vector z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; yd = my_data->v2; zd = my_data->v3; start = my_data->start; end = my_data->end; /* compute vector difference */ for (i = start; i < end; i++) zd[i] = (a*xd[i]) - yd[i]; /* exit */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute special cases of linear sum */ static void Vaxpy_Pthreads(realtype a, N_Vector x, N_Vector y) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; yd = my_data->v2; start = my_data->start; end = my_data->end; /* compute axpy */ if (a == ONE) { for (i = start; i < end; i++) yd[i] += xd[i]; /* exit */ pthread_exit(NULL); } if (a == -ONE) { for (i = start; i < end; i++) yd[i] -= xd[i]; /* exit */ pthread_exit(NULL); } for (i = start; i < end; i++) yd[i] += a*xd[i]; /* return */ pthread_exit(NULL); } /* ---------------------------------------------------------------------------- * Compute scaled vector */ static void VScaleBy_Pthreads(realtype a, N_Vector x) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(x); nthreads = NV_NUM_THREADS_PT(x); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); for (i=0; ic1; xd = my_data->v1; start = my_data->start; end = my_data->end; /* compute scaled vector */ for (i = start; i < end; i++) xd[i] *= a; /* exit */ pthread_exit(NULL); } /* * ----------------------------------------------------------------------------- * private functions for special cases of vector array operations * ----------------------------------------------------------------------------- */ static int VSumVectorArray_Pthreads(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z) { sunindextype N; int i, nthreads; pthread_t *threads; Pthreads_Data *thread_data; pthread_attr_t attr; /* allocate threads and thread data structs */ N = NV_LENGTH_PT(X[0]); nthreads = NV_NUM_THREADS_PT(X[0]); threads = malloc(nthreads*sizeof(pthread_t)); thread_data = (Pthreads_Data *) malloc(nthreads*sizeof(struct _Pthreads_Data)); /* set thread attributes */ pthread_attr_init(&attr); pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE); /* pack thread data, distribute loop indices, and create threads/call kernel */ for (i=0; istart; end = my_data->end; for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; c = my_data->c1; for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; c = my_data->c1; for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; a = my_data->c1; for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; a = my_data->c1; for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); zd = NV_DATA_PT(my_data->Y3[i]); for (j=start; jstart; end = my_data->end; a = my_data->c1; if (a == ONE) { for (i=0; invec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); for (j=start; jnvec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); for (j=start; jnvec; i++) { xd = NV_DATA_PT(my_data->Y1[i]); yd = NV_DATA_PT(my_data->Y2[i]); for (j=start; jstart = -1; thread_data->end = -1; #if __STDC_VERSION__ >= 199901L thread_data->c1 = NAN; thread_data->c2 = NAN; #else thread_data->c1 = ZERO; thread_data->c2 = ZERO; #endif thread_data->v1 = NULL; thread_data->v2 = NULL; thread_data->v3 = NULL; thread_data->global_val = NULL; thread_data->global_mutex = NULL; thread_data->nvec = ZERO; thread_data->nsum = ZERO; thread_data->cvals = NULL; thread_data->Y1 = NULL; thread_data->Y2 = NULL; thread_data->Y3 = NULL; } /* * ----------------------------------------------------------------- * Enable / Disable fused and vector array operations * ----------------------------------------------------------------- */ int N_VEnableFusedOps_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_Pthreads; v->ops->nvscaleaddmulti = N_VScaleAddMulti_Pthreads; v->ops->nvdotprodmulti = N_VDotProdMulti_Pthreads; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Pthreads; v->ops->nvscalevectorarray = N_VScaleVectorArray_Pthreads; v->ops->nvconstvectorarray = N_VConstVectorArray_Pthreads; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Pthreads; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Pthreads; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Pthreads; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Pthreads; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_Pthreads; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_Pthreads; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_Pthreads; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Pthreads; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_Pthreads; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_Pthreads; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Pthreads; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Pthreads; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Pthreads; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_Pthreads(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Pthreads; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/nvector/pthreads/fnvector_pthreads.c0000644000176200001440000000737113766554457022456 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Steven Smith @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_pthreads.h) contains the * implementation needed for the Fortran initialization of pthreads * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fnvector_pthreads.h" /* Define global vector variables */ N_Vector F2C_CVODE_vec; N_Vector F2C_CVODE_vecQ; N_Vector *F2C_CVODE_vecS; N_Vector F2C_CVODE_vecB; N_Vector F2C_CVODE_vecQB; N_Vector F2C_IDA_vec; N_Vector F2C_IDA_vecQ; N_Vector *F2C_IDA_vecS; N_Vector F2C_IDA_vecB; N_Vector F2C_IDA_vecQB; N_Vector F2C_KINSOL_vec; N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FNV_INITPTS(int *code, long int *N, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vec = NULL; F2C_CVODE_vec = N_VNewEmpty_Pthreads(*N, *num_threads); if (F2C_CVODE_vec == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vec = NULL; F2C_IDA_vec = N_VNewEmpty_Pthreads(*N, *num_threads); if (F2C_IDA_vec == NULL) *ier = -1; break; case FCMIX_KINSOL: F2C_KINSOL_vec = NULL; F2C_KINSOL_vec = N_VNewEmpty_Pthreads(*N, *num_threads); if (F2C_KINSOL_vec == NULL) *ier = -1; break; case FCMIX_ARKODE: F2C_ARKODE_vec = NULL; F2C_ARKODE_vec = N_VNewEmpty_Pthreads(*N, *num_threads); if (F2C_ARKODE_vec == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITPTS_Q(int *code, long int *Nq, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQ = NULL; F2C_CVODE_vecQ = N_VNewEmpty_Pthreads(*Nq, *num_threads); if (F2C_CVODE_vecQ == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQ = NULL; F2C_IDA_vecQ = N_VNewEmpty_Pthreads(*Nq, *num_threads); if (F2C_IDA_vecQ == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITPTS_B(int *code, long int *NB, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecB = NULL; F2C_CVODE_vecB = N_VNewEmpty_Pthreads(*NB, *num_threads); if (F2C_CVODE_vecB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecB = NULL; F2C_IDA_vecB = N_VNewEmpty_Pthreads(*NB, *num_threads); if (F2C_IDA_vecB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITPTS_QB(int *code, long int *NqB, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQB = NULL; F2C_CVODE_vecQB = N_VNewEmpty_Pthreads(*NqB, *num_threads); if (F2C_CVODE_vecQB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQB = NULL; F2C_IDA_vecQB = N_VNewEmpty_Pthreads(*NqB, *num_threads); if (F2C_IDA_vecQB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITPTS_S(int *code, int *Ns, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecS = NULL; F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Pthreads(*Ns, F2C_CVODE_vec); if (F2C_CVODE_vecS == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecS = NULL; F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_Pthreads(*Ns, F2C_IDA_vec); if (F2C_IDA_vecS == NULL) *ier = -1; break; default: *ier = -1; } } StanHeaders/src/nvector/pthreads/F90/0000755000176200001440000000000013766554135017111 5ustar liggesusersStanHeaders/src/nvector/pthreads/F90/fnvector_pthreads.f900000644000176200001440000004225713766554457023172 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS Pthreads NVector using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fnvector_pthreads_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= ! ----------------------------------------------------------------- ! N_VNew_Pthreads ! ----------------------------------------------------------------- type(c_ptr) function FN_VNew_Pthreads(vec_length, num_threads) & bind(C,name='N_VNew_Pthreads') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: vec_length integer(c_int), value :: num_threads end function FN_VNew_Pthreads ! ----------------------------------------------------------------- ! N_VNewEmpty_Pthreads ! ----------------------------------------------------------------- type(c_ptr) function FN_VNewEmpty_Pthreads(vec_length, num_threads) & bind(C,name='N_VNewEmpty_Pthreads') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: vec_length integer(c_int), value :: num_threads end function FN_VNewEmpty_Pthreads ! ----------------------------------------------------------------- ! N_VMake_Pthreads ! ----------------------------------------------------------------- type(c_ptr) function FN_VMake_Pthreads(length, v_data, num_threads) & bind(C,name='N_VMake_Pthreads') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: length real(c_double) :: v_data(length) integer(c_int), value :: num_threads end function FN_VMake_Pthreads ! ----------------------------------------------------------------- ! N_VCloneVectorArray_Pthreads: NOT INTERFACED ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- ! N_VCloneVectorArrayEmpty_Pthreads: NOT INTERFACED ! ----------------------------------------------------------------- ! ================================================================= ! Destructors ! ================================================================= ! ----------------------------------------------------------------- ! N_VDestroy_Pthreads ! ----------------------------------------------------------------- subroutine FN_VDestroy_Pthreads(v) & bind(C,name='N_VDestroy_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end subroutine FN_VDestroy_Pthreads ! ----------------------------------------------------------------- ! N_VDestroyVectorArray_Pthreads: NOT INTERFACED ! ----------------------------------------------------------------- ! ================================================================= ! Other routines ! ================================================================= ! ----------------------------------------------------------------- ! N_VGetLength_Pthreads ! ----------------------------------------------------------------- integer(c_long) function FN_VGetLength_Pthreads(v) & bind(C,name='N_VGetLength_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end function FN_VGetLength_Pthreads ! ----------------------------------------------------------------- ! N_VPrint_Pthreads ! ----------------------------------------------------------------- subroutine FN_VPrint_Pthreads(v) & bind(C,name='N_VPrint_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end subroutine FN_VPrint_Pthreads ! ----------------------------------------------------------------- ! NOT INTERFACED: N_VPrintFile_Pthreads ! ----------------------------------------------------------------- ! ================================================================= ! Operations ! ================================================================= ! ----------------------------------------------------------------- ! N_VGetVectorID_Pthreads ! ----------------------------------------------------------------- integer(c_int) function FN_VGetVectorID_Pthreads(v) & bind(C,name='N_VGetVectorID_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end function FN_VGetVectorID_Pthreads ! ----------------------------------------------------------------- ! N_VCloneEmpty_Pthreads ! ----------------------------------------------------------------- type(c_ptr) function FN_VCloneEmpty_Pthreads(w) & bind(C,name='N_VCloneEmpty_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: w end function FN_VCloneEmpty_Pthreads ! ----------------------------------------------------------------- ! N_VClone_Pthreads ! ----------------------------------------------------------------- type(c_ptr) function FN_VClone_Pthreads(w) & bind(C,name='N_VClone_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: w end function FN_VClone_Pthreads ! ----------------------------------------------------------------- ! N_VSpace_Pthreads ! ----------------------------------------------------------------- subroutine FN_VSpace_Pthreads(v, lrw, liw) & bind(C,name='N_VSpace_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v integer(c_long) :: lrw integer(c_long) :: liw end subroutine FN_VSpace_Pthreads ! ----------------------------------------------------------------- ! N_VGetArrayPointer_Pthreads ! ----------------------------------------------------------------- type(c_ptr) function FN_VGetArrayPointer_Pthreads(vec) & bind(C,name='N_VGetArrayPointer_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: vec end function FN_VGetArrayPointer_Pthreads ! ----------------------------------------------------------------- ! N_VSetArrayPointer_Pthreads ! ----------------------------------------------------------------- subroutine FN_VSetArrayPointer_Pthreads(v_data, v) & bind(C,name='N_VSetArrayPointer_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v_data type(c_ptr), value :: v end subroutine FN_VSetArrayPointer_Pthreads ! ----------------------------------------------------------------- ! N_VLinearSum_Pthreads ! ----------------------------------------------------------------- subroutine FN_VLinearSum_Pthreads(a, x, b, y, z) & bind(C,name='N_VLinearSum_Pthreads') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: a type(c_ptr), value :: x real(c_double), value :: b type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VLinearSum_Pthreads ! ----------------------------------------------------------------- ! N_VConst_Pthreads ! ----------------------------------------------------------------- subroutine FN_VConst_Pthreads(c, z) & bind(C,name='N_VConst_Pthreads') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: z end subroutine FN_VConst_Pthreads ! ----------------------------------------------------------------- ! N_VProd_Pthreads ! ----------------------------------------------------------------- subroutine FN_VProd_Pthreads(x, y, z) & bind(C,name='N_VProd_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VProd_Pthreads ! ----------------------------------------------------------------- ! N_VDiv_Pthreads ! ----------------------------------------------------------------- subroutine FN_VDiv_Pthreads(x, y, z) & bind(C,name='N_VDiv_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VDiv_Pthreads ! ----------------------------------------------------------------- ! N_VScale_Pthreads ! ----------------------------------------------------------------- subroutine FN_VScale_Pthreads(c, x, z) & bind(C,name='N_VScale_Pthreads') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VScale_Pthreads ! ----------------------------------------------------------------- ! N_VAbs_Pthreads ! ----------------------------------------------------------------- subroutine FN_VAbs_Pthreads(x, z) & bind(C,name='N_VAbs_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VAbs_Pthreads ! ----------------------------------------------------------------- ! N_VInv_Pthreads ! ----------------------------------------------------------------- subroutine FN_VInv_Pthreads(x, z) & bind(C,name='N_VInv_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VInv_Pthreads ! ----------------------------------------------------------------- ! N_VAddConst ! ----------------------------------------------------------------- subroutine FN_VAddConst_Pthreads(x, b, z) & bind(C,name='N_VAddConst_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x real(c_double), value :: b type(c_ptr), value :: z end subroutine FN_VAddConst_Pthreads ! ----------------------------------------------------------------- ! N_VDotProd_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VDotProd_Pthreads(x, y) & bind(C,name='N_VDotProd_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y end function FN_VDotProd_Pthreads ! ----------------------------------------------------------------- ! N_VMaxNorm_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VMaxNorm_Pthreads(x) & bind(C,name='N_VMaxNorm_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VMaxNorm_Pthreads ! ----------------------------------------------------------------- ! N_VWrmsNorm_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VWrmsNorm_Pthreads(x, w) & bind(C,name='N_VWrmsNorm_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w end function FN_VWrmsNorm_Pthreads ! ----------------------------------------------------------------- ! N_VWrmsNormMask_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VWrmsNormMask_Pthreads(x, w, id) & bind(C,name='N_VWrmsNormMask_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w type(c_ptr), value :: id end function FN_VWrmsNormMask_Pthreads ! ----------------------------------------------------------------- ! N_VMin_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VMin_Pthreads(x) & bind(C,name='N_VMin_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VMin_Pthreads ! ----------------------------------------------------------------- ! N_VWL2Norm_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VWL2Norm_Pthreads(x, w) & bind(C,name='N_VWL2Norm_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w end function FN_VWL2Norm_Pthreads ! ----------------------------------------------------------------- ! N_VL1Norm_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VL1Norm_Pthreads(x) & bind(C,name='N_VL1Norm_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VL1Norm_Pthreads ! ----------------------------------------------------------------- ! N_VCompare_Pthreads ! ----------------------------------------------------------------- subroutine FN_VCompare_Pthreads(c, x, z) & bind(C,name='N_VCompare_Pthreads') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VCompare_Pthreads ! ----------------------------------------------------------------- ! N_VInvTest_Pthreads ! ----------------------------------------------------------------- integer(c_int) function FN_VInvTest_Pthreads(x, z) & bind(C,name='N_VInvTest_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end function FN_VInvTest_Pthreads ! ----------------------------------------------------------------- ! N_VConstrMask_Pthreads ! ----------------------------------------------------------------- integer(c_int) function FN_VConstrMask_Pthreads(c, x, m) & bind(C,name='N_VConstrMask_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: c type(c_ptr), value :: x type(c_ptr), value :: m end function FN_VConstrMask_Pthreads ! ----------------------------------------------------------------- ! N_VMinQuotient_Pthreads ! ----------------------------------------------------------------- real(c_double) function FN_VMinQuotient_Pthreads(num, denom) & bind(C,name='N_VMinQuotient_Pthreads') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: num type(c_ptr), value :: denom end function FN_VMinQuotient_Pthreads ! ================================================================ ! Fused vector operations: NOT INTERFACED ! ================================================================ ! ================================================================ ! Vector array operations: NOT INTERFACED ! ================================================================ end interface contains ! ================================================================ ! Helpful routines ! ================================================================ ! ---------------------------------------------------------------- ! FN_VGetData_Pthreads ! ! Extracts data array from a Pthreads SUNDIALS N_Vector ! ---------------------------------------------------------------- subroutine FN_VGetData_Pthreads(vec, f_array) !======= Inclusions =========== use, intrinsic :: iso_c_binding !======= Declarations ========= implicit none ! calling variables type(c_ptr) :: vec integer(c_long) :: length real(c_double), pointer :: f_array(:) ! C pointer for N_Vector interal data array type(c_ptr) :: c_array !======= Internals ============ ! get data pointer from N_Vector c_array = FN_VGetArrayPointer_Pthreads(vec) ! get vector length length = FN_VGetLength_Pthreads(vec) ! convert c pointer to f pointer call c_f_pointer(c_array, f_array, (/length/)) end subroutine FN_VGetData_Pthreads end module fnvector_pthreads_mod StanHeaders/src/nvector/raja/0000755000176200001440000000000013766554135015656 5ustar liggesusersStanHeaders/src/nvector/raja/nvector_raja.cu0000644000176200001440000011334513766554457020702 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a MPI+RAJA implementation * of the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) // RAJA defines #define CUDA_BLOCK_SIZE 256 #define RAJA_NODE_TYPE RAJA::cuda_exec< CUDA_BLOCK_SIZE > #define RAJA_REDUCE_TYPE RAJA::cuda_reduce< CUDA_BLOCK_SIZE > #define RAJA_LAMBDA [=] __device__ extern "C" { using namespace sunrajavec; // Type defines typedef sunrajavec::Vector vector_type; // Static constants static constexpr sunindextype zeroIdx = 0; /* * ---------------------------------------------------------------- * private accessor/helper functions * ---------------------------------------------------------------- */ static inline sunindextype getLocalLength(N_Vector v) { vector_type* vp = static_cast(v->content); return vp->size(); } static inline SUNMPI_Comm getMPIComm(N_Vector v) { vector_type* vp = static_cast(v->content); return vp->comm(); } /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Raja(N_Vector v) { return SUNDIALS_NVEC_RAJA; } N_Vector N_VNewEmpty_Raja() { N_Vector v; N_Vector_Ops ops; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Raja; ops->nvclone = N_VClone_Raja; ops->nvcloneempty = N_VCloneEmpty_Raja; ops->nvdestroy = N_VDestroy_Raja; ops->nvspace = N_VSpace_Raja; ops->nvgetarraypointer = NULL; //N_VGetArrayPointer_Raja; ops->nvsetarraypointer = NULL; //N_VSetArrayPointer_Raja; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_Raja; ops->nvconst = N_VConst_Raja; ops->nvprod = N_VProd_Raja; ops->nvdiv = N_VDiv_Raja; ops->nvscale = N_VScale_Raja; ops->nvabs = N_VAbs_Raja; ops->nvinv = N_VInv_Raja; ops->nvaddconst = N_VAddConst_Raja; ops->nvdotprod = N_VDotProd_Raja; ops->nvmaxnorm = N_VMaxNorm_Raja; ops->nvwrmsnormmask = N_VWrmsNormMask_Raja; ops->nvwrmsnorm = N_VWrmsNorm_Raja; ops->nvmin = N_VMin_Raja; ops->nvwl2norm = N_VWL2Norm_Raja; ops->nvl1norm = N_VL1Norm_Raja; ops->nvcompare = N_VCompare_Raja; ops->nvinvtest = N_VInvTest_Raja; ops->nvconstrmask = N_VConstrMask_Raja; ops->nvminquotient = N_VMinQuotient_Raja; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Attach ops and set content to NULL */ v->content = NULL; v->ops = ops; return(v); } #if SUNDIALS_MPI_ENABLED N_Vector N_VNew_Raja(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; v = NULL; v = N_VNewEmpty_Raja(); if (v == NULL) return(NULL); v->content = new vector_type(comm, local_length, global_length); return(v); } #else N_Vector N_VNew_Raja(sunindextype length) { N_Vector v; v = NULL; v = N_VNewEmpty_Raja(); if (v == NULL) return(NULL); v->content = new vector_type(length); return(v); } #endif N_Vector N_VMake_Raja(N_VectorContent_Raja c) { N_Vector v; vector_type* x = static_cast(c); sunindextype length = x->size(); v = NULL; v = N_VNewEmpty_Raja(); if (v == NULL) return(NULL); v->content = c; return(v); } /* ----------------------------------------------------------------- * Function to return the global length of the vector. */ sunindextype N_VGetLength_Raja(N_Vector v) { vector_type* xd = static_cast(v->content); return xd->sizeGlobal(); } #if SUNDIALS_MPI_ENABLED /* ----------------------------------------------------------------- * Function to return the local length of the vector. */ sunindextype N_VGetLocalLength_Raja(N_Vector v) { vector_type* xd = static_cast(v->content); return xd->size(); } /* ----------------------------------------------------------------- * Function to return the MPI communicator for the vector. */ MPI_Comm N_VGetMPIComm_Raja(N_Vector v) { vector_type* xd = static_cast(v->content); return (xd->comm()); } #endif /* ---------------------------------------------------------------------------- * Return pointer to the raw host data */ realtype *N_VGetHostArrayPointer_Raja(N_Vector x) { vector_type* xv = static_cast(x->content); return (xv->host()); } /* ---------------------------------------------------------------------------- * Return pointer to the raw device data */ realtype *N_VGetDeviceArrayPointer_Raja(N_Vector x) { vector_type* xv = static_cast(x->content); return (xv->device()); } /* ---------------------------------------------------------------------------- * Copy vector data to the device */ void N_VCopyToDevice_Raja(N_Vector x) { vector_type* xv = static_cast(x->content); xv->copyToDev(); } /* ---------------------------------------------------------------------------- * Copy vector data from the device to the host */ void N_VCopyFromDevice_Raja(N_Vector x) { vector_type* xv = static_cast(x->content); xv->copyFromDev(); } /* ---------------------------------------------------------------------------- * Function to print the a serial vector to stdout */ void N_VPrint_Raja(N_Vector X) { N_VPrintFile_Raja(X, stdout); } /* ---------------------------------------------------------------------------- * Function to print the a serial vector to outfile */ void N_VPrintFile_Raja(N_Vector X, FILE *outfile) { const realtype *xd = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); sunindextype i; for (i = 0; i < N; ++i) { #if defined(SUNDIALS_EXTENDED_PRECISION) fprintf(outfile, "%35.32Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) fprintf(outfile, "%19.16g\n", xd[i]); #else fprintf(outfile, "%11.8g\n", xd[i]); #endif } fprintf(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Raja(N_Vector w) { N_Vector v; N_Vector_Ops ops; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ v->content = NULL; v->ops = ops; return(v); } N_Vector N_VClone_Raja(N_Vector w) { N_Vector v; vector_type* wdat = static_cast(w->content); vector_type* vdat = new vector_type(*wdat); v = NULL; v = N_VCloneEmpty_Raja(w); if (v == NULL) return(NULL); v->content = vdat; return(v); } void N_VDestroy_Raja(N_Vector v) { vector_type* x = static_cast(v->content); if (x != NULL) { delete x; v->content = NULL; } free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Raja(N_Vector X, sunindextype *lrw, sunindextype *liw) { SUNMPI_Comm comm = getMPIComm(X); int npes; SUNMPI_Comm_size(comm, &npes); *lrw = N_VGetLength_Raja(X); *liw = 2*npes; } void N_VConst_Raja(realtype c, N_Vector Z) { const sunindextype N = getLocalLength(Z); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = c; }); } void N_VLinearSum_Raja(realtype a, N_Vector X, realtype b, N_Vector Y, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *ydata = N_VGetDeviceArrayPointer_Raja(Y); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = a*xdata[i] + b*ydata[i]; } ); } void N_VProd_Raja(N_Vector X, N_Vector Y, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *ydata = N_VGetDeviceArrayPointer_Raja(Y); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = xdata[i] * ydata[i]; } ); } void N_VDiv_Raja(N_Vector X, N_Vector Y, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *ydata = N_VGetDeviceArrayPointer_Raja(Y); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = xdata[i] / ydata[i]; } ); } void N_VScale_Raja(realtype c, N_Vector X, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = c * xdata[i]; } ); } void N_VAbs_Raja(N_Vector X, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = abs(xdata[i]); } ); } void N_VInv_Raja(N_Vector X, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = ONE / xdata[i]; } ); } void N_VAddConst_Raja(N_Vector X, realtype b, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = xdata[i] + b; } ); } realtype N_VDotProd_Raja(N_Vector X, N_Vector Y) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *ydata = N_VGetDeviceArrayPointer_Raja(Y); const sunindextype N = getLocalLength(X); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(0.0); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { gpu_result += xdata[i] * ydata[i] ; } ); /* Reduce across MPI processes */ realtype sum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); realtype gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return gsum; } realtype N_VMaxNorm_Raja(N_Vector X) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); RAJA::ReduceMax< RAJA_REDUCE_TYPE, realtype> gpu_result(0.0); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { gpu_result.max(abs(xdata[i])); } ); /* Reduce across MPI processes */ realtype maximum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); return SUNMPI_Allreduce_scalar(maximum, 2, comm); } realtype N_VWrmsNorm_Raja(N_Vector X, N_Vector W) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *wdata = N_VGetDeviceArrayPointer_Raja(W); const sunindextype N = getLocalLength(X); const sunindextype Nglobal = N_VGetLength_Raja(X); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(0.0); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { gpu_result += (xdata[i] * wdata[i] * xdata[i] * wdata[i]); } ); /* Reduce across MPI processes */ realtype sum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); return std::sqrt(SUNMPI_Allreduce_scalar(sum, 1, comm)/Nglobal); } realtype N_VWrmsNormMask_Raja(N_Vector X, N_Vector W, N_Vector ID) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *wdata = N_VGetDeviceArrayPointer_Raja(W); const realtype *iddata = N_VGetDeviceArrayPointer_Raja(ID); const sunindextype N = getLocalLength(X); const sunindextype Nglobal = N_VGetLength_Raja(X); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(0.0); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { if (iddata[i] > ZERO) gpu_result += (xdata[i] * wdata[i] * xdata[i] * wdata[i]); } ); /* Reduce across MPI processes */ realtype sum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); return std::sqrt(SUNMPI_Allreduce_scalar(sum, 1, comm)/Nglobal); } realtype N_VMin_Raja(N_Vector X) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); RAJA::ReduceMin< RAJA_REDUCE_TYPE, realtype> gpu_result(std::numeric_limits::max()); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { gpu_result.min(xdata[i]); } ); /* Reduce across MPI processes */ realtype minumum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); return SUNMPI_Allreduce_scalar(minumum, 3, comm); } realtype N_VWL2Norm_Raja(N_Vector X, N_Vector W) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const realtype *wdata = N_VGetDeviceArrayPointer_Raja(W); const sunindextype N = getLocalLength(X); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(0.0); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { gpu_result += (xdata[i] * wdata[i] * xdata[i] * wdata[i]); } ); /* Reduce across MPI processes */ realtype sum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); return std::sqrt(SUNMPI_Allreduce_scalar(sum, 1, comm)); } realtype N_VL1Norm_Raja(N_Vector X) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(0.0); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { gpu_result += (abs(xdata[i])); } ); /* Reduce across MPI processes */ realtype sum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(X); return SUNMPI_Allreduce_scalar(sum, 1, comm); } void N_VCompare_Raja(realtype c, N_Vector X, N_Vector Z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(X); const sunindextype N = getLocalLength(X); realtype *zdata = N_VGetDeviceArrayPointer_Raja(Z); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { zdata[i] = abs(xdata[i]) >= c ? ONE : ZERO; } ); } booleantype N_VInvTest_Raja(N_Vector x, N_Vector z) { const realtype *xdata = N_VGetDeviceArrayPointer_Raja(x); const sunindextype N = getLocalLength(x); realtype *zdata = N_VGetDeviceArrayPointer_Raja(z); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(ZERO); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { if (xdata[i] == ZERO) { gpu_result += ONE; } else { zdata[i] = ONE/xdata[i]; } } ); /* Reduce across MPI processes */ realtype minimum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(x); realtype global_minimum = SUNMPI_Allreduce_scalar(minimum, 3, comm); return (global_minimum < HALF); } booleantype N_VConstrMask_Raja(N_Vector c, N_Vector x, N_Vector m) { const realtype *cdata = N_VGetDeviceArrayPointer_Raja(c); const realtype *xdata = N_VGetDeviceArrayPointer_Raja(x); const sunindextype N = getLocalLength(x); realtype *mdata = N_VGetDeviceArrayPointer_Raja(m); RAJA::ReduceSum< RAJA_REDUCE_TYPE, realtype> gpu_result(ZERO); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { bool test = (abs(cdata[i]) > ONEPT5 && cdata[i]*xdata[i] <= ZERO) || (abs(cdata[i]) > HALF && cdata[i]*xdata[i] < ZERO); mdata[i] = test ? ONE : ZERO; gpu_result += mdata[i]; } ); /* Reduce across MPI processes */ realtype sum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(x); realtype global_sum = SUNMPI_Allreduce_scalar(sum, 1, comm); return (global_sum < HALF); } realtype N_VMinQuotient_Raja(N_Vector num, N_Vector denom) { const realtype *ndata = N_VGetDeviceArrayPointer_Raja(num); const realtype *ddata = N_VGetDeviceArrayPointer_Raja(denom); const sunindextype N = getLocalLength(num); RAJA::ReduceMin< RAJA_REDUCE_TYPE, realtype> gpu_result(std::numeric_limits::max()); RAJA::forall< RAJA_NODE_TYPE >(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { if (ddata[i] != ZERO) gpu_result.min(ndata[i]/ddata[i]); } ); /* Reduce across MPI processes */ realtype minimum = static_cast(gpu_result); SUNMPI_Comm comm = getMPIComm(num); return SUNMPI_Allreduce_scalar(minimum, 3, comm); } /* * ----------------------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------------------- */ int N_VLinearCombination_Raja(int nvec, realtype* c, N_Vector* X, N_Vector z) { cudaError_t err; sunindextype N = getLocalLength(z); realtype* d_zd = N_VGetDeviceArrayPointer_Raja(z); // Copy c array to device realtype* d_c; err = cudaMalloc((void**) &d_c, nvec*sizeof(realtype)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_c, c, nvec*sizeof(realtype), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Create array of device pointers on host realtype** h_Xd = new realtype*[nvec]; for (int j=0; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { d_zd[i] = d_c[0] * d_Xd[0][i]; for (int j=1; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { for (int j=0; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { for (int j=0; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { for (int j=0; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { for (int j=0; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { for (int j=0; j(RAJA::RangeSegment(zeroIdx, N), RAJA_LAMBDA(sunindextype i) { for (int j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_Raja; v->ops->nvscaleaddmulti = N_VScaleAddMulti_Raja; v->ops->nvdotprodmulti = NULL; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Raja; v->ops->nvscalevectorarray = N_VScaleVectorArray_Raja; v->ops->nvconstvectorarray = N_VConstVectorArray_Raja; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Raja; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Raja; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_Raja; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_Raja; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Raja; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_Raja; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_Raja; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Raja; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_Raja(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Raja; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } } // extern "C" StanHeaders/src/nvector/parhyp/0000755000176200001440000000000013766554135016244 5ustar liggesusersStanHeaders/src/nvector/parhyp/nvector_parhyp.c0000644000176200001440000013303213766554457021464 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL and Jean M. Sexton @ SMU * ----------------------------------------------------------------- * Based on work by Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a HYPRE ParVector wrapper * for the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Error Message */ #define BAD_N1 "N_VNew_ParHyp -- Sum of local vector lengths differs from " #define BAD_N2 "input global length. \n\n" #define BAD_N BAD_N1 BAD_N2 /* * ----------------------------------------------------------------- * Simplifying macros NV_CONTENT_PH, NV_DATA_PH, NV_LOCLENGTH_PH, * NV_GLOBLENGTH_PH, and NV_COMM_PH * ----------------------------------------------------------------- * In the descriptions below, the following user declarations * are assumed: * * N_Vector v; * sunindextype v_len, s_len, i; * * (1) NV_CONTENT_PH * * This routines gives access to the contents of the HYPRE * vector wrapper (the N_Vector). * * The assignment v_cont = NV_CONTENT_PH(v) sets v_cont to be * a pointer to the N_Vector content structure. * * (2) NV_DATA_PH, NV_LOCLENGTH_PH, NV_GLOBLENGTH_PH, and NV_COMM_PH * * These routines give access to the individual parts of * the content structure of a parhyp N_Vector. * * The assignment v_llen = NV_LOCLENGTH_PH(v) sets v_llen to * be the length of the local part of the vector v. The call * NV_LOCLENGTH_PH(v) = llen_v generally should NOT be used! It * will change locally stored value with the HYPRE local vector * length, but it will NOT change the length of the actual HYPRE * local vector. * * The assignment v_glen = NV_GLOBLENGTH_PH(v) sets v_glen to * be the global length of the vector v. The call * NV_GLOBLENGTH_PH(v) = glen_v generally should NOT be used! It * will change locally stored value with the HYPRE parallel vector * length, but it will NOT change the length of the actual HYPRE * parallel vector. * * The assignment v_comm = NV_COMM_PH(v) sets v_comm to be the * MPI communicator of the vector v. The assignment * NV_COMM_C(v) = comm_v sets the MPI communicator of v to be * NV_COMM_PH(v) = comm_v generally should NOT be used! It * will change locally stored value with the HYPRE parallel vector * communicator, but it will NOT change the communicator of the * actual HYPRE parallel vector. * * (3) NV_DATA_PH, NV_HYPRE_PARVEC_PH * * The assignment v_data = NV_DATA_PH(v) sets v_data to be * a pointer to the first component of the data inside the * local vector of the HYPRE_parhyp vector for the vector v. * The assignment NV_DATA_PH(v) = data_v should NOT be used. * Instead, use NV_HYPRE_PARVEC_PH to obtain pointer to HYPRE * vector and then use HYPRE functions to manipulate vector data. * * The assignment v_parhyp = NV_HYPRE_PARVEC_PH(v) sets v_parhyp * to be a pointer to HYPRE_ParVector of vector v. The assignment * NV_HYPRE_PARVEC_PH(v) = parhyp_v sets pointer to * HYPRE_ParVector of vector v to be parhyp_v. * * ----------------------------------------------------------------- */ #define NV_CONTENT_PH(v) ( (N_VectorContent_ParHyp)(v->content) ) #define NV_LOCLENGTH_PH(v) ( NV_CONTENT_PH(v)->local_length ) #define NV_GLOBLENGTH_PH(v) ( NV_CONTENT_PH(v)->global_length ) #define NV_OWN_PARVEC_PH(v) ( NV_CONTENT_PH(v)->own_parvector ) #define NV_HYPRE_PARVEC_PH(v) ( NV_CONTENT_PH(v)->x ) #define NV_DATA_PH(v) ( NV_HYPRE_PARVEC_PH(v) == NULL ? NULL : hypre_VectorData(hypre_ParVectorLocalVector(NV_HYPRE_PARVEC_PH(v))) ) #define NV_COMM_PH(v) ( NV_CONTENT_PH(v)->comm ) /* Private function prototypes */ /* z=x+y */ static void VSum_ParHyp(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VDiff_ParHyp(N_Vector x, N_Vector y, N_Vector z); /* z=c(x+y) */ static void VScaleSum_ParHyp(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VScaleDiff_ParHyp(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin1_ParHyp(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void VLin2_ParHyp(realtype a, N_Vector x, N_Vector y, N_Vector z); /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_ParHyp(N_Vector v) { return SUNDIALS_NVEC_PARHYP; } /* ---------------------------------------------------------------- * Function to create a new parhyp vector without underlying * HYPRE vector. */ N_Vector N_VNewEmpty_ParHyp(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_ParHyp content; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_ParHyp; ops->nvclone = N_VClone_ParHyp; ops->nvcloneempty = N_VCloneEmpty_ParHyp; ops->nvdestroy = N_VDestroy_ParHyp; ops->nvspace = N_VSpace_ParHyp; ops->nvgetarraypointer = N_VGetArrayPointer_ParHyp; ops->nvsetarraypointer = N_VSetArrayPointer_ParHyp; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_ParHyp; ops->nvconst = N_VConst_ParHyp; ops->nvprod = N_VProd_ParHyp; ops->nvdiv = N_VDiv_ParHyp; ops->nvscale = N_VScale_ParHyp; ops->nvabs = N_VAbs_ParHyp; ops->nvinv = N_VInv_ParHyp; ops->nvaddconst = N_VAddConst_ParHyp; ops->nvdotprod = N_VDotProd_ParHyp; ops->nvmaxnorm = N_VMaxNorm_ParHyp; ops->nvwrmsnormmask = N_VWrmsNormMask_ParHyp; ops->nvwrmsnorm = N_VWrmsNorm_ParHyp; ops->nvmin = N_VMin_ParHyp; ops->nvwl2norm = N_VWL2Norm_ParHyp; ops->nvl1norm = N_VL1Norm_ParHyp; ops->nvcompare = N_VCompare_ParHyp; ops->nvinvtest = N_VInvTest_ParHyp; ops->nvconstrmask = N_VConstrMask_ParHyp; ops->nvminquotient = N_VMinQuotient_ParHyp; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_ParHyp) malloc(sizeof(struct _N_VectorContent_ParHyp)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = local_length; content->global_length = global_length; content->comm = comm; content->own_parvector = SUNFALSE; content->x = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------- * Function to create a parhyp N_Vector wrapper around user * supplie HYPRE vector. */ N_Vector N_VMake_ParHyp(HYPRE_ParVector x) { N_Vector v; MPI_Comm comm = hypre_ParVectorComm(x); HYPRE_Int global_length = hypre_ParVectorGlobalSize(x); HYPRE_Int local_begin = hypre_ParVectorFirstIndex(x); HYPRE_Int local_end = hypre_ParVectorLastIndex(x); HYPRE_Int local_length = local_end - local_begin + 1; v = NULL; v = N_VNewEmpty_ParHyp(comm, local_length, global_length); if (v == NULL) return(NULL); NV_OWN_PARVEC_PH(v) = SUNFALSE; NV_HYPRE_PARVEC_PH(v) = x; return(v); } /* ---------------------------------------------------------------- * Function to create an array of new parhyp vectors. */ N_Vector *N_VCloneVectorArray_ParHyp(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_ParHyp(w); if (vs[j] == NULL) { N_VDestroyVectorArray_ParHyp(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to create an array of new parhyp vector wrappers * without uderlying HYPRE vectors. */ N_Vector *N_VCloneVectorArrayEmpty_ParHyp(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_ParHyp(w); if (vs[j] == NULL) { N_VDestroyVectorArray_ParHyp(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_ParHyp */ void N_VDestroyVectorArray_ParHyp(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_ParHyp(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------- * Extract HYPRE vector */ HYPRE_ParVector N_VGetVector_ParHyp(N_Vector v) { return NV_HYPRE_PARVEC_PH(v); } /* ---------------------------------------------------------------- * Function to print a parhyp vector. * TODO: Consider using a HYPRE function for this. */ void N_VPrint_ParHyp(N_Vector x) { N_VPrintFile_ParHyp(x, stdout); } /* ---------------------------------------------------------------- * Function to print a parhyp vector. * TODO: Consider using a HYPRE function for this. */ void N_VPrintFile_ParHyp(N_Vector x, FILE *outfile) { sunindextype i, N; realtype *xd; xd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%g\n", xd[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%g\n", xd[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_ParHyp(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_ParHyp content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Added variables for hypre_parhyp intialization */ int nprocs, myid; MPI_Comm_size(NV_COMM_PH(w), &nprocs); MPI_Comm_rank(NV_COMM_PH(w), &myid); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_ParHyp) malloc(sizeof(struct _N_VectorContent_ParHyp)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = NV_LOCLENGTH_PH(w); content->global_length = NV_GLOBLENGTH_PH(w); content->comm = NV_COMM_PH(w); content->own_parvector = SUNFALSE; content->x = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* * Clone HYPRE vector wrapper. * */ N_Vector N_VClone_ParHyp(N_Vector w) { N_Vector v; HYPRE_ParVector vx; const HYPRE_ParVector wx = NV_HYPRE_PARVEC_PH(w); v = NULL; v = N_VCloneEmpty_ParHyp(w); if (v==NULL) return(NULL); vx = hypre_ParVectorCreate(wx->comm, wx->global_size, wx->partitioning); hypre_ParVectorInitialize(vx); hypre_ParVectorSetPartitioningOwner(vx, 0); hypre_ParVectorSetDataOwner(vx, 1); hypre_SeqVectorSetDataOwner(hypre_ParVectorLocalVector(vx), 1); NV_HYPRE_PARVEC_PH(v) = vx; NV_OWN_PARVEC_PH(v) = SUNTRUE; return(v); } void N_VDestroy_ParHyp(N_Vector v) { if ((NV_OWN_PARVEC_PH(v) == SUNTRUE)) { hypre_ParVectorDestroy(NV_HYPRE_PARVEC_PH(v)); } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_ParHyp(N_Vector v, sunindextype *lrw, sunindextype *liw) { MPI_Comm comm; int npes; comm = NV_COMM_PH(v); MPI_Comm_size(comm, &npes); *lrw = NV_GLOBLENGTH_PH(v); *liw = 2*npes; return; } /* * This function is disabled in ParHyp implementation and returns NULL. * The user should extract HYPRE vector using N_VGetVector_ParHyp and * then use HYPRE functions to get pointer to raw data of the local HYPRE * vector. */ realtype *N_VGetArrayPointer_ParHyp(N_Vector v) { return NULL; /* ((realtype *) NV_DATA_PH(v)); */ } /* * This method is not implemented for HYPRE vector wrapper. * TODO: Put error handler in the function body. */ void N_VSetArrayPointer_ParHyp(realtype *v_data, N_Vector v) { /* Not implemented for Hypre vector */ } /* * Computes z[i] = a*x[i] + b*y[i] * */ void N_VLinearSum_ParHyp(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { sunindextype i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; xd = yd = zd = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ HYPRE_Complex alpha=a; HYPRE_ParVectorAxpy( alpha, (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(x), (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(y)); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ HYPRE_Complex beta=b; HYPRE_ParVectorAxpy( beta, (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(y), (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(x)); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_ParHyp(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_ParHyp(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_ParHyp(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_ParHyp(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_ParHyp(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_ParHyp(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); yd = NV_DATA_PH(y); zd = NV_DATA_PH(z); for (i = 0; i < N; i++) zd[i] = (a*xd[i])+(b*yd[i]); return; } void N_VConst_ParHyp(realtype c, N_Vector z) { HYPRE_Complex value = c; HYPRE_ParVectorSetConstantValues( (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(z), value); return; } /* ---------------------------------------------------------------------------- * Compute componentwise product z[i] = x[i]*y[i] */ void N_VProd_ParHyp(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); yd = NV_DATA_PH(y); zd = NV_DATA_PH(z); for (i = 0; i < N; i++) zd[i] = xd[i]*yd[i]; return; } /* ---------------------------------------------------------------------------- * Compute componentwise division z[i] = x[i]/y[i] */ void N_VDiv_ParHyp(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); yd = NV_DATA_PH(y); zd = NV_DATA_PH(z); for (i = 0; i < N; i++) zd[i] = xd[i]/yd[i]; return; } void N_VScale_ParHyp(realtype c, N_Vector x, N_Vector z) { HYPRE_Complex value = c; if (x != z) { HYPRE_ParVectorCopy((HYPRE_ParVector) NV_HYPRE_PARVEC_PH(x), (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(z)); } HYPRE_ParVectorScale(value, (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(z)); return; } void N_VAbs_ParHyp(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); zd = NV_DATA_PH(z); for (i = 0; i < N; i++) zd[i] = SUNRabs(xd[i]); return; } void N_VInv_ParHyp(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); zd = NV_DATA_PH(z); for (i = 0; i < N; i++) zd[i] = ONE/xd[i]; return; } void N_VAddConst_ParHyp(N_Vector x, realtype b, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); zd = NV_DATA_PH(z); for (i = 0; i < N; i++) zd[i] = xd[i] + b; return; } realtype N_VDotProd_ParHyp(N_Vector x, N_Vector y) { HYPRE_Real gsum; HYPRE_ParVectorInnerProd( (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(x), (HYPRE_ParVector) NV_HYPRE_PARVEC_PH(y), &gsum); return(gsum); } realtype N_VMaxNorm_ParHyp(N_Vector x) { sunindextype i, N; realtype max, *xd, gmax; MPI_Comm comm; xd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); comm = NV_COMM_PH(x); max = ZERO; for (i = 0; i < N; i++) { if (SUNRabs(xd[i]) > max) max = SUNRabs(xd[i]); } gmax = SUNMPI_Allreduce_scalar(max, 2, comm); return(gmax); } realtype N_VWrmsNorm_ParHyp(N_Vector x, N_Vector w) { sunindextype i, N, N_global; realtype sum, prodi, *xd, *wd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = NULL; N = NV_LOCLENGTH_PH(x); N_global = NV_GLOBLENGTH_PH(x); xd = NV_DATA_PH(x); wd = NV_DATA_PH(w); comm = NV_COMM_PH(x); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(SUNRsqrt(gsum/N_global)); } realtype N_VWrmsNormMask_ParHyp(N_Vector x, N_Vector w, N_Vector id) { sunindextype i, N, N_global; realtype sum, prodi, *xd, *wd, *idd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = idd = NULL; N = NV_LOCLENGTH_PH(x); N_global = NV_GLOBLENGTH_PH(x); xd = NV_DATA_PH(x); wd = NV_DATA_PH(w); idd = NV_DATA_PH(id); comm = NV_COMM_PH(x); for (i = 0; i < N; i++) { if (idd[i] > ZERO) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } } gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(SUNRsqrt(gsum/N_global)); } realtype N_VMin_ParHyp(N_Vector x) { sunindextype i, N; realtype min, *xd, gmin; MPI_Comm comm; xd = NULL; N = NV_LOCLENGTH_PH(x); comm = NV_COMM_PH(x); min = BIG_REAL; if (N > 0) { xd = NV_DATA_PH(x); min = xd[0]; for (i = 1; i < N; i++) { if (xd[i] < min) min = xd[i]; } } gmin = SUNMPI_Allreduce_scalar(min, 3, comm); return(gmin); } realtype N_VWL2Norm_ParHyp(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, prodi, *xd, *wd, gsum; MPI_Comm comm; sum = ZERO; xd = wd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); wd = NV_DATA_PH(w); comm = NV_COMM_PH(x); for (i = 0; i < N; i++) { prodi = xd[i]*wd[i]; sum += SUNSQR(prodi); } gsum = SUNMPI_Allreduce_scalar(sum, 1, comm); return(SUNRsqrt(gsum)); } realtype N_VL1Norm_ParHyp(N_Vector x) { sunindextype i, N; realtype sum, gsum, *xd; MPI_Comm comm; sum = ZERO; xd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); comm = NV_COMM_PH(x); for (i = 0; i= c) ? ONE : ZERO; } return; } booleantype N_VInvTest_ParHyp(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd, val, gval; MPI_Comm comm; xd = zd = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); zd = NV_DATA_PH(z); comm = NV_COMM_PH(x); val = ONE; for (i = 0; i < N; i++) { if (xd[i] == ZERO) val = ZERO; else zd[i] = ONE/xd[i]; } gval = SUNMPI_Allreduce_scalar(val, 3, comm); if (gval == ZERO) return(SUNFALSE); else return(SUNTRUE); } booleantype N_VConstrMask_ParHyp(N_Vector c, N_Vector x, N_Vector m) { sunindextype i, N; realtype temp; realtype *cd, *xd, *md; booleantype test; MPI_Comm comm; cd = xd = md = NULL; N = NV_LOCLENGTH_PH(x); xd = NV_DATA_PH(x); cd = NV_DATA_PH(c); md = NV_DATA_PH(m); comm = NV_COMM_PH(x); temp = ZERO; for (i = 0; i < N; i++) { md[i] = ZERO; /* Continue if no constraints were set for the variable */ if (cd[i] == ZERO) continue; /* Check if a set constraint has been violated */ test = (SUNRabs(cd[i]) > ONEPT5 && xd[i]*cd[i] <= ZERO) || (SUNRabs(cd[i]) > HALF && xd[i]*cd[i] < ZERO); if (test) { temp = md[i] = ONE; } } /* Find max temp across all MPI ranks */ temp = SUNMPI_Allreduce_scalar(temp, 2, comm); /* Return false if any constraint was violated */ return (temp == ONE) ? SUNFALSE : SUNTRUE; } realtype N_VMinQuotient_ParHyp(N_Vector num, N_Vector denom) { booleantype notEvenOnce; sunindextype i, N; realtype *nd, *dd, min; MPI_Comm comm; nd = dd = NULL; N = NV_LOCLENGTH_PH(num); nd = NV_DATA_PH(num); dd = NV_DATA_PH(denom); comm = NV_COMM_PH(num); notEvenOnce = SUNTRUE; min = BIG_REAL; for (i = 0; i < N; i++) { if (dd[i] == ZERO) continue; else { if (!notEvenOnce) min = SUNMIN(min, nd[i]/dd[i]); else { min = nd[i]/dd[i]; notEvenOnce = SUNFALSE; } } } return(SUNMPI_Allreduce_scalar(min, 3, comm)); } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_ParHyp(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i; sunindextype j, N; realtype* zd=NULL; realtype* xd=NULL; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_ParHyp(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_ParHyp(c[0], X[0], c[1], X[1], z); return(0); } /* get vector length and data array */ N = NV_LOCLENGTH_PH(z); zd = NV_DATA_PH(z); /* * X[0] += c[i]*X[i], i = 1,...,nvec-1 */ if ((X[0] == z) && (c[0] == ONE)) { for (i=1; i ZERO) nrm[i] += SUNSQR(xd[j] * wd[j]); } } SUNMPI_Allreduce(nrm, nvec, 1, comm); for (i=0; i 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_ParHyp(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length */ N = NV_LOCLENGTH_PH(X[0]); /* * Y[i][j] += a[i] * x[j] */ if (Y == Z) { for (i=0; i 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_ParHyp; v->ops->nvscaleaddmulti = N_VScaleAddMulti_ParHyp; v->ops->nvdotprodmulti = N_VDotProdMulti_ParHyp; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_ParHyp; v->ops->nvscalevectorarray = N_VScaleVectorArray_ParHyp; v->ops->nvconstvectorarray = N_VConstVectorArray_ParHyp; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_ParHyp; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_ParHyp; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_ParHyp; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_ParHyp; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_ParHyp; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_ParHyp; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_ParHyp; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_ParHyp; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_ParHyp; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_ParHyp; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_ParHyp; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_ParHyp; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_ParHyp; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_ParHyp(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_ParHyp; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/nvector/openmp/0000755000176200001440000000000013766554135016237 5ustar liggesusersStanHeaders/src/nvector/openmp/nvector_openmp.c0000644000176200001440000017275413766554457021470 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner and Carol S. Woodward @ LLNL * ----------------------------------------------------------------- * Acknowledgements: This NVECTOR module is based on the NVECTOR * Serial module by Scott D. Cohen, Alan C. * Hindmarsh, Radu Serban, and Aaron Collier * @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for an OpenMP implementation * of the NVECTOR module. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Private functions for special cases of vector operations */ static void VCopy_OpenMP(N_Vector x, N_Vector z); /* z=x */ static void VSum_OpenMP(N_Vector x, N_Vector y, N_Vector z); /* z=x+y */ static void VDiff_OpenMP(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VNeg_OpenMP(N_Vector x, N_Vector z); /* z=-x */ static void VScaleSum_OpenMP(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x+y) */ static void VScaleDiff_OpenMP(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VLin1_OpenMP(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin2_OpenMP(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void Vaxpy_OpenMP(realtype a, N_Vector x, N_Vector y); /* y <- ax+y */ static void VScaleBy_OpenMP(realtype a, N_Vector x); /* x <- ax */ /* Private functions for special cases of vector array operations */ static int VSumVectorArray_OpenMP(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X+Y */ static int VDiffVectorArray_OpenMP(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X-Y */ static int VScaleSumVectorArray_OpenMP(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X+Y) */ static int VScaleDiffVectorArray_OpenMP(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X-Y) */ static int VLin1VectorArray_OpenMP(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX+Y */ static int VLin2VectorArray_OpenMP(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX-Y */ static int VaxpyVectorArray_OpenMP(int nvec, realtype a, N_Vector* X, N_Vector* Y); /* Y <- aX+Y */ /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_OpenMP(N_Vector v) { return SUNDIALS_NVEC_OPENMP; } /* ---------------------------------------------------------------------------- * Function to create a new empty vector */ N_Vector N_VNewEmpty_OpenMP(sunindextype length, int num_threads) { N_Vector v; N_Vector_Ops ops; N_VectorContent_OpenMP content; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_OpenMP; ops->nvclone = N_VClone_OpenMP; ops->nvcloneempty = N_VCloneEmpty_OpenMP; ops->nvdestroy = N_VDestroy_OpenMP; ops->nvspace = N_VSpace_OpenMP; ops->nvgetarraypointer = N_VGetArrayPointer_OpenMP; ops->nvsetarraypointer = N_VSetArrayPointer_OpenMP; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_OpenMP; ops->nvconst = N_VConst_OpenMP; ops->nvprod = N_VProd_OpenMP; ops->nvdiv = N_VDiv_OpenMP; ops->nvscale = N_VScale_OpenMP; ops->nvabs = N_VAbs_OpenMP; ops->nvinv = N_VInv_OpenMP; ops->nvaddconst = N_VAddConst_OpenMP; ops->nvdotprod = N_VDotProd_OpenMP; ops->nvmaxnorm = N_VMaxNorm_OpenMP; ops->nvwrmsnormmask = N_VWrmsNormMask_OpenMP; ops->nvwrmsnorm = N_VWrmsNorm_OpenMP; ops->nvmin = N_VMin_OpenMP; ops->nvwl2norm = N_VWL2Norm_OpenMP; ops->nvl1norm = N_VL1Norm_OpenMP; ops->nvcompare = N_VCompare_OpenMP; ops->nvinvtest = N_VInvTest_OpenMP; ops->nvconstrmask = N_VConstrMask_OpenMP; ops->nvminquotient = N_VMinQuotient_OpenMP; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_OpenMP) malloc(sizeof(struct _N_VectorContent_OpenMP)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = length; content->num_threads = num_threads; content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Function to create a new vector */ N_Vector N_VNew_OpenMP(sunindextype length, int num_threads) { N_Vector v; realtype *data; v = NULL; v = N_VNewEmpty_OpenMP(length, num_threads); if (v == NULL) return(NULL); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_OpenMP(v); return(NULL); } /* Attach data */ NV_OWN_DATA_OMP(v) = SUNTRUE; NV_DATA_OMP(v) = data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create a vector with user data component */ N_Vector N_VMake_OpenMP(sunindextype length, realtype *v_data, int num_threads) { N_Vector v; v = NULL; v = N_VNewEmpty_OpenMP(length, num_threads); if (v == NULL) return(NULL); if (length > 0) { /* Attach data */ NV_OWN_DATA_OMP(v) = SUNFALSE; NV_DATA_OMP(v) = v_data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create an array of new vectors. */ N_Vector *N_VCloneVectorArray_OpenMP(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_OpenMP(w); if (vs[j] == NULL) { N_VDestroyVectorArray_OpenMP(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to create an array of new vectors with NULL data array. */ N_Vector *N_VCloneVectorArrayEmpty_OpenMP(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_OpenMP(w); if (vs[j] == NULL) { N_VDestroyVectorArray_OpenMP(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_OpenMP */ void N_VDestroyVectorArray_OpenMP(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_OpenMP(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------------------- * Function to return number of vector elements */ sunindextype N_VGetLength_OpenMP(N_Vector v) { return NV_LENGTH_OMP(v); } /* ---------------------------------------------------------------------------- * Function to print a vector to stdout */ void N_VPrint_OpenMP(N_Vector x) { N_VPrintFile_OpenMP(x, stdout); } /* ---------------------------------------------------------------------------- * Function to print a vector to outfile */ void N_VPrintFile_OpenMP(N_Vector x, FILE *outfile) { sunindextype i, N; realtype *xd; xd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%11.8Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Create new vector from existing vector without attaching data */ N_Vector N_VCloneEmpty_OpenMP(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_OpenMP content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_OpenMP) malloc(sizeof(struct _N_VectorContent_OpenMP)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = NV_LENGTH_OMP(w); content->num_threads = NV_NUM_THREADS_OMP(w); content->own_data = SUNFALSE; content->data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Create new vector from existing vector and attach data */ N_Vector N_VClone_OpenMP(N_Vector w) { N_Vector v; realtype *data; sunindextype length; v = NULL; v = N_VCloneEmpty_OpenMP(w); if (v == NULL) return(NULL); length = NV_LENGTH_OMP(w); /* Create data */ if (length > 0) { /* Allocate memory */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); if(data == NULL) { N_VDestroy_OpenMP(v); return(NULL); } /* Attach data */ NV_OWN_DATA_OMP(v) = SUNTRUE; NV_DATA_OMP(v) = data; } return(v); } /* ---------------------------------------------------------------------------- * Destroy vector and free vector memory */ void N_VDestroy_OpenMP(N_Vector v) { if (NV_OWN_DATA_OMP(v) == SUNTRUE) { free(NV_DATA_OMP(v)); NV_DATA_OMP(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } /* ---------------------------------------------------------------------------- * Get storage requirement for N_Vector */ void N_VSpace_OpenMP(N_Vector v, sunindextype *lrw, sunindextype *liw) { *lrw = NV_LENGTH_OMP(v); *liw = 1; return; } /* ---------------------------------------------------------------------------- * Get vector data pointer */ realtype *N_VGetArrayPointer_OpenMP(N_Vector v) { return((realtype *) NV_DATA_OMP(v)); } /* ---------------------------------------------------------------------------- * Set vector data pointer */ void N_VSetArrayPointer_OpenMP(realtype *v_data, N_Vector v) { if (NV_LENGTH_OMP(v) > 0) NV_DATA_OMP(v) = v_data; return; } /* ---------------------------------------------------------------------------- * Compute linear combination z[i] = a*x[i]+b*y[i] */ void N_VLinearSum_OpenMP(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { sunindextype i, N; realtype c, *xd, *yd, *zd; N_Vector v1, v2; booleantype test; xd = yd = zd = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_OpenMP(a,x,y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_OpenMP(b,y,x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_OpenMP(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_OpenMP(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_OpenMP(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_OpenMP(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_OpenMP(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_OpenMP(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); yd = NV_DATA_OMP(y); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,a,b,xd,yd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = (a*xd[i])+(b*yd[i]); return; } /* ---------------------------------------------------------------------------- * Assigns constant value to all vector elements, z[i] = c */ void N_VConst_OpenMP(realtype c, N_Vector z) { sunindextype i, N; realtype *zd; zd = NULL; N = NV_LENGTH_OMP(z); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,c,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(z)) for (i = 0; i < N; i++) zd[i] = c; return; } /* ---------------------------------------------------------------------------- * Compute componentwise product z[i] = x[i]*y[i] */ void N_VProd_OpenMP(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); yd = NV_DATA_OMP(y); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,xd,yd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = xd[i]*yd[i]; return; } /* ---------------------------------------------------------------------------- * Compute componentwise division z[i] = x[i]/y[i] */ void N_VDiv_OpenMP(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd, *yd, *zd; xd = yd = zd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); yd = NV_DATA_OMP(y); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,xd,yd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = xd[i]/yd[i]; return; } /* ---------------------------------------------------------------------------- * Compute scaler multiplication z[i] = c*x[i] */ void N_VScale_OpenMP(realtype c, N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_OpenMP(c, x); return; } if (c == ONE) { VCopy_OpenMP(x, z); } else if (c == -ONE) { VNeg_OpenMP(x, z); } else { N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,c,xd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = c*xd[i]; } return; } /* ---------------------------------------------------------------------------- * Compute absolute value of vector components z[i] = SUNRabs(x[i]) */ void N_VAbs_OpenMP(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); zd = NV_DATA_OMP(z); #pragma omp parallel for schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = SUNRabs(xd[i]); return; } /* ---------------------------------------------------------------------------- * Compute componentwise inverse z[i] = 1 / x[i] */ void N_VInv_OpenMP(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,xd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = ONE/xd[i]; return; } /* ---------------------------------------------------------------------------- * Compute componentwise addition of a scaler to a vector z[i] = x[i] + b */ void N_VAddConst_OpenMP(N_Vector x, realtype b, N_Vector z) { sunindextype i, N; realtype *xd, *zd; xd = zd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); zd = NV_DATA_OMP(z); #pragma omp parallel for default(none) private(i) shared(N,b,xd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) zd[i] = xd[i]+b; return; } /* ---------------------------------------------------------------------------- * Computes the dot product of two vectors, a = sum(x[i]*y[i]) */ realtype N_VDotProd_OpenMP(N_Vector x, N_Vector y) { sunindextype i, N; realtype sum, *xd, *yd; sum = ZERO; xd = yd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); yd = NV_DATA_OMP(y); #pragma omp parallel for default(none) private(i) shared(N,xd,yd) \ reduction(+:sum) schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) { sum += xd[i]*yd[i]; } return(sum); } /* ---------------------------------------------------------------------------- * Computes max norm of a vector */ realtype N_VMaxNorm_OpenMP(N_Vector x) { sunindextype i, N; realtype tmax, max, *xd; max = ZERO; xd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); #pragma omp parallel default(none) private(i,tmax) shared(N,max,xd) \ num_threads(NV_NUM_THREADS_OMP(x)) { tmax = ZERO; #pragma omp for schedule(static) for (i = 0; i < N; i++) { if (SUNRabs(xd[i]) > tmax) tmax = SUNRabs(xd[i]); } #pragma omp critical { if (tmax > max) max = tmax; } } return(max); } /* ---------------------------------------------------------------------------- * Computes weighted root mean square norm of a vector */ realtype N_VWrmsNorm_OpenMP(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, *xd, *wd; sum = ZERO; xd = wd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); wd = NV_DATA_OMP(w); #pragma omp parallel for default(none) private(i) shared(N,xd,wd) \ reduction(+:sum) schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) { sum += SUNSQR(xd[i]*wd[i]); } return(SUNRsqrt(sum/N)); } /* ---------------------------------------------------------------------------- * Computes weighted root mean square norm of a masked vector */ realtype N_VWrmsNormMask_OpenMP(N_Vector x, N_Vector w, N_Vector id) { sunindextype i, N; realtype sum, *xd, *wd, *idd; sum = ZERO; xd = wd = idd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); wd = NV_DATA_OMP(w); idd = NV_DATA_OMP(id); #pragma omp parallel for default(none) private(i) shared(N,xd,wd,idd) \ reduction(+:sum) schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) { if (idd[i] > ZERO) { sum += SUNSQR(xd[i]*wd[i]); } } return(SUNRsqrt(sum / N)); } /* ---------------------------------------------------------------------------- * Finds the minimun component of a vector */ realtype N_VMin_OpenMP(N_Vector x) { sunindextype i, N; realtype min, *xd; realtype tmin; xd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); min = xd[0]; #pragma omp parallel default(none) private(i,tmin) shared(N,min,xd) \ num_threads(NV_NUM_THREADS_OMP(x)) { tmin = xd[0]; #pragma omp for schedule(static) for (i = 1; i < N; i++) { if (xd[i] < tmin) tmin = xd[i]; } if (tmin < min) { #pragma omp critical { if (tmin < min) min = tmin; } } } return(min); } /* ---------------------------------------------------------------------------- * Computes weighted L2 norm of a vector */ realtype N_VWL2Norm_OpenMP(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, *xd, *wd; sum = ZERO; xd = wd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); wd = NV_DATA_OMP(w); #pragma omp parallel for default(none) private(i) shared(N,xd,wd) \ reduction(+:sum) schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) { sum += SUNSQR(xd[i]*wd[i]); } return(SUNRsqrt(sum)); } /* ---------------------------------------------------------------------------- * Computes L1 norm of a vector */ realtype N_VL1Norm_OpenMP(N_Vector x) { sunindextype i, N; realtype sum, *xd; sum = ZERO; xd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); #pragma omp parallel for default(none) private(i) shared(N,xd) \ reduction(+:sum) schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i= c) ? ONE : ZERO; } return; } /* ---------------------------------------------------------------------------- * Compute componentwise inverse z[i] = ONE/x[i] and checks if x[i] == ZERO */ booleantype N_VInvTest_OpenMP(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd, *zd, val; xd = zd = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); zd = NV_DATA_OMP(z); val = ZERO; #pragma omp parallel for default(none) private(i) shared(N,val,xd,zd) schedule(static) \ num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) { if (xd[i] == ZERO) val = ONE; else zd[i] = ONE/xd[i]; } if (val > ZERO) return (SUNFALSE); else return (SUNTRUE); } /* ---------------------------------------------------------------------------- * Compute constraint mask of a vector */ booleantype N_VConstrMask_OpenMP(N_Vector c, N_Vector x, N_Vector m) { sunindextype i, N; realtype temp; realtype *cd, *xd, *md; booleantype test; cd = xd = md = NULL; N = NV_LENGTH_OMP(x); xd = NV_DATA_OMP(x); cd = NV_DATA_OMP(c); md = NV_DATA_OMP(m); temp = ZERO; #pragma omp parallel for default(none) private(i,test) shared(N,xd,cd,md,temp) \ schedule(static) num_threads(NV_NUM_THREADS_OMP(x)) for (i = 0; i < N; i++) { md[i] = ZERO; /* Continue if no constraints were set for the variable */ if (cd[i] == ZERO) continue; /* Check if a set constraint has been violated */ test = (SUNRabs(cd[i]) > ONEPT5 && xd[i]*cd[i] <= ZERO) || (SUNRabs(cd[i]) > HALF && xd[i]*cd[i] < ZERO); if (test) { temp = md[i] = ONE; /* Here is a race to write to temp */ } } /* Return false if any constraint was violated */ return (temp == ONE) ? SUNFALSE : SUNTRUE; } /* ---------------------------------------------------------------------------- * Compute minimum componentwise quotient */ realtype N_VMinQuotient_OpenMP(N_Vector num, N_Vector denom) { sunindextype i, N; realtype *nd, *dd, min, tmin, val; nd = dd = NULL; N = NV_LENGTH_OMP(num); nd = NV_DATA_OMP(num); dd = NV_DATA_OMP(denom); min = BIG_REAL; #pragma omp parallel default(none) private(i,tmin,val) shared(N,min,nd,dd) \ num_threads(NV_NUM_THREADS_OMP(num)) { tmin = BIG_REAL; #pragma omp for schedule(static) for (i = 0; i < N; i++) { if (dd[i] != ZERO) { val = nd[i]/dd[i]; if (val < tmin) tmin = val; } } if (tmin < min) { #pragma omp critical { if (tmin < min) min = tmin; } } } return(min); } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_OpenMP(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i; sunindextype j, N; realtype* zd=NULL; realtype* xd=NULL; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_OpenMP(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_OpenMP(c[0], X[0], c[1], X[1], z); return(0); } /* get vector length and data array */ N = NV_LENGTH_OMP(z); zd = NV_DATA_OMP(z); /* * X[0] += c[i]*X[i], i = 1,...,nvec-1 */ if ((X[0] == z) && (c[0] == ONE)) { #pragma omp parallel default(none) private(i,j,xd) shared(nvec,X,N,c,zd) \ num_threads(NV_NUM_THREADS_OMP(z)) { for (i=1; i ZERO) sum += SUNSQR(xd[j] * wd[j]); } #pragma omp critical { nrm[i] += sum; } } } for (i=0; i 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_OpenMP(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length */ N = NV_LENGTH_OMP(X[0]); /* * Y[i][j] += a[i] * x[j] */ if (Y == Z) { #pragma omp parallel default(none) private(i,j,k,xd,yd) shared(nvec,nsum,X,Y,N,a) \ num_threads(NV_NUM_THREADS_OMP(X[0])) { for (i=0; i 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_OpenMP; v->ops->nvscaleaddmulti = N_VScaleAddMulti_OpenMP; v->ops->nvdotprodmulti = N_VDotProdMulti_OpenMP; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_OpenMP; v->ops->nvscalevectorarray = N_VScaleVectorArray_OpenMP; v->ops->nvconstvectorarray = N_VConstVectorArray_OpenMP; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_OpenMP; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_OpenMP; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_OpenMP; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_OpenMP; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_OpenMP; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_OpenMP; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_OpenMP; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_OpenMP; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_OpenMP; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_OpenMP; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_OpenMP; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_OpenMP; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_OpenMP; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_OpenMP(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_OpenMP; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/nvector/openmp/fnvector_openmp.c0000644000176200001440000000733313766554457021624 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Steven Smith @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_openmp.h) contains the * implementation needed for the Fortran initialization of openmp * vector operations. * ----------------------------------------------------------------- */ #include #include #include "fnvector_openmp.h" /* Define global vector variables */ N_Vector F2C_CVODE_vec; N_Vector F2C_CVODE_vecQ; N_Vector *F2C_CVODE_vecS; N_Vector F2C_CVODE_vecB; N_Vector F2C_CVODE_vecQB; N_Vector F2C_IDA_vec; N_Vector F2C_IDA_vecQ; N_Vector *F2C_IDA_vecS; N_Vector F2C_IDA_vecB; N_Vector F2C_IDA_vecQB; N_Vector F2C_KINSOL_vec; N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FNV_INITOMP(int *code, long int *N, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vec = NULL; F2C_CVODE_vec = N_VNewEmpty_OpenMP(*N, *num_threads); if (F2C_CVODE_vec == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vec = NULL; F2C_IDA_vec = N_VNewEmpty_OpenMP(*N, *num_threads); if (F2C_IDA_vec == NULL) *ier = -1; break; case FCMIX_KINSOL: F2C_KINSOL_vec = NULL; F2C_KINSOL_vec = N_VNewEmpty_OpenMP(*N, *num_threads); if (F2C_KINSOL_vec == NULL) *ier = -1; break; case FCMIX_ARKODE: F2C_ARKODE_vec = NULL; F2C_ARKODE_vec = N_VNewEmpty_OpenMP(*N, *num_threads); if (F2C_ARKODE_vec == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITOMP_Q(int *code, long int *Nq, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQ = NULL; F2C_CVODE_vecQ = N_VNewEmpty_OpenMP(*Nq, *num_threads); if (F2C_CVODE_vecQ == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQ = NULL; F2C_IDA_vecQ = N_VNewEmpty_OpenMP(*Nq, *num_threads); if (F2C_IDA_vecQ == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITOMP_B(int *code, long int *NB, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecB = NULL; F2C_CVODE_vecB = N_VNewEmpty_OpenMP(*NB, *num_threads); if (F2C_CVODE_vecB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecB = NULL; F2C_IDA_vecB = N_VNewEmpty_OpenMP(*NB, *num_threads); if (F2C_IDA_vecB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITOMP_QB(int *code, long int *NqB, int *num_threads, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecQB = NULL; F2C_CVODE_vecQB = N_VNewEmpty_OpenMP(*NqB, *num_threads); if (F2C_CVODE_vecQB == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecQB = NULL; F2C_IDA_vecQB = N_VNewEmpty_OpenMP(*NqB, *num_threads); if (F2C_IDA_vecQB == NULL) *ier = -1; break; default: *ier = -1; } } void FNV_INITOMP_S(int *code, int *Ns, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: F2C_CVODE_vecS = NULL; F2C_CVODE_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_OpenMP(*Ns, F2C_CVODE_vec); if (F2C_CVODE_vecS == NULL) *ier = -1; break; case FCMIX_IDA: F2C_IDA_vecS = NULL; F2C_IDA_vecS = (N_Vector *) N_VCloneVectorArrayEmpty_OpenMP(*Ns, F2C_IDA_vec); if (F2C_IDA_vecS == NULL) *ier = -1; break; default: *ier = -1; } } StanHeaders/src/nvector/openmp/fnvector_openmp.h0000644000176200001440000000540213766554457021624 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Steven Smith @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file (companion of nvector_openmp.h) contains the * definitions needed for the initialization of openmp * vector operations in Fortran. * ----------------------------------------------------------------- */ #ifndef _FNVECTOR_OPENMP_H #define _FNVECTOR_OPENMP_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FNV_INITOMP SUNDIALS_F77_FUNC(fnvinitomp, FNVINITOMP) #else #define FNV_INITOMP fnvinitomp_ #endif #if defined(SUNDIALS_F77_FUNC_) #define FNV_INITOMP_Q SUNDIALS_F77_FUNC_(fnvinitomp_q, FNVINITOMP_Q) #define FNV_INITOMP_S SUNDIALS_F77_FUNC_(fnvinitomp_s, FNVINITOMP_S) #define FNV_INITOMP_B SUNDIALS_F77_FUNC_(fnvinitomp_b, FNVINITOMP_B) #define FNV_INITOMP_QB SUNDIALS_F77_FUNC_(fnvinitomp_qb, FNVINITOMP_QB) #else #define FNV_INITOMP_Q fnvinitomp_q_ #define FNV_INITOMP_S fnvinitomp_s_ #define FNV_INITOMP_B fnvinitomp_b_ #define FNV_INITOMP_QB fnvinitomp_qb_ #endif /* Declarations of global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_CVODE_vecQ; extern N_Vector *F2C_CVODE_vecS; extern N_Vector F2C_CVODE_vecB; extern N_Vector F2C_CVODE_vecQB; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_IDA_vecQ; extern N_Vector *F2C_IDA_vecS; extern N_Vector F2C_IDA_vecB; extern N_Vector F2C_IDA_vecQB; extern N_Vector F2C_KINSOL_vec; extern N_Vector F2C_ARKODE_vec; /* * Prototypes of exported functions * * FNV_INITOMP - initializes openmp vector operations for main problem * FNV_INITOMP_Q - initializes openmp vector operations for quadratures * FNV_INITOMP_S - initializes openmp vector operations for sensitivities * FNV_INITOMP_B - initializes openmp vector operations for adjoint problem * FNV_INITOMP_QB - initializes openmp vector operations for adjoint quadratures * */ void FNV_INITOMP(int *code, long int *neq, int *num_threads, int *ier); void FNV_INITOMP_Q(int *code, long int *Nq, int *num_threads, int *ier); void FNV_INITOMP_S(int *code, int *Ns, int *ier); void FNV_INITOMP_B(int *code, long int *NB, int *num_threads, int *ier); void FNV_INITOMP_QB(int *code, long int *NqB, int *num_threads, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/nvector/openmp/F90/0000755000176200001440000000000013766554135016575 5ustar liggesusersStanHeaders/src/nvector/openmp/F90/fnvector_openmp.f900000644000176200001440000004163713766554457022343 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS OpenMP NVector using the ISO_C_BINDING module. ! ----------------------------------------------------------------- module fnvector_openmp_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= ! ----------------------------------------------------------------- ! N_VNew_OpenMP ! ----------------------------------------------------------------- type(c_ptr) function FN_VNew_OpenMP(vec_length, num_threads) & bind(C,name='N_VNew_OpenMP') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: vec_length integer(c_int), value :: num_threads end function FN_VNew_OpenMP ! ----------------------------------------------------------------- ! N_VNewEmpty_OpenMP ! ----------------------------------------------------------------- type(c_ptr) function FN_VNewEmpty_OpenMP(vec_length, num_threads) & bind(C,name='N_VNewEmpty_OpenMP') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: vec_length integer(c_int), value :: num_threads end function FN_VNewEmpty_OpenMP ! ----------------------------------------------------------------- ! N_VMake_OpenMP ! ----------------------------------------------------------------- type(c_ptr) function FN_VMake_OpenMP(length, v_data, num_threads) & bind(C,name='N_VMake_OpenMP') use, intrinsic :: iso_c_binding implicit none integer(c_long), value :: length real(c_double) :: v_data(length) integer(c_int), value :: num_threads end function FN_VMake_OpenMP ! ----------------------------------------------------------------- ! N_VCloneVectorArray_OpenMP: NOT INTERFACED ! ----------------------------------------------------------------- ! ----------------------------------------------------------------- ! N_VCloneVectorArrayEmpty_OpenMP: NOT INTERFACED ! ----------------------------------------------------------------- ! ================================================================= ! Destructors ! ================================================================= ! ----------------------------------------------------------------- ! N_VDestroy_OpenMP ! ----------------------------------------------------------------- subroutine FN_VDestroy_OpenMP(v) & bind(C,name='N_VDestroy_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end subroutine FN_VDestroy_OpenMP ! ----------------------------------------------------------------- ! N_VDestroyVectorArray_OpenMP: NOT INTERFACED ! ----------------------------------------------------------------- ! ================================================================= ! Other routines ! ================================================================= ! ----------------------------------------------------------------- ! N_VGetLength_OpenMP ! ----------------------------------------------------------------- integer(c_long) function FN_VGetLength_OpenMP(v) & bind(C,name='N_VGetLength_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end function FN_VGetLength_OpenMP ! ----------------------------------------------------------------- ! N_VPrint_OpenMP ! ----------------------------------------------------------------- subroutine FN_VPrint_OpenMP(v) & bind(C,name='N_VPrint_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end subroutine FN_VPrint_OpenMP ! ----------------------------------------------------------------- ! NOT INTERFACED: N_VPrintFile_OpenMP ! ----------------------------------------------------------------- ! ================================================================= ! Operations ! ================================================================= ! ----------------------------------------------------------------- ! N_VGetVectorID_OpenMP ! ----------------------------------------------------------------- integer(c_int) function FN_VGetVectorID_OpenMP(v) & bind(C,name='N_VGetVectorID_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v end function FN_VGetVectorID_OpenMP ! ----------------------------------------------------------------- ! N_VCloneEmpty_OpenMP ! ----------------------------------------------------------------- type(c_ptr) function FN_VCloneEmpty_OpenMP(w) & bind(C,name='N_VCloneEmpty_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: w end function FN_VCloneEmpty_OpenMP ! ----------------------------------------------------------------- ! N_VClone_OpenMP ! ----------------------------------------------------------------- type(c_ptr) function FN_VClone_OpenMP(w) & bind(C,name='N_VClone_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: w end function FN_VClone_OpenMP ! ----------------------------------------------------------------- ! N_VSpace_OpenMP ! ----------------------------------------------------------------- subroutine FN_VSpace_OpenMP(v, lrw, liw) & bind(C,name='N_VSpace_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v integer(c_long) :: lrw integer(c_long) :: liw end subroutine FN_VSpace_OpenMP ! ----------------------------------------------------------------- ! N_VGetArrayPointer_OpenMP ! ----------------------------------------------------------------- type(c_ptr) function FN_VGetArrayPointer_OpenMP(vec) & bind(C,name='N_VGetArrayPointer_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: vec end function FN_VGetArrayPointer_OpenMP ! ----------------------------------------------------------------- ! N_VSetArrayPointer_OpenMP ! ----------------------------------------------------------------- subroutine FN_VSetArrayPointer_OpenMP(v_data, v) & bind(C,name='N_VSetArrayPointer_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: v_data type(c_ptr), value :: v end subroutine FN_VSetArrayPointer_OpenMP ! ----------------------------------------------------------------- ! N_VLinearSum_OpenMP ! ----------------------------------------------------------------- subroutine FN_VLinearSum_OpenMP(a, x, b, y, z) & bind(C,name='N_VLinearSum_OpenMP') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: a type(c_ptr), value :: x real(c_double), value :: b type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VLinearSum_OpenMP ! ----------------------------------------------------------------- ! N_VConst_OpenMP ! ----------------------------------------------------------------- subroutine FN_VConst_OpenMP(c, z) & bind(C,name='N_VConst_OpenMP') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: z end subroutine FN_VConst_OpenMP ! ----------------------------------------------------------------- ! N_VProd_OpenMP ! ----------------------------------------------------------------- subroutine FN_VProd_OpenMP(x, y, z) & bind(C,name='N_VProd_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VProd_OpenMP ! ----------------------------------------------------------------- ! N_VDiv_OpenMP ! ----------------------------------------------------------------- subroutine FN_VDiv_OpenMP(x, y, z) & bind(C,name='N_VDiv_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y type(c_ptr), value :: z end subroutine FN_VDiv_OpenMP ! ----------------------------------------------------------------- ! N_VScale_OpenMP ! ----------------------------------------------------------------- subroutine FN_VScale_OpenMP(c, x, z) & bind(C,name='N_VScale_OpenMP') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VScale_OpenMP ! ----------------------------------------------------------------- ! N_VAbs_OpenMP ! ----------------------------------------------------------------- subroutine FN_VAbs_OpenMP(x, z) & bind(C,name='N_VAbs_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VAbs_OpenMP ! ----------------------------------------------------------------- ! N_VInv_OpenMP ! ----------------------------------------------------------------- subroutine FN_VInv_OpenMP(x, z) & bind(C,name='N_VInv_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VInv_OpenMP ! ----------------------------------------------------------------- ! N_VAddConst ! ----------------------------------------------------------------- subroutine FN_VAddConst_OpenMP(x, b, z) & bind(C,name='N_VAddConst_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x real(c_double), value :: b type(c_ptr), value :: z end subroutine FN_VAddConst_OpenMP ! ----------------------------------------------------------------- ! N_VDotProd_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VDotProd_OpenMP(x, y) & bind(C,name='N_VDotProd_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: y end function FN_VDotProd_OpenMP ! ----------------------------------------------------------------- ! N_VMaxNorm_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VMaxNorm_OpenMP(x) & bind(C,name='N_VMaxNorm_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VMaxNorm_OpenMP ! ----------------------------------------------------------------- ! N_VWrmsNorm_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VWrmsNorm_OpenMP(x, w) & bind(C,name='N_VWrmsNorm_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w end function FN_VWrmsNorm_OpenMP ! ----------------------------------------------------------------- ! N_VWrmsNormMask_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VWrmsNormMask_OpenMP(x, w, id) & bind(C,name='N_VWrmsNormMask_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w type(c_ptr), value :: id end function FN_VWrmsNormMask_OpenMP ! ----------------------------------------------------------------- ! N_VMin_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VMin_OpenMP(x) & bind(C,name='N_VMin_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VMin_OpenMP ! ----------------------------------------------------------------- ! N_VWL2Norm_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VWL2Norm_OpenMP(x, w) & bind(C,name='N_VWL2Norm_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: w end function FN_VWL2Norm_OpenMP ! ----------------------------------------------------------------- ! N_VL1Norm_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VL1Norm_OpenMP(x) & bind(C,name='N_VL1Norm_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x end function FN_VL1Norm_OpenMP ! ----------------------------------------------------------------- ! N_VCompare_OpenMP ! ----------------------------------------------------------------- subroutine FN_VCompare_OpenMP(c, x, z) & bind(C,name='N_VCompare_OpenMP') use, intrinsic :: iso_c_binding implicit none real(c_double), value :: c type(c_ptr), value :: x type(c_ptr), value :: z end subroutine FN_VCompare_OpenMP ! ----------------------------------------------------------------- ! N_VInvTest_OpenMP ! ----------------------------------------------------------------- integer(c_int) function FN_VInvTest_OpenMP(x, z) & bind(C,name='N_VInvTest_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: x type(c_ptr), value :: z end function FN_VInvTest_OpenMP ! ----------------------------------------------------------------- ! N_VConstrMask_OpenMP ! ----------------------------------------------------------------- integer(c_int) function FN_VConstrMask_OpenMP(c, x, m) & bind(C,name='N_VConstrMask_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: c type(c_ptr), value :: x type(c_ptr), value :: m end function FN_VConstrMask_OpenMP ! ----------------------------------------------------------------- ! N_VMinQuotient_OpenMP ! ----------------------------------------------------------------- real(c_double) function FN_VMinQuotient_OpenMP(num, denom) & bind(C,name='N_VMinQuotient_OpenMP') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: num type(c_ptr), value :: denom end function FN_VMinQuotient_OpenMP ! ================================================================ ! Fused vector operations: NOT INTERFACED ! ================================================================ ! ================================================================ ! Vector array operations: NOT INTERFACED ! ================================================================ end interface contains ! ================================================================ ! Helpful routines ! ================================================================ ! ---------------------------------------------------------------- ! FN_VGetData_OpenMP ! ! Extracts data array from a OpenMP SUNDIALS N_Vector ! ---------------------------------------------------------------- subroutine FN_VGetData_OpenMP(vec, f_array) !======= Inclusions =========== use, intrinsic :: iso_c_binding !======= Declarations ========= implicit none ! calling variables type(c_ptr) :: vec integer(c_long) :: length real(c_double), pointer :: f_array(:) ! C pointer for N_Vector interal data array type(c_ptr) :: c_array !======= Internals ============ ! get data pointer from N_Vector c_array = FN_VGetArrayPointer_OpenMP(vec) ! get vector length length = FN_VGetLength_OpenMP(vec) ! convert c pointer to f pointer call c_f_pointer(c_array, f_array, (/length/)) end subroutine FN_VGetData_OpenMP end module fnvector_openmp_mod StanHeaders/src/nvector/openmpdev/0000755000176200001440000000000013766554135016736 5ustar liggesusersStanHeaders/src/nvector/openmpdev/nvector_openmpdev.c0000644000176200001440000024050613766554457022655 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner and Shelby Lockhart @ LLNL * ----------------------------------------------------------------- * Acknowledgements: This NVECTOR module is based on the NVECTOR * Serial module by Scott D. Cohen, Alan C. * Hindmarsh, Radu Serban, and Aaron Collier * @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for an OpenMP DEV implementation * of the NVECTOR module. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Private functions for special cases of vector operations */ static void VCopy_OpenMPDEV(N_Vector x, N_Vector z); /* z=x */ static void VSum_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z); /* z=x+y */ static void VDiff_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z); /* z=x-y */ static void VNeg_OpenMPDEV(N_Vector x, N_Vector z); /* z=-x */ static void VScaleSum_OpenMPDEV(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x+y) */ static void VScaleDiff_OpenMPDEV(realtype c, N_Vector x, N_Vector y, N_Vector z); /* z=c(x-y) */ static void VLin1_OpenMPDEV(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax+y */ static void VLin2_OpenMPDEV(realtype a, N_Vector x, N_Vector y, N_Vector z); /* z=ax-y */ static void Vaxpy_OpenMPDEV(realtype a, N_Vector x, N_Vector y); /* y <- ax+y */ static void VScaleBy_OpenMPDEV(realtype a, N_Vector x); /* x <- ax */ /* Private functions for special cases of vector array operations */ static int VSumVectorArray_OpenMPDEV(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X+Y */ static int VDiffVectorArray_OpenMPDEV(int nvec, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=X-Y */ static int VScaleSumVectorArray_OpenMPDEV(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X+Y) */ static int VScaleDiffVectorArray_OpenMPDEV(int nvec, realtype c, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=c(X-Y) */ static int VLin1VectorArray_OpenMPDEV(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX+Y */ static int VLin2VectorArray_OpenMPDEV(int nvec, realtype a, N_Vector* X, N_Vector* Y, N_Vector* Z); /* Z=aX-Y */ static int VaxpyVectorArray_OpenMPDEV(int nvec, realtype a, N_Vector* X, N_Vector* Y); /* Y <- aX+Y */ /* * ----------------------------------------------------------------- * exported functions * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_OpenMPDEV(N_Vector v) { return SUNDIALS_NVEC_OPENMPDEV; } /* ---------------------------------------------------------------------------- * Function to create a new empty vector */ N_Vector N_VNewEmpty_OpenMPDEV(sunindextype length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_OpenMPDEV content; /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_OpenMPDEV; ops->nvclone = N_VClone_OpenMPDEV; ops->nvcloneempty = N_VCloneEmpty_OpenMPDEV; ops->nvdestroy = N_VDestroy_OpenMPDEV; ops->nvspace = N_VSpace_OpenMPDEV; ops->nvgetarraypointer = NULL; ops->nvsetarraypointer = NULL; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_OpenMPDEV; ops->nvconst = N_VConst_OpenMPDEV; ops->nvprod = N_VProd_OpenMPDEV; ops->nvdiv = N_VDiv_OpenMPDEV; ops->nvscale = N_VScale_OpenMPDEV; ops->nvabs = N_VAbs_OpenMPDEV; ops->nvinv = N_VInv_OpenMPDEV; ops->nvaddconst = N_VAddConst_OpenMPDEV; ops->nvdotprod = N_VDotProd_OpenMPDEV; ops->nvmaxnorm = N_VMaxNorm_OpenMPDEV; ops->nvwrmsnormmask = N_VWrmsNormMask_OpenMPDEV; ops->nvwrmsnorm = N_VWrmsNorm_OpenMPDEV; ops->nvmin = N_VMin_OpenMPDEV; ops->nvwl2norm = N_VWL2Norm_OpenMPDEV; ops->nvl1norm = N_VL1Norm_OpenMPDEV; ops->nvcompare = N_VCompare_OpenMPDEV; ops->nvinvtest = N_VInvTest_OpenMPDEV; ops->nvconstrmask = N_VConstrMask_OpenMPDEV; ops->nvminquotient = N_VMinQuotient_OpenMPDEV; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_OpenMPDEV) malloc(sizeof(struct _N_VectorContent_OpenMPDEV)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = length; content->own_data = SUNFALSE; content->host_data = NULL; content->dev_data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Function to create a new vector */ N_Vector N_VNew_OpenMPDEV(sunindextype length) { N_Vector v; realtype *data; realtype *dev_data; int dev; v = NULL; v = N_VNewEmpty_OpenMPDEV(length); if (v == NULL) return(NULL); /* Create data */ if (length > 0) { /* Allocate memory on host */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); /* Allocate memory on device */ dev = omp_get_default_device(); dev_data = omp_target_alloc(length * sizeof(realtype), dev); if(data == NULL) { N_VDestroy_OpenMPDEV(v); return(NULL); } /* Attach data */ NV_OWN_DATA_OMPDEV(v) = SUNTRUE; NV_DATA_HOST_OMPDEV(v) = data; NV_DATA_DEV_OMPDEV(v) = dev_data; } return(v); } /* ---------------------------------------------------------------------------- * Function to create a vector with user data component */ N_Vector N_VMake_OpenMPDEV(sunindextype length, realtype *h_vdata, realtype *d_vdata) { N_Vector v; int dev, host; if (h_vdata == NULL || d_vdata == NULL) return(NULL); v = NULL; v = N_VNewEmpty_OpenMPDEV(length); if (v == NULL) return(NULL); if (length > 0) { /* Get device and host identifiers */ dev = omp_get_default_device(); host = omp_get_initial_device(); /* Attach data */ NV_OWN_DATA_OMPDEV(v) = SUNFALSE; NV_DATA_HOST_OMPDEV(v) = h_vdata; NV_DATA_DEV_OMPDEV(v) = d_vdata; } return(v); } /* ---------------------------------------------------------------------------- * Function to create an array of new vectors. */ N_Vector *N_VCloneVectorArray_OpenMPDEV(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_OpenMPDEV(w); if (vs[j] == NULL) { N_VDestroyVectorArray_OpenMPDEV(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to create an array of new vectors with NULL data array. */ N_Vector *N_VCloneVectorArrayEmpty_OpenMPDEV(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_OpenMPDEV(w); if (vs[j] == NULL) { N_VDestroyVectorArray_OpenMPDEV(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_OpenMPDEV */ void N_VDestroyVectorArray_OpenMPDEV(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_OpenMPDEV(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------------------- * Function to return number of vector elements */ sunindextype N_VGetLength_OpenMPDEV(N_Vector v) { return NV_LENGTH_OMPDEV(v); } /* ---------------------------------------------------------------------------- * Function to return a pointer to the data array on the host. */ realtype *N_VGetHostArrayPointer_OpenMPDEV(N_Vector v) { return((realtype *) NV_DATA_HOST_OMPDEV(v)); } /* ---------------------------------------------------------------------------- * Function to return a pointer to the data array on the device. */ realtype *N_VGetDeviceArrayPointer_OpenMPDEV(N_Vector v) { return((realtype *) NV_DATA_DEV_OMPDEV(v)); } /* ---------------------------------------------------------------------------- * Function to print a vector to stdout */ void N_VPrint_OpenMPDEV(N_Vector x) { N_VPrintFile_OpenMPDEV(x, stdout); } /* ---------------------------------------------------------------------------- * Function to print a vector to outfile */ void N_VPrintFile_OpenMPDEV(N_Vector x, FILE *outfile) { sunindextype i, N; realtype *xd; xd = NULL; N = NV_LENGTH_OMPDEV(x); xd = NV_DATA_HOST_OMPDEV(x); for (i = 0; i < N; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%11.8Lg\n", xd[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%11.8g\n", xd[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); return; } /* ---------------------------------------------------------------------------- * Function to copy host array into device array */ void N_VCopyToDevice_OpenMPDEV(N_Vector x) { int dev, host; sunindextype length; realtype *host_ptr; realtype *dev_ptr; /* Get array information */ length = NV_LENGTH_OMPDEV(x); host_ptr = NV_DATA_HOST_OMPDEV(x); dev_ptr = NV_DATA_DEV_OMPDEV(x); /* Get device and host identifiers */ dev = omp_get_default_device(); host = omp_get_initial_device(); /* Copy array from host to device */ omp_target_memcpy(dev_ptr, host_ptr, sizeof(realtype) * length, 0, 0, dev, host); return; } /* ---------------------------------------------------------------------------- * Function to copy device array into host array */ void N_VCopyFromDevice_OpenMPDEV(N_Vector x) { int dev, host; sunindextype length; realtype *host_ptr; realtype *dev_ptr; /* Get array information */ length = NV_LENGTH_OMPDEV(x); host_ptr = NV_DATA_HOST_OMPDEV(x); dev_ptr = NV_DATA_DEV_OMPDEV(x); /* Get device and host identifiers */ dev = omp_get_default_device(); host = omp_get_initial_device(); /* Copy array from device to host */ omp_target_memcpy(host_ptr, dev_ptr, sizeof(realtype) * length, 0, 0, host, dev); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ /* ---------------------------------------------------------------------------- * Create new vector from existing vector without attaching data */ N_Vector N_VCloneEmpty_OpenMPDEV(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_OpenMPDEV content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_OpenMPDEV) malloc(sizeof(struct _N_VectorContent_OpenMPDEV)); if (content == NULL) { free(ops); free(v); return(NULL); } content->length = NV_LENGTH_OMPDEV(w); content->own_data = SUNFALSE; content->host_data = NULL; content->dev_data = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------------------- * Create new vector from existing vector and attach data */ N_Vector N_VClone_OpenMPDEV(N_Vector w) { N_Vector v; realtype *data; realtype *dev_data; sunindextype length; int dev; v = NULL; v = N_VCloneEmpty_OpenMPDEV(w); if (v == NULL) return(NULL); length = NV_LENGTH_OMPDEV(w); /* Create data */ if (length > 0) { /* Allocate memory on host */ data = NULL; data = (realtype *) malloc(length * sizeof(realtype)); /* Allocate memory on device */ dev = omp_get_default_device(); dev_data = omp_target_alloc(length * sizeof(realtype), dev); if(data == NULL) { N_VDestroy_OpenMPDEV(v); return(NULL); } /* Attach data */ NV_OWN_DATA_OMPDEV(v) = SUNTRUE; NV_DATA_HOST_OMPDEV(v)= data; NV_DATA_DEV_OMPDEV(v) = dev_data; } return(v); } /* ---------------------------------------------------------------------------- * Destroy vector and free vector memory */ void N_VDestroy_OpenMPDEV(N_Vector v) { int dev; if (NV_OWN_DATA_OMPDEV(v) == SUNTRUE) { /* Free host memory */ free(NV_DATA_HOST_OMPDEV(v)); NV_DATA_HOST_OMPDEV(v) = NULL; /* Free device memory */ dev = omp_get_default_device(); omp_target_free(NV_DATA_DEV_OMPDEV(v), dev); NV_DATA_DEV_OMPDEV(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } /* ---------------------------------------------------------------------------- * Get storage requirement for N_Vector */ void N_VSpace_OpenMPDEV(N_Vector v, sunindextype *lrw, sunindextype *liw) { *lrw = NV_LENGTH_OMPDEV(v); *liw = 1; return; } /* ---------------------------------------------------------------------------- * Compute linear combination z[i] = a*x[i]+b*y[i] */ void N_VLinearSum_OpenMPDEV(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { sunindextype i, N; realtype c, *xd_dev, *yd_dev, *zd_dev; N_Vector v1, v2; booleantype test; int dev; xd_dev = yd_dev = zd_dev = NULL; if ((b == ONE) && (z == y)) { /* BLAS usage: axpy y <- ax+y */ Vaxpy_OpenMPDEV(a,x,y); return; } if ((a == ONE) && (z == x)) { /* BLAS usage: axpy x <- by+x */ Vaxpy_OpenMPDEV(b,y,x); return; } /* Case: a == b == 1.0 */ if ((a == ONE) && (b == ONE)) { VSum_OpenMPDEV(x, y, z); return; } /* Cases: (1) a == 1.0, b = -1.0, (2) a == -1.0, b == 1.0 */ if ((test = ((a == ONE) && (b == -ONE))) || ((a == -ONE) && (b == ONE))) { v1 = test ? y : x; v2 = test ? x : y; VDiff_OpenMPDEV(v2, v1, z); return; } /* Cases: (1) a == 1.0, b == other or 0.0, (2) a == other or 0.0, b == 1.0 */ /* if a or b is 0.0, then user should have called N_VScale */ if ((test = (a == ONE)) || (b == ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin1_OpenMPDEV(c, v1, v2, z); return; } /* Cases: (1) a == -1.0, b != 1.0, (2) a != 1.0, b == -1.0 */ if ((test = (a == -ONE)) || (b == -ONE)) { c = test ? b : a; v1 = test ? y : x; v2 = test ? x : y; VLin2_OpenMPDEV(c, v1, v2, z); return; } /* Case: a == b */ /* catches case both a and b are 0.0 - user should have called N_VConst */ if (a == b) { VScaleSum_OpenMPDEV(a, x, y, z); return; } /* Case: a == -b */ if (a == -b) { VScaleDiff_OpenMPDEV(a, x, y, z); return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); yd_dev = NV_DATA_DEV_OMPDEV(y); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N,a,b) is_device_ptr(xd_dev, yd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = (a*xd_dev[i])+(b*yd_dev[i]); return; } /* ---------------------------------------------------------------------------- * Assigns constant value to all vector elements, z[i] = c */ void N_VConst_OpenMPDEV(realtype c, N_Vector z) { sunindextype i, N; realtype *zd_dev; int dev; zd_dev = NULL; N = NV_LENGTH_OMPDEV(z); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N,c) is_device_ptr(zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = c; return; } /* ---------------------------------------------------------------------------- * Compute componentwise product z[i] = x[i]*y[i] */ void N_VProd_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd_dev, *yd_dev, *zd_dev; int dev; xd_dev = yd_dev = zd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); yd_dev = NV_DATA_DEV_OMPDEV(y); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) is_device_ptr(xd_dev, yd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = xd_dev[i]*yd_dev[i]; return; } /* ---------------------------------------------------------------------------- * Compute componentwise division z[i] = x[i]/y[i] */ void N_VDiv_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z) { sunindextype i, N; realtype *xd_dev, *yd_dev, *zd_dev; int dev; xd_dev = yd_dev = zd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); yd_dev = NV_DATA_DEV_OMPDEV(y); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) is_device_ptr(xd_dev, yd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = xd_dev[i]/yd_dev[i]; return; } /* ---------------------------------------------------------------------------- * Compute scaler multiplication z[i] = c*x[i] */ void N_VScale_OpenMPDEV(realtype c, N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd_dev, *zd_dev; int dev; xd_dev = zd_dev = NULL; if (z == x) { /* BLAS usage: scale x <- cx */ VScaleBy_OpenMPDEV(c, x); return; } if (c == ONE) { VCopy_OpenMPDEV(x, z); } else if (c == -ONE) { VNeg_OpenMPDEV(x, z); } else { N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N,c) is_device_ptr(xd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = c*xd_dev[i]; } return; } /* ---------------------------------------------------------------------------- * Compute absolute value of vector components z[i] = SUNRabs(x[i]) */ void N_VAbs_OpenMPDEV(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd_dev, *zd_dev; int dev; xd_dev = zd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) is_device_ptr(xd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = SUNRabs(xd_dev[i]); return; } /* ---------------------------------------------------------------------------- * Compute componentwise inverse z[i] = 1 / x[i] */ void N_VInv_OpenMPDEV(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd_dev, *zd_dev; int dev; xd_dev = zd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) is_device_ptr(xd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = ONE/xd_dev[i]; return; } /* ---------------------------------------------------------------------------- * Compute componentwise addition of a scaler to a vector z[i] = x[i] + b */ void N_VAddConst_OpenMPDEV(N_Vector x, realtype b, N_Vector z) { sunindextype i, N; realtype *xd_dev, *zd_dev; int dev; xd_dev = zd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N,b) is_device_ptr(xd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for schedule(static, 1) for (i = 0; i < N; i++) zd_dev[i] = xd_dev[i]+b; return; } /* ---------------------------------------------------------------------------- * Computes the dot product of two vectors, a = sum(x[i]*y[i]) */ realtype N_VDotProd_OpenMPDEV(N_Vector x, N_Vector y) { sunindextype i, N; realtype sum, *xd_dev, *yd_dev; int dev; xd_dev = yd_dev = NULL; sum = ZERO; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); yd_dev = NV_DATA_DEV_OMPDEV(y); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(tofrom:sum) is_device_ptr(xd_dev, yd_dev) device(dev) #pragma omp teams distribute parallel for reduction(+:sum) schedule(static, 1) for (i = 0; i < N; i++) { sum += xd_dev[i]*yd_dev[i]; } return(sum); } /* ---------------------------------------------------------------------------- * Computes max norm of a vector */ realtype N_VMaxNorm_OpenMPDEV(N_Vector x) { sunindextype i, N; realtype max, *xd_dev; int dev; max = ZERO; xd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(tofrom:max) is_device_ptr(xd_dev) device(dev) #pragma omp teams distribute parallel for reduction(max:max) schedule(static, 1) for (i = 0; i < N; i++) { max = SUNMAX(SUNRabs(xd_dev[i]), max); } return(max); } /* ---------------------------------------------------------------------------- * Computes weighted root mean square norm of a vector */ realtype N_VWrmsNorm_OpenMPDEV(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, *xd_dev, *wd_dev; int dev; sum = ZERO; xd_dev = wd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); wd_dev = NV_DATA_DEV_OMPDEV(w); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(tofrom:sum) is_device_ptr(xd_dev, wd_dev) device(dev) #pragma omp teams distribute parallel for reduction(+:sum) schedule(static, 1) for (i = 0; i < N; i++) { sum += SUNSQR(xd_dev[i]*wd_dev[i]); } return(SUNRsqrt(sum/N)); } /* ---------------------------------------------------------------------------- * Computes weighted root mean square norm of a masked vector */ realtype N_VWrmsNormMask_OpenMPDEV(N_Vector x, N_Vector w, N_Vector id) { sunindextype i, N; realtype sum, *xd_dev, *wd_dev, *idd_dev; int dev; sum = ZERO; xd_dev = wd_dev = idd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); wd_dev = NV_DATA_DEV_OMPDEV(w); idd_dev = NV_DATA_DEV_OMPDEV(id); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(tofrom:sum) is_device_ptr(xd_dev, wd_dev, idd_dev) device(dev) #pragma omp teams distribute parallel for reduction(+:sum) schedule(static, 1) for (i = 0; i < N; i++) { if (idd_dev[i] > ZERO) { sum += SUNSQR(xd_dev[i]*wd_dev[i]); } } return(SUNRsqrt(sum / N)); } /* ---------------------------------------------------------------------------- * Finds the minimun component of a vector */ realtype N_VMin_OpenMPDEV(N_Vector x) { sunindextype i, N; realtype min, *xd_dev; int dev; xd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(from:min) is_device_ptr(xd_dev) device(dev) #pragma omp teams num_teams(1) { min = xd_dev[0]; #pragma omp distribute parallel for reduction(min:min) schedule(static, 1) for (i = 1; i < N; i++) { min = SUNMIN(xd_dev[i], min); } } return(min); } /* ---------------------------------------------------------------------------- * Computes weighted L2 norm of a vector */ realtype N_VWL2Norm_OpenMPDEV(N_Vector x, N_Vector w) { sunindextype i, N; realtype sum, *xd_dev, *wd_dev; int dev; sum = ZERO; xd_dev = wd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); wd_dev = NV_DATA_DEV_OMPDEV(w); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(tofrom:sum) is_device_ptr(xd_dev, wd_dev) device(dev) #pragma omp teams distribute parallel for reduction(+:sum) schedule(static, 1) for (i = 0; i < N; i++) { sum += SUNSQR(xd_dev[i]*wd_dev[i]); } return(SUNRsqrt(sum)); } /* ---------------------------------------------------------------------------- * Computes L1 norm of a vector */ realtype N_VL1Norm_OpenMPDEV(N_Vector x) { sunindextype i, N; realtype sum, *xd_dev; int dev; sum = ZERO; xd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); /* get default device identifier */ dev = omp_get_default_device(); #pragma omp target map(to:N) map(tofrom:sum) is_device_ptr(xd_dev) device(dev) #pragma omp teams distribute parallel for reduction(+:sum) schedule(static, 1) for (i = 0; i= c) ? ONE : ZERO; return; } /* ---------------------------------------------------------------------------- * Compute componentwise inverse z[i] = ONE/x[i] and checks if x[i] == ZERO */ booleantype N_VInvTest_OpenMPDEV(N_Vector x, N_Vector z) { sunindextype i, N; realtype *xd_dev, *zd_dev, val; int dev; xd_dev = zd_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); val = ZERO; #pragma omp target map(to:N) map(tofrom:val) is_device_ptr(xd_dev, zd_dev) device(dev) #pragma omp teams distribute parallel for reduction(max:val) schedule(static, 1) for (i = 0; i < N; i++) { if (xd_dev[i] == ZERO) val = ONE; else zd_dev[i] = ONE/xd_dev[i]; } if (val > ZERO) return (SUNFALSE); else return (SUNTRUE); } /* ---------------------------------------------------------------------------- * Compute constraint mask of a vector */ booleantype N_VConstrMask_OpenMPDEV(N_Vector c, N_Vector x, N_Vector m) { sunindextype i, N; realtype temp; realtype *cd_dev, *xd_dev, *md_dev; int dev; cd_dev = xd_dev = md_dev = NULL; N = NV_LENGTH_OMPDEV(x); xd_dev = NV_DATA_DEV_OMPDEV(x); cd_dev = NV_DATA_DEV_OMPDEV(c); md_dev = NV_DATA_DEV_OMPDEV(m); /* get default device identifier */ dev = omp_get_default_device(); temp = ONE; #pragma omp target map(to:N) map(tofrom:temp) is_device_ptr(xd_dev, cd_dev, md_dev) device(dev) #pragma omp teams distribute parallel for reduction(min:temp) schedule(static, 1) for (i = 0; i < N; i++) { md_dev[i] = ZERO; if (cd_dev[i] == ZERO) continue; if (cd_dev[i] > ONEPT5 || cd_dev[i] < -ONEPT5) { if ( xd_dev[i]*cd_dev[i] <= ZERO) { temp = ZERO; md_dev[i] = ONE; } continue; } if ( cd_dev[i] > HALF || cd_dev[i] < -HALF) { if (xd_dev[i]*cd_dev[i] < ZERO ) { temp = ZERO; md_dev[i] = ONE; } } } if (temp == ONE) return (SUNTRUE); else return(SUNFALSE); } /* ---------------------------------------------------------------------------- * Compute minimum componentwise quotient */ realtype N_VMinQuotient_OpenMPDEV(N_Vector num, N_Vector denom) { sunindextype i, N; realtype *nd_dev, *dd_dev, min; int dev; nd_dev = dd_dev = NULL; N = NV_LENGTH_OMPDEV(num); nd_dev = NV_DATA_DEV_OMPDEV(num); dd_dev = NV_DATA_DEV_OMPDEV(denom); /* get default device identifier */ dev = omp_get_default_device(); min = BIG_REAL; #pragma omp target map(to:N) map(tofrom:min) is_device_ptr(nd_dev, dd_dev) device(dev) #pragma omp teams distribute parallel for reduction(min:min) schedule(static, 1) for (i = 0; i < N; i++) if (dd_dev[i] != ZERO) min = SUNMIN(nd_dev[i]/dd_dev[i], min); return(min); } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_OpenMPDEV(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i, dev; realtype to_add; /* temporary variable to hold sum being added in atomic operation */ sunindextype j, N; realtype* zd_dev=NULL; realtype* xd_dev=NULL; realtype** xd_dev_ptrs=NULL; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_OpenMPDEV(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_OpenMPDEV(c[0], X[0], c[1], X[1], z); return(0); } /* get vector length and data array */ N = NV_LENGTH_OMPDEV(z); zd_dev = NV_DATA_DEV_OMPDEV(z); /* get default device identifier */ dev = omp_get_default_device(); /* Allocate and store X dev pointers to copy to device */ xd_dev_ptrs = (realtype**) malloc(nvec * sizeof(realtype*)); for (i=0; i ZERO) sum += SUNSQR(xd_dev[j] * wd_dev[j]); } } nrm[i] = SUNRsqrt(sum/N); } } free(xd_dev_ptrs); free(wd_dev_ptrs); return(0); } int N_VScaleAddMultiVectorArray_OpenMPDEV(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z) { int i, j, dev; sunindextype k, N; realtype* xd_dev=NULL; realtype* yd_dev=NULL; realtype* zd_dev=NULL; realtype** xd_dev_ptrs=NULL; realtype** yd_dev_ptrs=NULL; realtype** zd_dev_ptrs=NULL; int retval; N_Vector* YY; N_Vector* ZZ; /* invalid number of vectors */ if (nvec < 1) return(-1); if (nsum < 1) return(-1); /* --------------------------- * Special cases for nvec == 1 * --------------------------- */ if (nvec == 1) { /* should have called N_VLinearSum */ if (nsum == 1) { N_VLinearSum_OpenMPDEV(a[0], X[0], ONE, Y[0][0], Z[0][0]); return(0); } /* should have called N_VScaleAddMulti */ YY = (N_Vector *) malloc(nsum * sizeof(N_Vector)); ZZ = (N_Vector *) malloc(nsum * sizeof(N_Vector)); for (j=0; j 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_OpenMPDEV(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length */ N = NV_LENGTH_OMPDEV(X[0]); /* get default device identifier */ dev = omp_get_default_device(); /* Allocate and store dev pointers to copy to device */ xd_dev_ptrs = (realtype**) malloc(nvec * sizeof(realtype*)); yd_dev_ptrs = (realtype**) malloc(nvec * nsum * sizeof(realtype*)); for (i=0; i 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_OpenMPDEV; v->ops->nvscaleaddmulti = N_VScaleAddMulti_OpenMPDEV; v->ops->nvdotprodmulti = N_VDotProdMulti_OpenMPDEV; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_OpenMPDEV; v->ops->nvscalevectorarray = N_VScaleVectorArray_OpenMPDEV; v->ops->nvconstvectorarray = N_VConstVectorArray_OpenMPDEV; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_OpenMPDEV; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_OpenMPDEV; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_OpenMPDEV; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_OpenMPDEV; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_OpenMPDEV; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_OpenMPDEV; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_OpenMPDEV; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_OpenMPDEV; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_OpenMPDEV; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_OpenMPDEV; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_OpenMPDEV; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_OpenMPDEV; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_OpenMPDEV; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_OpenMPDEV(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_OpenMPDEV; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/nvector/petsc/0000755000176200001440000000000013766554135016057 5ustar liggesusersStanHeaders/src/nvector/petsc/nvector_petsc.c0000644000176200001440000012163413766554457021117 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * Based on N_Vector_Parallel by Scott D. Cohen, Alan C. Hindmarsh, * Radu Serban, and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a PETSc implementation * of the NVECTOR package. * -----------------------------------------------------------------*/ #include #include #include #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) /* Error Message */ #define BAD_N1 "N_VNewEmpty_Petsc -- Sum of local vector lengths differs from " #define BAD_N2 "input global length. \n\n" #define BAD_N BAD_N1 BAD_N2 /* * ----------------------------------------------------------------- * Simplifying macros NV_CONTENT_PTC, NV_OWN_DATA_PTC, * NV_LOCLENGTH_PTC, NV_GLOBLENGTH_PTC, * NV_COMM_PTC * ----------------------------------------------------------------- * In the descriptions below, the following user declarations * are assumed: * * N_Vector v; * sunindextype v_len, s_len, i; * * (1) NV_CONTENT_PTC * * This routines gives access to the contents of the PETSc * vector wrapper N_Vector. * * The assignment v_cont = NV_CONTENT_PTC(v) sets v_cont to be * a pointer to the N_Vector (PETSc wrapper) content structure. * * (2) NV_PVEC_PTC, NV_OWN_DATA_PTC, NV_LOCLENGTH_PTC, NV_GLOBLENGTH_PTC, * and NV_COMM_PTC * * These routines give access to the individual parts of * the content structure of a PETSc N_Vector wrapper. * * NV_PVEC_PTC(v) returns the PETSc vector (Vec) object. * * The assignment v_llen = NV_LOCLENGTH_PTC(v) sets v_llen to * be the length of the local part of the vector v. The call * NV_LOCLENGTH_PTC(v) = llen_v should NOT be used! It will * change the value stored in the N_Vector content structure, * but it will NOT change the length of the actual PETSc vector. * * The assignment v_glen = NV_GLOBLENGTH_PTC(v) sets v_glen to * be the global length of the vector v. The call * NV_GLOBLENGTH_PTC(v) = glen_v should NOT be used! It will * change the value stored in the N_Vector content structure, * but it will NOT change the length of the actual PETSc vector. * * The assignment v_comm = NV_COMM_PTC(v) sets v_comm to be the * MPI communicator of the vector v. The assignment * NV_COMM_PTC(v) = comm_v should NOT be used! It will change * the value stored in the N_Vector content structure, but it * will NOT change the MPI communicator of the actual PETSc * vector. * * ----------------------------------------------------------------- */ #define NV_CONTENT_PTC(v) ( (N_VectorContent_Petsc)(v->content) ) #define NV_LOCLENGTH_PTC(v) ( NV_CONTENT_PTC(v)->local_length ) #define NV_GLOBLENGTH_PTC(v) ( NV_CONTENT_PTC(v)->global_length ) #define NV_OWN_DATA_PTC(v) ( NV_CONTENT_PTC(v)->own_data ) #define NV_PVEC_PTC(v) ( NV_CONTENT_PTC(v)->pvec ) #define NV_COMM_PTC(v) ( NV_CONTENT_PTC(v)->comm ) /* ---------------------------------------------------------------- * Returns vector type ID. Used to identify vector implementation * from abstract N_Vector interface. */ N_Vector_ID N_VGetVectorID_Petsc(N_Vector v) { return SUNDIALS_NVEC_PETSC; } /* ---------------------------------------------------------------- * Function to create a new N_Vector wrapper with an empty (NULL) * PETSc vector. */ N_Vector N_VNewEmpty_Petsc(MPI_Comm comm, sunindextype local_length, sunindextype global_length) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Petsc content; sunindextype n, Nsum; PetscErrorCode ierr; /* Compute global length as sum of local lengths */ n = local_length; ierr = MPI_Allreduce(&n, &Nsum, 1, PVEC_INTEGER_MPI_TYPE, MPI_SUM, comm); CHKERRABORT(comm,ierr); if (Nsum != global_length) { STAN_SUNDIALS_FPRINTF(stderr, BAD_N); return(NULL); } /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = N_VGetVectorID_Petsc; ops->nvclone = N_VClone_Petsc; ops->nvcloneempty = N_VCloneEmpty_Petsc; ops->nvdestroy = N_VDestroy_Petsc; ops->nvspace = N_VSpace_Petsc; ops->nvgetarraypointer = N_VGetArrayPointer_Petsc; ops->nvsetarraypointer = N_VSetArrayPointer_Petsc; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_Petsc; ops->nvconst = N_VConst_Petsc; ops->nvprod = N_VProd_Petsc; ops->nvdiv = N_VDiv_Petsc; ops->nvscale = N_VScale_Petsc; ops->nvabs = N_VAbs_Petsc; ops->nvinv = N_VInv_Petsc; ops->nvaddconst = N_VAddConst_Petsc; ops->nvdotprod = N_VDotProd_Petsc; ops->nvmaxnorm = N_VMaxNorm_Petsc; ops->nvwrmsnormmask = N_VWrmsNormMask_Petsc; ops->nvwrmsnorm = N_VWrmsNorm_Petsc; ops->nvmin = N_VMin_Petsc; ops->nvwl2norm = N_VWL2Norm_Petsc; ops->nvl1norm = N_VL1Norm_Petsc; ops->nvcompare = N_VCompare_Petsc; ops->nvinvtest = N_VInvTest_Petsc; ops->nvconstrmask = N_VConstrMask_Petsc; ops->nvminquotient = N_VMinQuotient_Petsc; /* fused vector operations (optional, NULL means disabled by default) */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations (optional, NULL means disabled by default) */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* Create content */ content = NULL; content = (N_VectorContent_Petsc) malloc(sizeof(struct _N_VectorContent_Petsc)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = local_length; content->global_length = global_length; content->comm = comm; content->own_data = SUNFALSE; content->pvec = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /* ---------------------------------------------------------------- * Function to create an N_Vector wrapper for a PETSc vector. */ N_Vector N_VMake_Petsc(Vec pvec) { N_Vector v = NULL; MPI_Comm comm; PetscInt local_length; PetscInt global_length; VecGetLocalSize(pvec, &local_length); VecGetSize(pvec, &global_length); PetscObjectGetComm((PetscObject) pvec, &comm); v = N_VNewEmpty_Petsc(comm, local_length, global_length); if (v == NULL) return(NULL); /* Attach data */ NV_OWN_DATA_PTC(v) = SUNFALSE; NV_PVEC_PTC(v) = pvec; return(v); } /* ---------------------------------------------------------------- * Function to create an array of new PETSc vector wrappers. */ N_Vector *N_VCloneVectorArray_Petsc(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VClone_Petsc(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Petsc(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to create an array of new PETSc vector wrappers with * empty (NULL) PETSc vectors. */ N_Vector *N_VCloneVectorArrayEmpty_Petsc(int count, N_Vector w) { N_Vector *vs; int j; if (count <= 0) return(NULL); vs = NULL; vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = NULL; vs[j] = N_VCloneEmpty_Petsc(w); if (vs[j] == NULL) { N_VDestroyVectorArray_Petsc(vs, j-1); return(NULL); } } return(vs); } /* ---------------------------------------------------------------- * Function to free an array created with N_VCloneVectorArray_Petsc */ void N_VDestroyVectorArray_Petsc(N_Vector *vs, int count) { int j; for (j = 0; j < count; j++) N_VDestroy_Petsc(vs[j]); free(vs); vs = NULL; return; } /* ---------------------------------------------------------------- * Function to extract PETSc vector */ Vec N_VGetVector_Petsc(N_Vector v) { return NV_PVEC_PTC(v); } /* ---------------------------------------------------------------- * Function to print the global data in a PETSc vector to stdout */ void N_VPrint_Petsc(N_Vector x) { Vec xv = NV_PVEC_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); VecView(xv, PETSC_VIEWER_STDOUT_(comm)); return; } /* ---------------------------------------------------------------- * Function to print the global data in a PETSc vector to fname */ void N_VPrintFile_Petsc(N_Vector x, const char fname[]) { Vec xv = NV_PVEC_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); PetscViewer viewer; PetscViewerASCIIOpen(comm, fname, &viewer); VecView(xv, viewer); PetscViewerDestroy(&viewer); return; } /* * ----------------------------------------------------------------- * implementation of vector operations * ----------------------------------------------------------------- */ N_Vector N_VCloneEmpty_Petsc(N_Vector w) { N_Vector v; N_Vector_Ops ops; N_VectorContent_Petsc content; if (w == NULL) return(NULL); /* Create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* Create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof(struct _generic_N_Vector_Ops)); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_Petsc) malloc(sizeof(struct _N_VectorContent_Petsc)); if (content == NULL) { free(ops); free(v); return(NULL); } /* Attach lengths and communicator */ content->local_length = NV_LOCLENGTH_PTC(w); content->global_length = NV_GLOBLENGTH_PTC(w); content->comm = NV_COMM_PTC(w); content->own_data = SUNFALSE; content->pvec = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } N_Vector N_VClone_Petsc(N_Vector w) { N_Vector v = NULL; Vec pvec = NULL; Vec wvec = NV_PVEC_PTC(w); /* PetscErrorCode ierr; */ v = N_VCloneEmpty_Petsc(w); if (v == NULL) return(NULL); /* Create data */ /* Allocate empty PETSc vector */ pvec = (Vec) malloc(sizeof(Vec)); if(pvec == NULL) { N_VDestroy_Petsc(v); return(NULL); } /* ierr = */ VecDuplicate(wvec, &pvec); if(pvec == NULL) { N_VDestroy_Petsc(v); return(NULL); } /* Attach data */ NV_OWN_DATA_PTC(v) = SUNTRUE; NV_PVEC_PTC(v) = pvec; return(v); } void N_VDestroy_Petsc(N_Vector v) { if (NV_OWN_DATA_PTC(v) == SUNTRUE) { VecDestroy(&(NV_PVEC_PTC(v))); NV_PVEC_PTC(v) = NULL; } free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } void N_VSpace_Petsc(N_Vector v, sunindextype *lrw, sunindextype *liw) { MPI_Comm comm; int npes; comm = NV_COMM_PTC(v); MPI_Comm_size(comm, &npes); *lrw = NV_GLOBLENGTH_PTC(v); *liw = 2*npes; return; } /* * Not implemented for PETSc wrapper. */ realtype *N_VGetArrayPointer_Petsc(N_Vector v) { return NULL; } /* * Not implemented for PETSc wrapper. */ void N_VSetArrayPointer_Petsc(realtype *v_data, N_Vector v) { return; } void N_VLinearSum_Petsc(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec yv = NV_PVEC_PTC(y); Vec zv = NV_PVEC_PTC(z); if (x == y) { N_VScale_Petsc(a + b, x, z); /* z <~ ax+bx */ return; } if (z == y) { if (b == ONE) { VecAXPY(yv, a, xv); /* BLAS usage: axpy y <- ax+y */ return; } VecAXPBY(yv, a, b, xv); /* BLAS usage: axpby y <- ax+by */ return; } if (z == x) { if (a == ONE) { VecAXPY(xv, b, yv); /* BLAS usage: axpy x <- by+x */ return; } VecAXPBY(xv, b, a, yv); /* BLAS usage: axpby x <- by+ax */ return; } /* Do all cases not handled above: (1) a == other, b == 0.0 - user should have called N_VScale (2) a == 0.0, b == other - user should have called N_VScale (3) a,b == other, a !=b, a != -b */ VecAXPBYPCZ(zv, a, b, 0.0, xv, yv); /* PETSc, probably not optimal */ return; } void N_VConst_Petsc(realtype c, N_Vector z) { Vec zv = NV_PVEC_PTC(z); VecSet(zv, c); return; } void N_VProd_Petsc(N_Vector x, N_Vector y, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec yv = NV_PVEC_PTC(y); Vec zv = NV_PVEC_PTC(z); VecPointwiseMult(zv, xv, yv); return; } void N_VDiv_Petsc(N_Vector x, N_Vector y, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec yv = NV_PVEC_PTC(y); Vec zv = NV_PVEC_PTC(z); VecPointwiseDivide(zv, xv, yv); /* z = x/y */ return; } void N_VScale_Petsc(realtype c, N_Vector x, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec zv = NV_PVEC_PTC(z); if (z == x) { /* BLAS usage: scale x <- cx */ VecScale(xv, c); return; } VecAXPBY(zv, c, 0.0, xv); return; } void N_VAbs_Petsc(N_Vector x, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec zv = NV_PVEC_PTC(z); if(z != x) VecCopy(xv, zv); /* copy x~>z */ VecAbs(zv); return; } void N_VInv_Petsc(N_Vector x, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec zv = NV_PVEC_PTC(z); if(z != x) VecCopy(xv, zv); /* copy x~>z */ VecReciprocal(zv); return; } void N_VAddConst_Petsc(N_Vector x, realtype b, N_Vector z) { Vec xv = NV_PVEC_PTC(x); Vec zv = NV_PVEC_PTC(z); if(z != x) VecCopy(xv, zv); /* copy x~>z */ VecShift(zv, b); return; } realtype N_VDotProd_Petsc(N_Vector x, N_Vector y) { Vec xv = NV_PVEC_PTC(x); Vec yv = NV_PVEC_PTC(y); PetscScalar dotprod; VecDot(xv, yv, &dotprod); return dotprod; } realtype N_VMaxNorm_Petsc(N_Vector x) { Vec xv = NV_PVEC_PTC(x); PetscReal norm; VecNorm(xv, NORM_INFINITY, &norm); return norm; } realtype N_VWrmsNorm_Petsc(N_Vector x, N_Vector w) { sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(x); sunindextype N_global = NV_GLOBLENGTH_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); Vec xv = NV_PVEC_PTC(x); Vec wv = NV_PVEC_PTC(w); PetscScalar *xd; PetscScalar *wd; PetscReal sum = ZERO; realtype global_sum; VecGetArray(xv, &xd); VecGetArray(wv, &wd); for (i = 0; i < N; i++) { sum += PetscSqr(PetscAbsScalar(xd[i] * wd[i])); } VecRestoreArray(xv, &xd); VecRestoreArray(wv, &wd); global_sum = SUNMPI_Allreduce_scalar(sum, 1, comm); return (SUNRsqrt(global_sum/N_global)); } realtype N_VWrmsNormMask_Petsc(N_Vector x, N_Vector w, N_Vector id) { sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(x); sunindextype N_global = NV_GLOBLENGTH_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); Vec xv = NV_PVEC_PTC(x); Vec wv = NV_PVEC_PTC(w); Vec idv = NV_PVEC_PTC(id); PetscScalar *xd; PetscScalar *wd; PetscScalar *idd; PetscReal sum = ZERO; realtype global_sum; VecGetArray(xv, &xd); VecGetArray(wv, &wd); VecGetArray(idv, &idd); for (i = 0; i < N; i++) { PetscReal tag = (PetscReal) idd[i]; if (tag > ZERO) { sum += PetscSqr(PetscAbsScalar(xd[i] * wd[i])); } } VecRestoreArray(xv, &xd); VecRestoreArray(wv, &wd); VecRestoreArray(idv, &idd); global_sum = SUNMPI_Allreduce_scalar(sum, 1, comm); return (SUNRsqrt(global_sum/N_global)); } realtype N_VMin_Petsc(N_Vector x) { Vec xv = NV_PVEC_PTC(x); PetscReal minval; PetscInt i; VecMin(xv, &i, &minval); return minval; } realtype N_VWL2Norm_Petsc(N_Vector x, N_Vector w) { sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); Vec xv = NV_PVEC_PTC(x); Vec wv = NV_PVEC_PTC(w); PetscScalar *xd; PetscScalar *wd; PetscReal sum = ZERO; realtype global_sum; VecGetArray(xv, &xd); VecGetArray(wv, &wd); for (i = 0; i < N; i++) { sum += PetscSqr(PetscAbsScalar(xd[i] * wd[i])); } VecRestoreArray(xv, &xd); VecRestoreArray(wv, &wd); global_sum = SUNMPI_Allreduce_scalar(sum, 1, comm); return (SUNRsqrt(global_sum)); } realtype N_VL1Norm_Petsc(N_Vector x) { Vec xv = NV_PVEC_PTC(x); PetscReal norm; VecNorm(xv, NORM_1, &norm); return norm; } void N_VCompare_Petsc(realtype c, N_Vector x, N_Vector z) { sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(x); Vec xv = NV_PVEC_PTC(x); Vec zv = NV_PVEC_PTC(z); PetscReal cpet = c; /* <~ realtype should typedef to PETScReal */ PetscScalar *xdata; PetscScalar *zdata; VecGetArray(xv, &xdata); VecGetArray(zv, &zdata); for (i = 0; i < N; i++) { zdata[i] = PetscAbsScalar(xdata[i]) >= cpet ? ONE : ZERO; } VecRestoreArray(xv, &xdata); VecRestoreArray(zv, &zdata); return; } booleantype N_VInvTest_Petsc(N_Vector x, N_Vector z) { sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); Vec xv = NV_PVEC_PTC(x); Vec zv = NV_PVEC_PTC(z); PetscScalar *xd; PetscScalar *zd; PetscReal val = ONE; VecGetArray(xv, &xd); VecGetArray(zv, &zd); for (i = 0; i < N; i++) { if (xd[i] == ZERO) val = ZERO; else zd[i] = ONE/xd[i]; } VecRestoreArray(xv, &xd); VecRestoreArray(zv, &zd); val = SUNMPI_Allreduce_scalar(val, 3, comm); if (val == ZERO) return(SUNFALSE); else return(SUNTRUE); } booleantype N_VConstrMask_Petsc(N_Vector c, N_Vector x, N_Vector m) { sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(x); MPI_Comm comm = NV_COMM_PTC(x); realtype temp; booleantype test; Vec xv = NV_PVEC_PTC(x); Vec cv = NV_PVEC_PTC(c); Vec mv = NV_PVEC_PTC(m); PetscScalar *xd; PetscScalar *cd; PetscScalar *md; temp = ZERO; VecGetArray(xv, &xd); VecGetArray(cv, &cd); VecGetArray(mv, &md); for (i = 0; i < N; i++) { PetscReal cc = (PetscReal) cd[i]; /* <~ Drop imaginary parts if any. */ PetscReal xx = (PetscReal) xd[i]; /* <~ Constraints defined on Re{x} */ md[i] = ZERO; /* Continue if no constraints were set for the variable */ if (cc == ZERO) continue; /* Check if a set constraint has been violated */ test = (SUNRabs(cc) > ONEPT5 && xx*cc <= ZERO) || (SUNRabs(cc) > HALF && xx*cc < ZERO); if (test) { temp = md[i] = ONE; } } VecRestoreArray(xv, &xd); VecRestoreArray(cv, &cd); VecRestoreArray(mv, &md); /* Find max temp across all MPI ranks */ temp = SUNMPI_Allreduce_scalar(temp, 2, comm); /* Return false if any constraint was violated */ return (temp == ONE) ? SUNFALSE : SUNTRUE; } realtype N_VMinQuotient_Petsc(N_Vector num, N_Vector denom) { booleantype notEvenOnce = SUNTRUE; sunindextype i; sunindextype N = NV_LOCLENGTH_PTC(num); MPI_Comm comm = NV_COMM_PTC(num); Vec nv = NV_PVEC_PTC(num); Vec dv = NV_PVEC_PTC(denom); PetscScalar *nd; PetscScalar *dd; PetscReal minval = BIG_REAL; VecGetArray(nv, &nd); VecGetArray(dv, &dd); for (i = 0; i < N; i++) { PetscReal nr = (PetscReal) nd[i]; PetscReal dr = (PetscReal) dd[i]; if (dr == ZERO) continue; else { if (!notEvenOnce) minval = SUNMIN(minval, nr/dr); else { minval = nr/dr; notEvenOnce = SUNFALSE; } } } VecRestoreArray(nv, &nd); VecRestoreArray(dv, &dd); return(SUNMPI_Allreduce_scalar(minval, 3, comm)); } /* * ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination_Petsc(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i; Vec* xv; Vec zv; /* invalid number of vectors */ if (nvec < 1) return(-1); /* should have called N_VScale */ if (nvec == 1) { N_VScale_Petsc(c[0], X[0], z); return(0); } /* should have called N_VLinearSum */ if (nvec == 2) { N_VLinearSum_Petsc(c[0], X[0], c[1], X[1], z); return(0); } /* get petsc vectors */ xv = (Vec*) malloc(nvec * sizeof(Vec)); for (i=0; i ZERO) nrm[i] += SUNSQR(xd[j] * wd[j]); } VecRestoreArray(NV_PVEC_PTC(X[i]), &xd); VecRestoreArray(NV_PVEC_PTC(W[i]), &wd); } VecRestoreArray(NV_PVEC_PTC(id), &idd); SUNMPI_Allreduce(nrm, nvec, 1, comm); for (i=0; i 1 * -------------------------- */ /* should have called N_VLinearSumVectorArray */ if (nsum == 1) { retval = N_VLinearSumVectorArray_Petsc(nvec, a[0], X, ONE, Y[0], Z[0]); return(retval); } /* ---------------------------- * Compute multiple linear sums * ---------------------------- */ /* get vector length */ N = NV_LOCLENGTH_PTC(X[0]); /* * Y[i][j] += a[i] * x[j] */ if (Y == Z) { for (i=0; i 1 * -------------------------- */ /* should have called N_VScaleVectorArray */ if (nsum == 1) { ctmp = (realtype*) malloc(nvec * sizeof(realtype)); for (j=0; jops == NULL) return(-1); if (tf) { /* enable all fused vector operations */ v->ops->nvlinearcombination = N_VLinearCombination_Petsc; v->ops->nvscaleaddmulti = N_VScaleAddMulti_Petsc; v->ops->nvdotprodmulti = N_VDotProdMulti_Petsc; /* enable all vector array operations */ v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Petsc; v->ops->nvscalevectorarray = N_VScaleVectorArray_Petsc; v->ops->nvconstvectorarray = N_VConstVectorArray_Petsc; v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Petsc; v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Petsc; v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Petsc; v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Petsc; } else { /* disable all fused vector operations */ v->ops->nvlinearcombination = NULL; v->ops->nvscaleaddmulti = NULL; v->ops->nvdotprodmulti = NULL; /* disable all vector array operations */ v->ops->nvlinearsumvectorarray = NULL; v->ops->nvscalevectorarray = NULL; v->ops->nvconstvectorarray = NULL; v->ops->nvwrmsnormvectorarray = NULL; v->ops->nvwrmsnormmaskvectorarray = NULL; v->ops->nvscaleaddmultivectorarray = NULL; v->ops->nvlinearcombinationvectorarray = NULL; } /* return success */ return(0); } int N_VEnableLinearCombination_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombination = N_VLinearCombination_Petsc; else v->ops->nvlinearcombination = NULL; /* return success */ return(0); } int N_VEnableScaleAddMulti_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmulti = N_VScaleAddMulti_Petsc; else v->ops->nvscaleaddmulti = NULL; /* return success */ return(0); } int N_VEnableDotProdMulti_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvdotprodmulti = N_VDotProdMulti_Petsc; else v->ops->nvdotprodmulti = NULL; /* return success */ return(0); } int N_VEnableLinearSumVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearsumvectorarray = N_VLinearSumVectorArray_Petsc; else v->ops->nvlinearsumvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscalevectorarray = N_VScaleVectorArray_Petsc; else v->ops->nvscalevectorarray = NULL; /* return success */ return(0); } int N_VEnableConstVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvconstvectorarray = N_VConstVectorArray_Petsc; else v->ops->nvconstvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormvectorarray = N_VWrmsNormVectorArray_Petsc; else v->ops->nvwrmsnormvectorarray = NULL; /* return success */ return(0); } int N_VEnableWrmsNormMaskVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvwrmsnormmaskvectorarray = N_VWrmsNormMaskVectorArray_Petsc; else v->ops->nvwrmsnormmaskvectorarray = NULL; /* return success */ return(0); } int N_VEnableScaleAddMultiVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvscaleaddmultivectorarray = N_VScaleAddMultiVectorArray_Petsc; else v->ops->nvscaleaddmultivectorarray = NULL; /* return success */ return(0); } int N_VEnableLinearCombinationVectorArray_Petsc(N_Vector v, booleantype tf) { /* check that vector is non-NULL */ if (v == NULL) return(-1); /* check that ops structure is non-NULL */ if (v->ops == NULL) return(-1); /* enable/disable operation */ if (tf) v->ops->nvlinearcombinationvectorarray = N_VLinearCombinationVectorArray_Petsc; else v->ops->nvlinearcombinationvectorarray = NULL; /* return success */ return(0); } StanHeaders/src/kinsol/0000755000176200001440000000000013766554135014560 5ustar liggesusersStanHeaders/src/kinsol/kinsol.c0000644000176200001440000023067613766554457016250 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, Carol Woodward, * John Loffeld, and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the main KINSol solver. * It is independent of the KINSol linear solver in use. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * Creation and allocation functions * KINCreate * KINInit * Main solver function * KINSol * Deallocation function * KINFree * * PRIVATE FUNCTIONS * ----------------- * KINCheckNvector * Memory allocation/deallocation * KINAllocVectors * KINFreeVectors * Initial setup * KINSolInit * Step functions * KINLinSolDrv * KINFullNewton * KINLineSearch * KINConstraint * KINFP * KINPicardAA * Stopping tests * KINStop * KINForcingTerm * Norm functions * KINScFNorm * KINScSNorm * KINSOL Verbose output functions * KINPrintInfo * KINInfoHandler * KINSOL Error Handling functions * KINProcessError * KINErrHandler * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include #include "kinsol_impl.h" #include /* * ================================================================= * KINSOL PRIVATE CONSTANTS * ================================================================= */ #define HALF RCONST(0.5) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define ONEPT5 RCONST(1.5) #define TWO RCONST(2.0) #define THREE RCONST(3.0) #define FIVE RCONST(5.0) #define TWELVE RCONST(12.0) #define POINT1 RCONST(0.1) #define POINT01 RCONST(0.01) #define POINT99 RCONST(0.99) #define THOUSAND RCONST(1000.0) #define ONETHIRD RCONST(0.3333333333333333) #define TWOTHIRDS RCONST(0.6666666666666667) #define POINT9 RCONST(0.9) #define POINT0001 RCONST(0.0001) /* * ================================================================= * KINSOL ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by KINSol * ---------------------------------------------------------- * * KINStop return value requesting more iterations * RETRY_ITERATION * CONTINUE_ITERATIONS * * KINFullNewton, KINLineSearch, KINFP, and KINPicardAA return values: * KIN_SUCCESS * KIN_SYSFUNC_FAIL * STEP_TOO_SMALL * * KINConstraint return values: * KIN_SUCCESS * CONSTR_VIOLATED */ #define RETRY_ITERATION -998 #define CONTINUE_ITERATIONS -999 #define STEP_TOO_SMALL -997 #define CONSTR_VIOLATED -996 /* * Algorithmic constants * --------------------- * * MAX_RECVR max. no. of attempts to correct a recoverable func error */ #define MAX_RECVR 5 /* * Keys for KINPrintInfo * --------------------- */ #define PRNT_RETVAL 1 #define PRNT_NNI 2 #define PRNT_TOL 3 #define PRNT_FMAX 4 #define PRNT_PNORM 5 #define PRNT_PNORM1 6 #define PRNT_FNORM 7 #define PRNT_LAM 8 #define PRNT_ALPHA 9 #define PRNT_BETA 10 #define PRNT_ALPHABETA 11 #define PRNT_ADJ 12 /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype KINCheckNvector(N_Vector tmpl); static booleantype KINAllocVectors(KINMem kin_mem, N_Vector tmpl); static int KINSolInit(KINMem kin_mem); static int KINConstraint(KINMem kin_mem ); static void KINForcingTerm(KINMem kin_mem, realtype fnormp); static void KINFreeVectors(KINMem kin_mem); static int KINFullNewton(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken); static int KINLineSearch(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken); static int KINPicardAA(KINMem kin_mem, long int *iter, realtype *R, realtype *gamma, realtype *fmax); static int KINFP(KINMem kin_mem, long int *iter, realtype *R, realtype *gamma, realtype *fmax); static int KINLinSolDrv(KINMem kinmem); static int KINPicardFcnEval(KINMem kin_mem, N_Vector gval, N_Vector uval, N_Vector fval1); static realtype KINScFNorm(KINMem kin_mem, N_Vector v, N_Vector scale); static realtype KINScSNorm(KINMem kin_mem, N_Vector v, N_Vector u); static int KINStop(KINMem kin_mem, booleantype maxStepTaken, int sflag); static int AndersonAcc(KINMem kin_mem, N_Vector gval, N_Vector fv, N_Vector x, N_Vector x_old, int iter, realtype *R, realtype *gamma); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation and allocation functions * ----------------------------------------------------------------- */ /* * Function : KINCreate * * KINCreate creates an internal memory block for a problem to * be solved by KINSOL. If successful, KINCreate returns a pointer * to the problem memory. This pointer should be passed to * KINInit. If an initialization error occurs, KINCreate prints * an error message to standard error and returns NULL. */ void *KINCreate(void) { KINMem kin_mem; realtype uround; kin_mem = NULL; kin_mem = (KINMem) malloc(sizeof(struct KINMemRec)); if (kin_mem == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINCreate", MSG_MEM_FAIL); return(NULL); } /* Zero out kin_mem */ memset(kin_mem, 0, sizeof(struct KINMemRec)); /* set uround (unit roundoff) */ kin_mem->kin_uround = uround = UNIT_ROUNDOFF; /* set default values for solver optional inputs */ kin_mem->kin_func = NULL; kin_mem->kin_user_data = NULL; kin_mem->kin_constraints = NULL; kin_mem->kin_uscale = NULL; kin_mem->kin_fscale = NULL; kin_mem->kin_fold_aa = NULL; kin_mem->kin_gold_aa = NULL; kin_mem->kin_df_aa = NULL; kin_mem->kin_dg_aa = NULL; kin_mem->kin_q_aa = NULL; kin_mem->kin_gamma_aa = NULL; kin_mem->kin_R_aa = NULL; kin_mem->kin_cv = NULL; kin_mem->kin_Xv = NULL; kin_mem->kin_m_aa = ZERO; kin_mem->kin_aamem_aa = 0; kin_mem->kin_setstop_aa = 0; kin_mem->kin_constraintsSet = SUNFALSE; kin_mem->kin_ehfun = KINErrHandler; kin_mem->kin_eh_data = kin_mem; kin_mem->kin_errfp = stderr; kin_mem->kin_ihfun = KINInfoHandler; kin_mem->kin_ih_data = kin_mem; kin_mem->kin_infofp = stdout; kin_mem->kin_printfl = PRINTFL_DEFAULT; kin_mem->kin_mxiter = MXITER_DEFAULT; kin_mem->kin_noInitSetup = SUNFALSE; kin_mem->kin_msbset = MSBSET_DEFAULT; kin_mem->kin_noResMon = SUNFALSE; kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT; kin_mem->kin_update_fnorm_sub = SUNFALSE; kin_mem->kin_mxnbcf = MXNBCF_DEFAULT; kin_mem->kin_sthrsh = TWO; kin_mem->kin_noMinEps = SUNFALSE; kin_mem->kin_mxnstepin = ZERO; kin_mem->kin_sqrt_relfunc = SUNRsqrt(uround); kin_mem->kin_scsteptol = SUNRpowerR(uround,TWOTHIRDS); kin_mem->kin_fnormtol = SUNRpowerR(uround,ONETHIRD); kin_mem->kin_etaflag = KIN_ETACHOICE1; kin_mem->kin_eta = POINT1; /* default for KIN_ETACONSTANT */ kin_mem->kin_eta_alpha = TWO; /* default for KIN_ETACHOICE2 */ kin_mem->kin_eta_gamma = POINT9; /* default for KIN_ETACHOICE2 */ kin_mem->kin_MallocDone = SUNFALSE; kin_mem->kin_eval_omega = SUNTRUE; kin_mem->kin_omega = ZERO; /* default to using min/max */ kin_mem->kin_omega_min = OMEGA_MIN; kin_mem->kin_omega_max = OMEGA_MAX; /* initialize lrw and liw */ kin_mem->kin_lrw = 17; kin_mem->kin_liw = 22; /* NOTE: needed since KINInit could be called after KINSetConstraints */ kin_mem->kin_lrw1 = 0; kin_mem->kin_liw1 = 0; return((void *) kin_mem); } /* * Function : KINInit * * KINInit allocates memory for a problem or execution of KINSol. * If memory is successfully allocated, KIN_SUCCESS is returned. * Otherwise, an error message is printed and an error flag * returned. */ int KINInit(void *kinmem, KINSysFn func, N_Vector tmpl) { sunindextype liw1, lrw1; KINMem kin_mem; booleantype allocOK, nvectorOK; /* check kinmem */ if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINInit", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (func == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINInit", MSG_FUNC_NULL); return(KIN_ILL_INPUT); } /* check if all required vector operations are implemented */ nvectorOK = KINCheckNvector(tmpl); if (!nvectorOK) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINInit", MSG_BAD_NVECTOR); return(KIN_ILL_INPUT); } /* set space requirements for one N_Vector */ if (tmpl->ops->nvspace != NULL) { N_VSpace(tmpl, &lrw1, &liw1); kin_mem->kin_lrw1 = lrw1; kin_mem->kin_liw1 = liw1; } else { kin_mem->kin_lrw1 = 0; kin_mem->kin_liw1 = 0; } /* allocate necessary vectors */ allocOK = KINAllocVectors(kin_mem, tmpl); if (!allocOK) { KINProcessError(kin_mem, KIN_MEM_FAIL, "KINSOL", "KINInit", MSG_MEM_FAIL); free(kin_mem); kin_mem = NULL; return(KIN_MEM_FAIL); } /* copy the input parameter into KINSol state */ kin_mem->kin_func = func; /* set the linear solver addresses to NULL */ kin_mem->kin_linit = NULL; kin_mem->kin_lsetup = NULL; kin_mem->kin_lsolve = NULL; kin_mem->kin_lfree = NULL; kin_mem->kin_lmem = NULL; /* problem memory has been successfully allocated */ kin_mem->kin_MallocDone = SUNTRUE; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * Function : KINSol * * KINSol (main KINSOL driver routine) manages the computational * process of computing an approximate solution of the nonlinear * system F(uu) = 0. The KINSol routine calls the following * subroutines: * * KINSolInit checks if initial guess satisfies user-supplied * constraints and initializes linear solver * * KINLinSolDrv interfaces with linear solver to find a * solution of the system J(uu)*x = b (calculate * Newton step) * * KINFullNewton/KINLineSearch implement the global strategy * * KINForcingTerm computes the forcing term (eta) * * KINStop determines if an approximate solution has been found */ int KINSol(void *kinmem, N_Vector u, int strategy_in, N_Vector u_scale, N_Vector f_scale) { realtype fnormp, f1normp, epsmin, fmax=ZERO; KINMem kin_mem; int ret, sflag; booleantype maxStepTaken; /* intialize to avoid compiler warning messages */ maxStepTaken = SUNFALSE; f1normp = fnormp = -ONE; /* initialize epsmin to avoid compiler warning message */ epsmin = ZERO; /* check for kinmem non-NULL */ if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSol", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if(kin_mem->kin_MallocDone == SUNFALSE) { KINProcessError(NULL, KIN_NO_MALLOC, "KINSOL", "KINSol", MSG_NO_MALLOC); return(KIN_NO_MALLOC); } /* load input arguments */ kin_mem->kin_uu = u; kin_mem->kin_uscale = u_scale; kin_mem->kin_fscale = f_scale; kin_mem->kin_globalstrategy = strategy_in; /* CSW: Call fixed point solver if requested. Note that this should probably be forked off to a FPSOL solver instead of kinsol in the future. */ if ( kin_mem->kin_globalstrategy == KIN_FP ) { if (kin_mem->kin_uu == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSol", MSG_UU_NULL); return(KIN_ILL_INPUT); } if (kin_mem->kin_constraintsSet != SUNFALSE) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSol", MSG_CONSTRAINTS_NOTOK); return(KIN_ILL_INPUT); } if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_TOL, "KINSOL", "KINSol", INFO_TOL, kin_mem->kin_scsteptol, kin_mem->kin_fnormtol); kin_mem->kin_nfe = kin_mem->kin_nnilset = kin_mem->kin_nnilset_sub = kin_mem->kin_nni = kin_mem->kin_nbcf = kin_mem->kin_nbktrk = 0; ret = KINFP(kin_mem, &(kin_mem->kin_nni), kin_mem->kin_R_aa, kin_mem->kin_gamma_aa, &fmax); switch(ret) { case KIN_SYSFUNC_FAIL: KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSol", MSG_SYSFUNC_FAILED); break; case KIN_MAXITER_REACHED: KINProcessError(kin_mem, KIN_MAXITER_REACHED, "KINSOL", "KINSol", MSG_MAXITER_REACHED); break; } return(ret); } /* initialize solver */ ret = KINSolInit(kin_mem); if (ret != KIN_SUCCESS) return(ret); kin_mem->kin_ncscmx = 0; /* Note: The following logic allows the choice of whether or not to force a call to the linear solver setup upon a given call to KINSol */ if (kin_mem->kin_noInitSetup) kin_mem->kin_sthrsh = ONE; else kin_mem->kin_sthrsh = TWO; /* if eps is to be bounded from below, set the bound */ if (kin_mem->kin_inexact_ls && !(kin_mem->kin_noMinEps)) epsmin = POINT01 * kin_mem->kin_fnormtol; /* if omega is zero at this point, make sure it will be evaluated at each iteration based on the provided min/max bounds and the current function norm. */ if (kin_mem->kin_omega == ZERO) kin_mem->kin_eval_omega = SUNTRUE; else kin_mem->kin_eval_omega = SUNFALSE; /* CSW: Call fixed point solver for Picard method if requested. Note that this should probably be forked off to a part of an FPSOL solver instead of kinsol in the future. */ if ( kin_mem->kin_globalstrategy == KIN_PICARD ) { kin_mem->kin_gval = N_VClone(kin_mem->kin_unew); kin_mem->kin_lrw += kin_mem->kin_lrw1; ret = KINPicardAA(kin_mem, &(kin_mem->kin_nni), kin_mem->kin_R_aa, kin_mem->kin_gamma_aa, &fmax); return(ret); } for(;;){ kin_mem->kin_retry_nni = SUNFALSE; kin_mem->kin_nni++; /* calculate the epsilon (stopping criteria for iterative linear solver) for this iteration based on eta from the routine KINForcingTerm */ if (kin_mem->kin_inexact_ls) { kin_mem->kin_eps = (kin_mem->kin_eta + kin_mem->kin_uround) * kin_mem->kin_fnorm; if(!(kin_mem->kin_noMinEps)) kin_mem->kin_eps = SUNMAX(epsmin, kin_mem->kin_eps); } repeat_nni: /* call the appropriate routine to calculate an acceptable step pp */ sflag = 0; if (kin_mem->kin_globalstrategy == KIN_NONE) { /* Full Newton Step*/ /* call KINLinSolDrv to calculate the (approximate) Newton step, pp */ ret = KINLinSolDrv(kin_mem); if (ret != KIN_SUCCESS) break; sflag = KINFullNewton(kin_mem, &fnormp, &f1normp, &maxStepTaken); /* if sysfunc failed unrecoverably, stop */ if ((sflag == KIN_SYSFUNC_FAIL) || (sflag == KIN_REPTD_SYSFUNC_ERR)) { ret = sflag; break; } } else if (kin_mem->kin_globalstrategy == KIN_LINESEARCH) { /* Line Search */ /* call KINLinSolDrv to calculate the (approximate) Newton step, pp */ ret = KINLinSolDrv(kin_mem); if (ret != KIN_SUCCESS) break; sflag = KINLineSearch(kin_mem, &fnormp, &f1normp, &maxStepTaken); /* if sysfunc failed unrecoverably, stop */ if ((sflag == KIN_SYSFUNC_FAIL) || (sflag == KIN_REPTD_SYSFUNC_ERR)) { ret = sflag; break; } /* if too many beta condition failures, then stop iteration */ if (kin_mem->kin_nbcf > kin_mem->kin_mxnbcf) { ret = KIN_LINESEARCH_BCFAIL; break; } } if ( (kin_mem->kin_globalstrategy != KIN_PICARD) && (kin_mem->kin_globalstrategy != KIN_FP) ) { /* evaluate eta by calling the forcing term routine */ if (kin_mem->kin_callForcingTerm) KINForcingTerm(kin_mem, fnormp); kin_mem->kin_fnorm = fnormp; /* call KINStop to check if tolerances where met by this iteration */ ret = KINStop(kin_mem, maxStepTaken, sflag); if (ret == RETRY_ITERATION) { kin_mem->kin_retry_nni = SUNTRUE; goto repeat_nni; } } /* update uu after the iteration */ N_VScale(ONE, kin_mem->kin_unew, kin_mem->kin_uu); kin_mem->kin_f1norm = f1normp; /* print the current nni, fnorm, and nfe values if printfl > 0 */ if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINSol", INFO_NNI, kin_mem->kin_nni, kin_mem->kin_nfe, kin_mem->kin_fnorm); if (ret != CONTINUE_ITERATIONS) break; fflush(kin_mem->kin_errfp); } /* end of loop; return */ if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINSol", INFO_RETVAL, ret); switch(ret) { case KIN_SYSFUNC_FAIL: KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSol", MSG_SYSFUNC_FAILED); break; case KIN_REPTD_SYSFUNC_ERR: KINProcessError(kin_mem, KIN_REPTD_SYSFUNC_ERR, "KINSOL", "KINSol", MSG_SYSFUNC_REPTD); break; case KIN_LSETUP_FAIL: KINProcessError(kin_mem, KIN_LSETUP_FAIL, "KINSOL", "KINSol", MSG_LSETUP_FAILED); break; case KIN_LSOLVE_FAIL: KINProcessError(kin_mem, KIN_LSOLVE_FAIL, "KINSOL", "KINSol", MSG_LSOLVE_FAILED); break; case KIN_LINSOLV_NO_RECOVERY: KINProcessError(kin_mem, KIN_LINSOLV_NO_RECOVERY, "KINSOL", "KINSol", MSG_LINSOLV_NO_RECOVERY); break; case KIN_LINESEARCH_NONCONV: KINProcessError(kin_mem, KIN_LINESEARCH_NONCONV, "KINSOL", "KINSol", MSG_LINESEARCH_NONCONV); break; case KIN_LINESEARCH_BCFAIL: KINProcessError(kin_mem, KIN_LINESEARCH_BCFAIL, "KINSOL", "KINSol", MSG_LINESEARCH_BCFAIL); break; case KIN_MAXITER_REACHED: KINProcessError(kin_mem, KIN_MAXITER_REACHED, "KINSOL", "KINSol", MSG_MAXITER_REACHED); break; case KIN_MXNEWT_5X_EXCEEDED: KINProcessError(kin_mem, KIN_MXNEWT_5X_EXCEEDED, "KINSOL", "KINSol", MSG_MXNEWT_5X_EXCEEDED); break; } return(ret); } /* * ----------------------------------------------------------------- * Deallocation function * ----------------------------------------------------------------- */ /* * Function : KINFree * * This routine frees the problem memory allocated by KINInit. * Such memory includes all the vectors allocated by * KINAllocVectors, and the memory lmem for the linear solver * (deallocated by a call to lfree). */ void KINFree(void **kinmem) { KINMem kin_mem; if (*kinmem == NULL) return; kin_mem = (KINMem) (*kinmem); KINFreeVectors(kin_mem); /* call lfree if non-NULL */ if (kin_mem->kin_lfree != NULL) kin_mem->kin_lfree(kin_mem); free(*kinmem); *kinmem = NULL; } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * Function : KINCheckNvector * * This routine checks if all required vector operations are * implemented (excluding those required by KINConstraint). If all * necessary operations are present, then KINCheckNvector returns * SUNTRUE. Otherwise, SUNFALSE is returned. */ static booleantype KINCheckNvector(N_Vector tmpl) { if ((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvdiv == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvmaxnorm == NULL) || (tmpl->ops->nvmin == NULL) || (tmpl->ops->nvwl2norm == NULL)) return(SUNFALSE); else return(SUNTRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * Function : KINAllocVectors * * This routine allocates the KINSol vectors. If all memory * allocations are successful, KINAllocVectors returns SUNTRUE. * Otherwise all allocated memory is freed and KINAllocVectors * returns SUNFALSE. */ static booleantype KINAllocVectors(KINMem kin_mem, N_Vector tmpl) { /* allocate unew, fval, pp, vtemp1 and vtemp2. */ /* allocate df, dg, q, for Anderson Acceleration, Broyden and EN */ kin_mem->kin_unew = N_VClone(tmpl); if (kin_mem->kin_unew == NULL) return(SUNFALSE); kin_mem->kin_fval = N_VClone(tmpl); if (kin_mem->kin_fval == NULL) { N_VDestroy(kin_mem->kin_unew); return(SUNFALSE); } kin_mem->kin_pp = N_VClone(tmpl); if (kin_mem->kin_pp == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); return(SUNFALSE); } kin_mem->kin_vtemp1 = N_VClone(tmpl); if (kin_mem->kin_vtemp1 == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); return(SUNFALSE); } kin_mem->kin_vtemp2 = N_VClone(tmpl); if (kin_mem->kin_vtemp2 == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); return(SUNFALSE); } /* update solver workspace lengths */ kin_mem->kin_liw += 5*kin_mem->kin_liw1; kin_mem->kin_lrw += 5*kin_mem->kin_lrw1; if (kin_mem->kin_m_aa) { kin_mem->kin_R_aa = (realtype *) malloc((kin_mem->kin_m_aa*kin_mem->kin_m_aa) * sizeof(realtype)); if (kin_mem->kin_R_aa == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); return(KIN_MEM_FAIL); } kin_mem->kin_gamma_aa = (realtype *)malloc(kin_mem->kin_m_aa * sizeof(realtype)); if (kin_mem->kin_gamma_aa == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); return(KIN_MEM_FAIL); } kin_mem->kin_ipt_map = (int *)malloc(kin_mem->kin_m_aa * sizeof(int)); if (kin_mem->kin_ipt_map == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); return(KIN_MEM_FAIL); } kin_mem->kin_cv = (realtype *)malloc((kin_mem->kin_m_aa+1) * sizeof(realtype)); if (kin_mem->kin_cv == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); return(KIN_MEM_FAIL); } kin_mem->kin_Xv = (N_Vector *)malloc((kin_mem->kin_m_aa+1) * sizeof(N_Vector)); if (kin_mem->kin_Xv == NULL) { KINProcessError(kin_mem, 0, "KINSOL", "KINAllocVectors", MSG_MEM_FAIL); N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); free(kin_mem->kin_cv); return(KIN_MEM_FAIL); } } if (kin_mem->kin_m_aa) { kin_mem->kin_fold_aa = N_VClone(tmpl); if (kin_mem->kin_fold_aa == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); free(kin_mem->kin_cv); free(kin_mem->kin_Xv); return(SUNFALSE); } kin_mem->kin_gold_aa = N_VClone(tmpl); if (kin_mem->kin_gold_aa == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); free(kin_mem->kin_cv); free(kin_mem->kin_Xv); N_VDestroy(kin_mem->kin_fold_aa); return(SUNFALSE); } kin_mem->kin_df_aa = N_VCloneVectorArray(kin_mem->kin_m_aa,tmpl); if (kin_mem->kin_df_aa == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); free(kin_mem->kin_cv); free(kin_mem->kin_Xv); N_VDestroy(kin_mem->kin_fold_aa); N_VDestroy(kin_mem->kin_gold_aa); return(SUNFALSE); } kin_mem->kin_dg_aa = N_VCloneVectorArray(kin_mem->kin_m_aa,tmpl); if (kin_mem->kin_dg_aa == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); free(kin_mem->kin_cv); free(kin_mem->kin_Xv); N_VDestroy(kin_mem->kin_fold_aa); N_VDestroy(kin_mem->kin_gold_aa); N_VDestroyVectorArray(kin_mem->kin_df_aa, kin_mem->kin_m_aa); return(SUNFALSE); } /* update solver workspace lengths */ kin_mem->kin_liw += 2*kin_mem->kin_m_aa*kin_mem->kin_liw1+2; kin_mem->kin_lrw += 2*kin_mem->kin_m_aa*kin_mem->kin_lrw1+2; if (kin_mem->kin_aamem_aa) { kin_mem->kin_q_aa = N_VCloneVectorArray(kin_mem->kin_m_aa,tmpl); if (kin_mem->kin_q_aa == NULL) { N_VDestroy(kin_mem->kin_unew); N_VDestroy(kin_mem->kin_fval); N_VDestroy(kin_mem->kin_pp); N_VDestroy(kin_mem->kin_vtemp1); N_VDestroy(kin_mem->kin_vtemp2); free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); free(kin_mem->kin_cv); free(kin_mem->kin_Xv); N_VDestroy(kin_mem->kin_fold_aa); N_VDestroy(kin_mem->kin_gold_aa); N_VDestroyVectorArray(kin_mem->kin_df_aa, kin_mem->kin_m_aa); N_VDestroyVectorArray(kin_mem->kin_dg_aa, kin_mem->kin_m_aa); return(SUNFALSE); } kin_mem->kin_liw += kin_mem->kin_m_aa*kin_mem->kin_liw1; kin_mem->kin_lrw += kin_mem->kin_m_aa*kin_mem->kin_lrw1; } } return(SUNTRUE); } /* * KINFreeVectors * * This routine frees the KINSol vectors allocated by * KINAllocVectors. */ static void KINFreeVectors(KINMem kin_mem) { if (kin_mem->kin_unew != NULL) N_VDestroy(kin_mem->kin_unew); if (kin_mem->kin_fval != NULL) N_VDestroy(kin_mem->kin_fval); if (kin_mem->kin_pp != NULL) N_VDestroy(kin_mem->kin_pp); if (kin_mem->kin_vtemp1 != NULL) N_VDestroy(kin_mem->kin_vtemp1); if (kin_mem->kin_vtemp2 != NULL) N_VDestroy(kin_mem->kin_vtemp2); if ( (kin_mem->kin_globalstrategy == KIN_PICARD) && (kin_mem->kin_gval != NULL) ) N_VDestroy(kin_mem->kin_gval); if ( ((kin_mem->kin_globalstrategy == KIN_PICARD) || (kin_mem->kin_globalstrategy == KIN_FP)) && (kin_mem->kin_m_aa > 0) ) { free(kin_mem->kin_R_aa); free(kin_mem->kin_gamma_aa); free(kin_mem->kin_ipt_map); } if (kin_mem->kin_m_aa) { if (kin_mem->kin_fold_aa != NULL) N_VDestroy(kin_mem->kin_fold_aa); if (kin_mem->kin_gold_aa != NULL) N_VDestroy(kin_mem->kin_gold_aa); N_VDestroyVectorArray(kin_mem->kin_df_aa,kin_mem->kin_m_aa); N_VDestroyVectorArray(kin_mem->kin_dg_aa,kin_mem->kin_m_aa); free(kin_mem->kin_cv); free(kin_mem->kin_Xv); kin_mem->kin_lrw -= (2*kin_mem->kin_m_aa*kin_mem->kin_lrw1+2); kin_mem->kin_liw -= (2*kin_mem->kin_m_aa*kin_mem->kin_liw1+2); if (kin_mem->kin_aamem_aa) { N_VDestroyVectorArray(kin_mem->kin_q_aa,kin_mem->kin_m_aa); kin_mem->kin_lrw -= kin_mem->kin_m_aa*kin_mem->kin_lrw1; kin_mem->kin_liw -= kin_mem->kin_m_aa*kin_mem->kin_liw1; } } kin_mem->kin_lrw -= 5*kin_mem->kin_lrw1; kin_mem->kin_liw -= 5*kin_mem->kin_liw1; if (kin_mem->kin_constraintsSet) { if (kin_mem->kin_constraints != NULL) N_VDestroy(kin_mem->kin_constraints); kin_mem->kin_lrw -= kin_mem->kin_lrw1; kin_mem->kin_liw -= kin_mem->kin_liw1; } return; } /* * ----------------------------------------------------------------- * Initial setup * ----------------------------------------------------------------- */ /* * KINSolInit * * KINSolInit initializes the problem for the specific input * received in this call to KINSol (which calls KINSolInit). All * problem specification inputs are checked for errors. If any error * occurs during initialization, it is reported to the file whose * file pointer is errfp. * * The possible return values for KINSolInit are: * KIN_SUCCESS : indicates a normal initialization * * KIN_ILL_INPUT : indicates that an input error has been found * * KIN_INITIAL_GUESS_OK : indicates that the guess uu * satisfied the system func(uu) = 0 * within the tolerances specified */ static int KINSolInit(KINMem kin_mem) { int retval; realtype fmax; /* check for illegal input parameters */ if (kin_mem->kin_uu == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_UU_NULL); return(KIN_ILL_INPUT); } if ( (kin_mem->kin_globalstrategy != KIN_NONE) && (kin_mem->kin_globalstrategy != KIN_LINESEARCH) && (kin_mem->kin_globalstrategy != KIN_PICARD) && (kin_mem->kin_globalstrategy != KIN_FP) ) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_GLSTRAT); return(KIN_ILL_INPUT); } if (kin_mem->kin_uscale == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_USCALE); return(KIN_ILL_INPUT); } if (N_VMin(kin_mem->kin_uscale) <= ZERO){ KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_USCALE_NONPOSITIVE); return(KIN_ILL_INPUT); } if (kin_mem->kin_fscale == NULL) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_FSCALE); return(KIN_ILL_INPUT); } if (N_VMin(kin_mem->kin_fscale) <= ZERO){ KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_FSCALE_NONPOSITIVE); return(KIN_ILL_INPUT); } if ( (kin_mem->kin_constraints != NULL) && ( (kin_mem->kin_globalstrategy == KIN_PICARD) || (kin_mem->kin_globalstrategy == KIN_FP) ) ) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_CONSTRAINTS_NOTOK); return(KIN_ILL_INPUT); } /* set the constraints flag */ if (kin_mem->kin_constraints == NULL) kin_mem->kin_constraintsSet = SUNFALSE; else { kin_mem->kin_constraintsSet = SUNTRUE; if ((kin_mem->kin_constraints->ops->nvconstrmask == NULL) || (kin_mem->kin_constraints->ops->nvminquotient == NULL)) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_BAD_NVECTOR); return(KIN_ILL_INPUT); } } /* check the initial guess uu against the constraints */ if (kin_mem->kin_constraintsSet) { if (!N_VConstrMask(kin_mem->kin_constraints, kin_mem->kin_uu, kin_mem->kin_vtemp1)) { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINSOL", "KINSolInit", MSG_INITIAL_CNSTRNT); return(KIN_ILL_INPUT); } } /* all error checking is complete at this point */ if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_TOL, "KINSOL", "KINSolInit", INFO_TOL, kin_mem->kin_scsteptol, kin_mem->kin_fnormtol); /* calculate the default value for mxnewtstep (maximum Newton step) */ if (kin_mem->kin_mxnstepin == ZERO) kin_mem->kin_mxnewtstep = THOUSAND * N_VWL2Norm(kin_mem->kin_uu, kin_mem->kin_uscale); else kin_mem->kin_mxnewtstep = kin_mem->kin_mxnstepin; if (kin_mem->kin_mxnewtstep < ONE) kin_mem->kin_mxnewtstep = ONE; /* additional set-up for inexact linear solvers */ if (kin_mem->kin_inexact_ls) { /* set up the coefficients for the eta calculation */ kin_mem->kin_callForcingTerm = (kin_mem->kin_etaflag != KIN_ETACONSTANT); /* this value is always used for choice #1 */ if (kin_mem->kin_etaflag == KIN_ETACHOICE1) kin_mem->kin_eta_alpha = (ONE + SUNRsqrt(FIVE)) * HALF; /* initial value for eta set to 0.5 for other than the KIN_ETACONSTANT option */ if (kin_mem->kin_etaflag != KIN_ETACONSTANT) kin_mem->kin_eta = HALF; /* disable residual monitoring if using an inexact linear solver */ kin_mem->kin_noResMon = SUNTRUE; } else { kin_mem->kin_callForcingTerm = SUNFALSE; } /* initialize counters */ kin_mem->kin_nfe = kin_mem->kin_nnilset = kin_mem->kin_nnilset_sub = kin_mem->kin_nni = kin_mem->kin_nbcf = kin_mem->kin_nbktrk = 0; /* see if the initial guess uu satisfies the nonlinear system */ retval = kin_mem->kin_func(kin_mem->kin_uu, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval < 0) { KINProcessError(kin_mem, KIN_SYSFUNC_FAIL, "KINSOL", "KINSolInit", MSG_SYSFUNC_FAILED); return(KIN_SYSFUNC_FAIL); } else if (retval > 0) { KINProcessError(kin_mem, KIN_FIRST_SYSFUNC_ERR, "KINSOL", "KINSolInit", MSG_SYSFUNC_FIRST); return(KIN_FIRST_SYSFUNC_ERR); } fmax = KINScFNorm(kin_mem, kin_mem->kin_fval, kin_mem->kin_fscale); if (fmax <= (POINT01 * kin_mem->kin_fnormtol)) { kin_mem->kin_fnorm = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); return(KIN_INITIAL_GUESS_OK); } if (kin_mem->kin_printfl > 1) KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINSolInit", INFO_FMAX, fmax); /* initialize the linear solver if linit != NULL */ if (kin_mem->kin_linit != NULL) { retval = kin_mem->kin_linit(kin_mem); if (retval != 0) { KINProcessError(kin_mem, KIN_LINIT_FAIL, "KINSOL", "KINSolInit", MSG_LINIT_FAIL); return(KIN_LINIT_FAIL); } } /* initialize the L2 (Euclidean) norms of f for the linear iteration steps */ kin_mem->kin_fnorm = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); kin_mem->kin_f1norm = HALF * kin_mem->kin_fnorm * kin_mem->kin_fnorm; kin_mem->kin_fnorm_sub = kin_mem->kin_fnorm; if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINSolInit", INFO_NNI, kin_mem->kin_nni, kin_mem->kin_nfe, kin_mem->kin_fnorm); /* problem has now been successfully initialized */ return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Step functions * ----------------------------------------------------------------- */ /* * KINLinSolDrv * * This routine handles the process of solving for the approximate * solution of the Newton equations in the Newton iteration. * Subsequent routines handle the nonlinear aspects of its * application. */ static int KINLinSolDrv(KINMem kin_mem) { N_Vector x, b; int retval; if ((kin_mem->kin_nni - kin_mem->kin_nnilset) >= kin_mem->kin_msbset) { kin_mem->kin_sthrsh = TWO; kin_mem->kin_update_fnorm_sub = SUNTRUE; } for(;;){ kin_mem->kin_jacCurrent = SUNFALSE; if ((kin_mem->kin_sthrsh > ONEPT5) && (kin_mem->kin_lsetup != NULL)) { retval = kin_mem->kin_lsetup(kin_mem); kin_mem->kin_jacCurrent = SUNTRUE; kin_mem->kin_nnilset = kin_mem->kin_nni; kin_mem->kin_nnilset_sub = kin_mem->kin_nni; if (retval != 0) return(KIN_LSETUP_FAIL); } /* rename vectors for readability */ b = kin_mem->kin_unew; x = kin_mem->kin_pp; /* load b with the current value of -fval */ N_VScale(-ONE, kin_mem->kin_fval, b); /* call the generic 'lsolve' routine to solve the system Jx = b */ retval = kin_mem->kin_lsolve(kin_mem, x, b, &(kin_mem->kin_sJpnorm), &(kin_mem->kin_sFdotJp)); if (retval == 0) return(KIN_SUCCESS); else if (retval < 0) return(KIN_LSOLVE_FAIL); else if ((kin_mem->kin_lsetup == NULL) || (kin_mem->kin_jacCurrent)) return(KIN_LINSOLV_NO_RECOVERY); /* loop back only if the linear solver setup is in use and Jacobian information is not current */ kin_mem->kin_sthrsh = TWO; } } /* * KINFullNewton * * This routine is the main driver for the Full Newton * algorithm. Its purpose is to compute unew = uu + pp in the * direction pp from uu, taking the full Newton step. The * step may be constrained if the constraint conditions are * violated, or if the norm of pp is greater than mxnewtstep. */ static int KINFullNewton(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken) { realtype pnorm, ratio; booleantype fOK; int ircvr, retval; *maxStepTaken = SUNFALSE; pnorm = N_VWL2Norm(kin_mem->kin_pp, kin_mem->kin_uscale); ratio = ONE; if (pnorm > kin_mem->kin_mxnewtstep) { ratio = kin_mem->kin_mxnewtstep / pnorm; N_VScale(ratio, kin_mem->kin_pp, kin_mem->kin_pp); pnorm = kin_mem->kin_mxnewtstep; } if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM, "KINSOL", "KINFullNewton", INFO_PNORM, pnorm); /* If constraints are active, then constrain the step accordingly */ kin_mem->kin_stepl = pnorm; kin_mem->kin_stepmul = ONE; if (kin_mem->kin_constraintsSet) { retval = KINConstraint(kin_mem); if (retval == CONSTR_VIOLATED) { /* Apply stepmul set in KINConstraint */ ratio *= kin_mem->kin_stepmul; N_VScale(kin_mem->kin_stepmul, kin_mem->kin_pp, kin_mem->kin_pp); pnorm *= kin_mem->kin_stepmul; kin_mem->kin_stepl = pnorm; if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM, "KINSOL", "KINFullNewton", INFO_PNORM, pnorm); if (pnorm <= kin_mem->kin_scsteptol) { N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); return(STEP_TOO_SMALL);} } } /* Attempt (at most MAX_RECVR times) to evaluate function at the new iterate */ fOK = SUNFALSE; for (ircvr = 1; ircvr <= MAX_RECVR; ircvr++) { /* compute the iterate unew = uu + pp */ N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); /* evaluate func(unew) and its norm, and return */ retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; /* if func was successful, accept pp */ if (retval == 0) {fOK = SUNTRUE; break;} /* if func failed unrecoverably, give up */ else if (retval < 0) return(KIN_SYSFUNC_FAIL); /* func failed recoverably; cut step in half and try again */ ratio *= HALF; N_VScale(HALF, kin_mem->kin_pp, kin_mem->kin_pp); pnorm *= HALF; kin_mem->kin_stepl = pnorm; } /* If func() failed recoverably MAX_RECVR times, give up */ if (!fOK) return(KIN_REPTD_SYSFUNC_ERR); /* Evaluate function norms */ *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); *f1normp = HALF * (*fnormp) * (*fnormp); /* scale sFdotJp and sJpnorm by ratio for later use in KINForcingTerm */ kin_mem->kin_sFdotJp *= ratio; kin_mem->kin_sJpnorm *= ratio; if (kin_mem->kin_printfl > 1) KINPrintInfo(kin_mem, PRNT_FNORM, "KINSOL", "KINFullNewton", INFO_FNORM, *fnormp); if (pnorm > (POINT99 * kin_mem->kin_mxnewtstep)) *maxStepTaken = SUNTRUE; return(KIN_SUCCESS); } /* * KINLineSearch * * The routine KINLineSearch implements the LineSearch algorithm. * Its purpose is to find unew = uu + rl * pp in the direction pp * from uu so that: * t * func(unew) <= func(uu) + alpha * g (unew - uu) (alpha = 1.e-4) * * and * t * func(unew) >= func(uu) + beta * g (unew - uu) (beta = 0.9) * * where 0 < rlmin <= rl <= rlmax. * * Note: * mxnewtstep * rlmax = ---------------- if uu+pp is feasible * ||uscale*pp||_L2 * * rlmax = 1 otherwise * * and * * scsteptol * rlmin = -------------------------- * || pp || * || -------------------- ||_L-infinity * || (1/uscale + SUNRabs(uu)) || * * * If the system function fails unrecoverably at any time, KINLineSearch * returns KIN_SYSFUNC_FAIL which will halt the solver. * * We attempt to corect recoverable system function failures only before * the alpha-condition loop; i.e. when the solution is updated with the * full Newton step (possibly reduced due to constraint violations). * Once we find a feasible pp, we assume that any update up to pp is * feasible. * * If the step size is limited due to constraint violations and/or * recoverable system function failures, we set rlmax=1 to ensure * that the update remains feasible during the attempts to enforce * the beta-condition (this is not an issue while enforcing the alpha * condition, as rl can only decrease from 1 at that stage) */ static int KINLineSearch(KINMem kin_mem, realtype *fnormp, realtype *f1normp, booleantype *maxStepTaken) { realtype pnorm, ratio, slpi, rlmin, rlength, rl, rlmax, rldiff; realtype rltmp, rlprev, pt1trl, f1nprv, rllo, rlinc, alpha, beta; realtype alpha_cond, beta_cond, rl_a, tmp1, rl_b, tmp2, disc; int ircvr, nbktrk_l, retval; booleantype firstBacktrack, fOK; /* Initializations */ nbktrk_l = 0; /* local backtracking counter */ ratio = ONE; /* step change ratio */ alpha = POINT0001; beta = POINT9; firstBacktrack = SUNTRUE; *maxStepTaken = SUNFALSE; rlprev = f1nprv = ZERO; /* Compute length of Newton step */ pnorm = N_VWL2Norm(kin_mem->kin_pp, kin_mem->kin_uscale); rlmax = kin_mem->kin_mxnewtstep / pnorm; kin_mem->kin_stepl = pnorm; /* If the full Newton step is too large, set it to the maximum allowable value */ if(pnorm > kin_mem->kin_mxnewtstep ) { ratio = kin_mem->kin_mxnewtstep / pnorm; N_VScale(ratio, kin_mem->kin_pp, kin_mem->kin_pp); pnorm = kin_mem->kin_mxnewtstep; rlmax = ONE; kin_mem->kin_stepl = pnorm; } /* If constraint checking is activated, check and correct violations */ kin_mem->kin_stepmul = ONE; if(kin_mem->kin_constraintsSet){ retval = KINConstraint(kin_mem); if(retval == CONSTR_VIOLATED){ /* Apply stepmul set in KINConstraint */ N_VScale(kin_mem->kin_stepmul, kin_mem->kin_pp, kin_mem->kin_pp); ratio *= kin_mem->kin_stepmul; pnorm *= kin_mem->kin_stepmul; rlmax = ONE; kin_mem->kin_stepl = pnorm; if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_PNORM1, "KINSOL", "KINLineSearch", INFO_PNORM1, pnorm); if (pnorm <= kin_mem->kin_scsteptol) { N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); return(STEP_TOO_SMALL);} } } /* Attempt (at most MAX_RECVR times) to evaluate function at the new iterate */ fOK = SUNFALSE; for (ircvr = 1; ircvr <= MAX_RECVR; ircvr++) { /* compute the iterate unew = uu + pp */ N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_unew); /* evaluate func(unew) and its norm, and return */ retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; /* if func was successful, accept pp */ if (retval == 0) {fOK = SUNTRUE; break;} /* if func failed unrecoverably, give up */ else if (retval < 0) return(KIN_SYSFUNC_FAIL); /* func failed recoverably; cut step in half and try again */ N_VScale(HALF, kin_mem->kin_pp, kin_mem->kin_pp); ratio *= HALF; pnorm *= HALF; rlmax = ONE; kin_mem->kin_stepl = pnorm; } /* If func() failed recoverably MAX_RECVR times, give up */ if (!fOK) return(KIN_REPTD_SYSFUNC_ERR); /* Evaluate function norms */ *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); *f1normp = HALF * (*fnormp) * (*fnormp) ; /* Estimate the line search value rl (lambda) to satisfy both ALPHA and BETA conditions */ slpi = kin_mem->kin_sFdotJp * ratio; rlength = KINScSNorm(kin_mem, kin_mem->kin_pp, kin_mem->kin_uu); rlmin = (kin_mem->kin_scsteptol) / rlength; rl = ONE; if (kin_mem->kin_printfl > 2) KINPrintInfo(kin_mem, PRNT_LAM, "KINSOL", "KINLineSearch", INFO_LAM, rlmin, kin_mem->kin_f1norm, pnorm); /* Loop until the ALPHA condition is satisfied. Terminate if rl becomes too small */ for(;;) { /* Evaluate test quantity */ alpha_cond = kin_mem->kin_f1norm + (alpha * slpi * rl); if (kin_mem->kin_printfl > 2) KINPrintInfo(kin_mem, PRNT_ALPHA, "KINSOL", "KINLinesearch", INFO_ALPHA, *fnormp, *f1normp, alpha_cond, rl); /* If ALPHA condition is satisfied, break out from loop */ if ((*f1normp) <= alpha_cond) break; /* Backtracking. Use quadratic fit the first time and cubic fit afterwards. */ if (firstBacktrack) { rltmp = -slpi / (TWO * ((*f1normp) - kin_mem->kin_f1norm - slpi)); firstBacktrack = SUNFALSE; } else { tmp1 = (*f1normp) - kin_mem->kin_f1norm - (rl * slpi); tmp2 = f1nprv - kin_mem->kin_f1norm - (rlprev * slpi); rl_a = ((ONE / (rl * rl)) * tmp1) - ((ONE / (rlprev * rlprev)) * tmp2); rl_b = ((-rlprev / (rl * rl)) * tmp1) + ((rl / (rlprev * rlprev)) * tmp2); tmp1 = ONE / (rl - rlprev); rl_a *= tmp1; rl_b *= tmp1; disc = (rl_b * rl_b) - (THREE * rl_a * slpi); if (SUNRabs(rl_a) < kin_mem->kin_uround) { /* cubic is actually just a quadratic (rl_a ~ 0) */ rltmp = -slpi / (TWO * rl_b); } else { /* real cubic */ rltmp = (-rl_b + SUNRsqrt(disc)) / (THREE * rl_a); } } if (rltmp > (HALF * rl)) rltmp = HALF * rl; /* Set new rl (do not allow a reduction by a factor larger than 10) */ rlprev = rl; f1nprv = (*f1normp); pt1trl = POINT1 * rl; rl = SUNMAX(pt1trl, rltmp); nbktrk_l++; /* Update unew and re-evaluate function */ N_VLinearSum(ONE, kin_mem->kin_uu, rl, kin_mem->kin_pp, kin_mem->kin_unew); retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); *f1normp = HALF * (*fnormp) * (*fnormp) ; /* Check if rl (lambda) is too small */ if (rl < rlmin) { /* unew sufficiently distinct from uu cannot be found. copy uu into unew (step remains unchanged) and return STEP_TOO_SMALL */ N_VScale(ONE, kin_mem->kin_uu, kin_mem->kin_unew); return(STEP_TOO_SMALL); } } /* end ALPHA condition loop */ /* ALPHA condition is satisfied. Now check the BETA condition */ beta_cond = kin_mem->kin_f1norm + (beta * slpi * rl); if ((*f1normp) < beta_cond) { /* BETA condition not satisfied */ if ((rl == ONE) && (pnorm < kin_mem->kin_mxnewtstep)) { do { rlprev = rl; f1nprv = *f1normp; rl = SUNMIN((TWO * rl), rlmax); nbktrk_l++; N_VLinearSum(ONE, kin_mem->kin_uu, rl, kin_mem->kin_pp, kin_mem->kin_unew); retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); *f1normp = HALF * (*fnormp) * (*fnormp); alpha_cond = kin_mem->kin_f1norm + (alpha * slpi * rl); beta_cond = kin_mem->kin_f1norm + (beta * slpi * rl); if (kin_mem->kin_printfl > 2) KINPrintInfo(kin_mem, PRNT_BETA, "KINSOL", "KINLineSearch", INFO_BETA, *f1normp, beta_cond, rl); } while (((*f1normp) <= alpha_cond) && ((*f1normp) < beta_cond) && (rl < rlmax)); } /* end if (rl == ONE) block */ if ((rl < ONE) || ((rl > ONE) && (*f1normp > alpha_cond))) { rllo = SUNMIN(rl, rlprev); rldiff = SUNRabs(rlprev - rl); do { rlinc = HALF * rldiff; rl = rllo + rlinc; nbktrk_l++; N_VLinearSum(ONE, kin_mem->kin_uu, rl, kin_mem->kin_pp, kin_mem->kin_unew); retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); *f1normp = HALF * (*fnormp) * (*fnormp); alpha_cond = kin_mem->kin_f1norm + (alpha * slpi * rl); beta_cond = kin_mem->kin_f1norm + (beta * slpi * rl); if (kin_mem->kin_printfl > 2) KINPrintInfo(kin_mem, PRNT_ALPHABETA, "KINSOL", "KINLineSearch", INFO_ALPHABETA, *f1normp, alpha_cond, beta_cond, rl); if ((*f1normp) > alpha_cond) rldiff = rlinc; else if (*f1normp < beta_cond) { rllo = rl; rldiff = rldiff - rlinc; } } while ((*f1normp > alpha_cond) || ((*f1normp < beta_cond) && (rldiff >= rlmin))); if ( (*f1normp < beta_cond) || ((rldiff < rlmin) && (*f1normp > alpha_cond)) ) { /* beta condition could not be satisfied or rldiff too small and alpha_cond not satisfied, so set unew to last u value that satisfied the alpha condition and continue */ N_VLinearSum(ONE, kin_mem->kin_uu, rllo, kin_mem->kin_pp, kin_mem->kin_unew); retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval != 0) return(KIN_SYSFUNC_FAIL); *fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); *f1normp = HALF * (*fnormp) * (*fnormp); /* increment beta-condition failures counter */ kin_mem->kin_nbcf++; } } /* end of if (rl < ONE) block */ } /* end of if (f1normp < beta_cond) block */ /* Update number of backtracking operations */ kin_mem->kin_nbktrk += nbktrk_l; if (kin_mem->kin_printfl > 1) KINPrintInfo(kin_mem, PRNT_ADJ, "KINSOL", "KINLineSearch", INFO_ADJ, nbktrk_l); /* scale sFdotJp and sJpnorm by rl * ratio for later use in KINForcingTerm */ kin_mem->kin_sFdotJp = kin_mem->kin_sFdotJp * rl * ratio; kin_mem->kin_sJpnorm = kin_mem->kin_sJpnorm * rl * ratio; if ((rl * pnorm) > (POINT99 * kin_mem->kin_mxnewtstep)) *maxStepTaken = SUNTRUE; return(KIN_SUCCESS); } /* * Function : KINConstraint * * This routine checks if the proposed solution vector uu + pp * violates any constraints. If a constraint is violated, then the * scalar stepmul is determined such that uu + stepmul * pp does * not violate any constraints. * * Note: This routine is called by the functions * KINLineSearch and KINFullNewton. */ static int KINConstraint(KINMem kin_mem) { N_VLinearSum(ONE, kin_mem->kin_uu, ONE, kin_mem->kin_pp, kin_mem->kin_vtemp1); /* if vtemp1[i] violates constraint[i] then vtemp2[i] = 1 else vtemp2[i] = 0 (vtemp2 is the mask vector) */ if(N_VConstrMask(kin_mem->kin_constraints, kin_mem->kin_vtemp1, kin_mem->kin_vtemp2)) return(KIN_SUCCESS); /* vtemp1[i] = SUNRabs(pp[i]) */ N_VAbs(kin_mem->kin_pp, kin_mem->kin_vtemp1); /* consider vtemp1[i] only if vtemp2[i] = 1 (constraint violated) */ N_VProd(kin_mem->kin_vtemp2, kin_mem->kin_vtemp1, kin_mem->kin_vtemp1); N_VAbs(kin_mem->kin_uu, kin_mem->kin_vtemp2); kin_mem->kin_stepmul = POINT9 * N_VMinQuotient(kin_mem->kin_vtemp2, kin_mem->kin_vtemp1); return(CONSTR_VIOLATED); } /* * ----------------------------------------------------------------- * Stopping tests * ----------------------------------------------------------------- */ /* * KINStop * * This routine checks the current iterate unew to see if the * system func(unew) = 0 is satisfied by a variety of tests. * * strategy is one of KIN_NONE or KIN_LINESEARCH * sflag is one of KIN_SUCCESS, STEP_TOO_SMALL */ static int KINStop(KINMem kin_mem, booleantype maxStepTaken, int sflag) { realtype fmax, rlength, omexp; N_Vector delta; /* Check for too small a step */ if (sflag == STEP_TOO_SMALL) { if ((kin_mem->kin_lsetup != NULL) && !(kin_mem->kin_jacCurrent)) { /* If the Jacobian is out of date, update it and retry */ kin_mem->kin_sthrsh = TWO; return(RETRY_ITERATION); } else { /* Give up */ if (kin_mem->kin_globalstrategy == KIN_NONE) return(KIN_STEP_LT_STPTOL); else return(KIN_LINESEARCH_NONCONV); } } /* Check tolerance on scaled function norm at the current iterate */ fmax = KINScFNorm(kin_mem, kin_mem->kin_fval, kin_mem->kin_fscale); if (kin_mem->kin_printfl > 1) KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINStop", INFO_FMAX, fmax); if (fmax <= kin_mem->kin_fnormtol) return(KIN_SUCCESS); /* Check if the scaled distance between the last two steps is too small */ /* NOTE: pp used as work space to store this distance */ delta = kin_mem->kin_pp; N_VLinearSum(ONE, kin_mem->kin_unew, -ONE, kin_mem->kin_uu, delta); rlength = KINScSNorm(kin_mem, delta, kin_mem->kin_unew); if (rlength <= kin_mem->kin_scsteptol) { if ((kin_mem->kin_lsetup != NULL) && !(kin_mem->kin_jacCurrent)) { /* If the Jacobian is out of date, update it and retry */ kin_mem->kin_sthrsh = TWO; return(CONTINUE_ITERATIONS); } else { /* give up */ return(KIN_STEP_LT_STPTOL); } } /* Check if the maximum number of iterations is reached */ if (kin_mem->kin_nni >= kin_mem->kin_mxiter) return(KIN_MAXITER_REACHED); /* Check for consecutive number of steps taken of size mxnewtstep and if not maxStepTaken, then set ncscmx to 0 */ if (maxStepTaken) kin_mem->kin_ncscmx++; else kin_mem->kin_ncscmx = 0; if (kin_mem->kin_ncscmx == 5) return(KIN_MXNEWT_5X_EXCEEDED); /* Proceed according to the type of linear solver used */ if (kin_mem->kin_inexact_ls) { /* We're doing inexact Newton. Load threshold for reevaluating the Jacobian. */ kin_mem->kin_sthrsh = rlength; } else if (!(kin_mem->kin_noResMon)) { /* We're doing modified Newton and the user did not disable residual monitoring. Check if it is time to monitor residual. */ if ((kin_mem->kin_nni - kin_mem->kin_nnilset_sub) >= kin_mem->kin_msbset_sub) { /* Residual monitoring needed */ kin_mem->kin_nnilset_sub = kin_mem->kin_nni; /* If indicated, estimate new OMEGA value */ if (kin_mem->kin_eval_omega) { omexp = SUNMAX(ZERO,((kin_mem->kin_fnorm)/(kin_mem->kin_fnormtol))-ONE); kin_mem->kin_omega = (omexp > TWELVE)? kin_mem->kin_omega_max : SUNMIN(kin_mem->kin_omega_min * SUNRexp(omexp), kin_mem->kin_omega_max); } /* Check if making satisfactory progress */ if (kin_mem->kin_fnorm > kin_mem->kin_omega * kin_mem->kin_fnorm_sub) { /* Insufficient progress */ if ((kin_mem->kin_lsetup != NULL) && !(kin_mem->kin_jacCurrent)) { /* If the Jacobian is out of date, update it and retry */ kin_mem->kin_sthrsh = TWO; return(CONTINUE_ITERATIONS); } else { /* Otherwise, we cannot do anything, so just return. */ } } else { /* Sufficient progress */ kin_mem->kin_fnorm_sub = kin_mem->kin_fnorm; kin_mem->kin_sthrsh = ONE; } } else { /* Residual monitoring not needed */ /* Reset sthrsh */ if (kin_mem->kin_retry_nni || kin_mem->kin_update_fnorm_sub) kin_mem->kin_fnorm_sub = kin_mem->kin_fnorm; if (kin_mem->kin_update_fnorm_sub) kin_mem->kin_update_fnorm_sub = SUNFALSE; kin_mem->kin_sthrsh = ONE; } } /* if made it to here, then the iteration process is not finished so return CONTINUE_ITERATIONS flag */ return(CONTINUE_ITERATIONS); } /* * KINForcingTerm * * This routine computes eta, the scaling factor in the linear * convergence stopping tolerance eps when choice #1 or choice #2 * forcing terms are used. Eta is computed here for all but the * first iterative step, which is set to the default in routine * KINSolInit. * * This routine was written by Homer Walker of Utah State * University with subsequent modifications by Allan Taylor @ LLNL. * * It is based on the concepts of the paper 'Choosing the forcing * terms in an inexact Newton method', SIAM J Sci Comput, 17 * (1996), pp 16 - 32, or Utah State University Research Report * 6/94/75 of the same title. */ static void KINForcingTerm(KINMem kin_mem, realtype fnormp) { realtype eta_max, eta_min, eta_safe, linmodel_norm; eta_max = POINT9; eta_min = POINT0001; eta_safe = HALF; /* choice #1 forcing term */ if (kin_mem->kin_etaflag == KIN_ETACHOICE1) { /* compute the norm of f + Jp , scaled L2 norm */ linmodel_norm = SUNRsqrt((kin_mem->kin_fnorm * kin_mem->kin_fnorm) + (TWO * kin_mem->kin_sFdotJp) + (kin_mem->kin_sJpnorm * kin_mem->kin_sJpnorm)); /* form the safeguarded for choice #1 */ eta_safe = SUNRpowerR(kin_mem->kin_eta, kin_mem->kin_eta_alpha); kin_mem->kin_eta = SUNRabs(fnormp - linmodel_norm) / kin_mem->kin_fnorm; } /* choice #2 forcing term */ if (kin_mem->kin_etaflag == KIN_ETACHOICE2) { eta_safe = kin_mem->kin_eta_gamma * SUNRpowerR(kin_mem->kin_eta, kin_mem->kin_eta_alpha); kin_mem->kin_eta = kin_mem->kin_eta_gamma * SUNRpowerR((fnormp / kin_mem->kin_fnorm), kin_mem->kin_eta_alpha); } /* apply safeguards */ if(eta_safe < POINT1) eta_safe = ZERO; kin_mem->kin_eta = SUNMAX(kin_mem->kin_eta, eta_safe); kin_mem->kin_eta = SUNMAX(kin_mem->kin_eta, eta_min); kin_mem->kin_eta = SUNMIN(kin_mem->kin_eta, eta_max); return; } /* * ----------------------------------------------------------------- * Norm functions * ----------------------------------------------------------------- */ /* * Function : KINScFNorm * * This routine computes the max norm for scaled vectors. The * scaling vector is scale, and the vector of which the norm is to * be determined is vv. The returned value, fnormval, is the * resulting scaled vector norm. This routine uses N_Vector * functions from the vector module. */ static realtype KINScFNorm(KINMem kin_mem, N_Vector v, N_Vector scale) { N_VProd(scale, v, kin_mem->kin_vtemp1); return(N_VMaxNorm(kin_mem->kin_vtemp1)); } /* * Function : KINScSNorm * * This routine computes the max norm of the scaled steplength, ss. * Here ucur is the current step and usc is the u scale factor. */ static realtype KINScSNorm(KINMem kin_mem, N_Vector v, N_Vector u) { realtype length; N_VInv(kin_mem->kin_uscale, kin_mem->kin_vtemp1); N_VAbs(u, kin_mem->kin_vtemp2); N_VLinearSum(ONE, kin_mem->kin_vtemp1, ONE, kin_mem->kin_vtemp2, kin_mem->kin_vtemp1); N_VDiv(v, kin_mem->kin_vtemp1, kin_mem->kin_vtemp1); length = N_VMaxNorm(kin_mem->kin_vtemp1); return(length); } /* * ================================================================= * KINSOL Verbose output functions * ================================================================= */ /* * KINPrintInfo * * KINPrintInfo is a high level error handling function * Based on the value info_code, it composes the info message and * passes it to the info handler function. */ #define ihfun (kin_mem->kin_ihfun) #define ih_data (kin_mem->kin_ih_data) void KINPrintInfo(KINMem kin_mem, int info_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256], msg1[40]; char retstr[30]; int ret; /* Initialize argument processing (msgfrmt is the last required argument) */ va_start(ap, msgfmt); if (info_code == PRNT_RETVAL) { /* If info_code = PRNT_RETVAL, decode the numeric value */ ret = va_arg(ap, int); switch(ret) { case KIN_SUCCESS: sprintf(retstr, "KIN_SUCCESS"); break; case KIN_SYSFUNC_FAIL: sprintf(retstr, "KIN_SYSFUNC_FAIL"); break; case KIN_REPTD_SYSFUNC_ERR: sprintf(retstr, "KIN_REPTD_SYSFUNC_ERR"); break; case KIN_STEP_LT_STPTOL: sprintf(retstr, "KIN_STEP_LT_STPTOL"); break; case KIN_LINESEARCH_NONCONV: sprintf(retstr, "KIN_LINESEARCH_NONCONV"); break; case KIN_LINESEARCH_BCFAIL: sprintf(retstr, "KIN_LINESEARCH_BCFAIL"); break; case KIN_MAXITER_REACHED: sprintf(retstr, "KIN_MAXITER_REACHED"); break; case KIN_MXNEWT_5X_EXCEEDED: sprintf(retstr, "KIN_MXNEWT_5X_EXCEEDED"); break; case KIN_LINSOLV_NO_RECOVERY: sprintf(retstr, "KIN_LINSOLV_NO_RECOVERY"); break; case KIN_LSETUP_FAIL: sprintf(retstr, "KIN_PRECONDSET_FAILURE"); break; case KIN_LSOLVE_FAIL: sprintf(retstr, "KIN_PRECONDSOLVE_FAILURE"); break; } /* Compose the message */ sprintf(msg1, msgfmt, ret); sprintf(msg,"%s (%s)",msg1,retstr); } else { /* Compose the message */ vsprintf(msg, msgfmt, ap); } /* call the info message handler */ ihfun(module, fname, msg, ih_data); /* finalize argument processing */ va_end(ap); return; } /* * KINInfoHandler * * This is the default KINSOL info handling function. * It sends the info message to the stream pointed to by kin_infofp */ #define infofp (kin_mem->kin_infofp) void KINInfoHandler(const char *module, const char *function, char *msg, void *data) { KINMem kin_mem; /* data points to kin_mem here */ kin_mem = (KINMem) data; #ifndef NO_FPRINTF_OUTPUT if (infofp != NULL) { fprintf(infofp,"\n[%s] %s\n",module, function); fprintf(infofp," %s\n",msg); } #endif } /* * ================================================================= * KINSOL Error Handling functions * ================================================================= */ /* * KINProcessError * * KINProcessError is a high level error handling function. * - If cv_mem==NULL it prints the error message to stderr. * - Otherwise, it sets up and calls the error handling function * pointed to by cv_ehfun. */ #define ehfun (kin_mem->kin_ehfun) #define eh_data (kin_mem->kin_eh_data) void KINProcessError(KINMem kin_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to KINProcessError) */ va_start(ap, msgfmt); /* Compose the message */ vsprintf(msg, msgfmt, ap); if (kin_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT fprintf(stderr, "\n[%s ERROR] %s\n ", module, fname); fprintf(stderr, "%s\n\n", msg); #endif } else { /* We can call ehfun */ ehfun(error_code, module, fname, msg, eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* * KINErrHandler * * This is the default error handling function. * It sends the error message to the stream pointed to by kin_errfp */ void KINErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { KINMem kin_mem; char err_type[10]; /* data points to kin_mem here */ kin_mem = (KINMem) data; if (error_code == KIN_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (kin_mem->kin_errfp != NULL) { fprintf(kin_mem->kin_errfp,"\n[%s %s] %s\n",module,err_type,function); fprintf(kin_mem->kin_errfp," %s\n\n",msg); } #endif return; } /* * ======================================================================= * Picard and fixed point solvers * ======================================================================= */ /* * KINPicardAA * * This routine is the main driver for the Picard iteration with * acclerated fixed point. */ static int KINPicardAA(KINMem kin_mem, long int *iterp, realtype *R, realtype *gamma, realtype *fmaxptr) { int retval, ret; long int iter; realtype fmax, epsmin, fnormp; N_Vector delta, gval; delta = kin_mem->kin_vtemp1; gval = kin_mem->kin_gval; ret = CONTINUE_ITERATIONS; fmax = kin_mem->kin_fnormtol + ONE; iter = 0; epsmin = ZERO; fnormp = -ONE; N_VConst(ZERO, gval); /* if eps is to be bounded from below, set the bound */ if (kin_mem->kin_inexact_ls && !(kin_mem->kin_noMinEps)) epsmin = POINT01 * kin_mem->kin_fnormtol; while (ret == CONTINUE_ITERATIONS) { iter++; /* Update the forcing term for the inexact linear solves */ if (kin_mem->kin_inexact_ls) { kin_mem->kin_eps = (kin_mem->kin_eta + kin_mem->kin_uround) * kin_mem->kin_fnorm; if(!(kin_mem->kin_noMinEps)) kin_mem->kin_eps = SUNMAX(epsmin, kin_mem->kin_eps); } /* evaluate g = uu - L^{-1}func(uu) and return if failed. For Picard, assume that the fval vector has been filled with an eval of the nonlinear residual prior to this call. */ retval = KINPicardFcnEval(kin_mem, gval, kin_mem->kin_uu, kin_mem->kin_fval); if (retval < 0) { ret = KIN_SYSFUNC_FAIL; break; } if (kin_mem->kin_m_aa == 0) { N_VScale(ONE, gval, kin_mem->kin_unew); } else { /* use Anderson, if desired */ N_VScale(ONE, kin_mem->kin_uu, kin_mem->kin_unew); AndersonAcc(kin_mem, gval, delta, kin_mem->kin_unew, kin_mem->kin_uu, (int)(iter-1), R, gamma); } /* Fill the Newton residual based on the new solution iterate */ retval = kin_mem->kin_func(kin_mem->kin_unew, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval < 0) { ret = KIN_SYSFUNC_FAIL; break; } /* Evaluate function norms */ fnormp = N_VWL2Norm(kin_mem->kin_fval, kin_mem->kin_fscale); fmax = KINScFNorm(kin_mem, kin_mem->kin_fval, kin_mem->kin_fscale); /* measure || F(x) ||_max */ kin_mem->kin_fnorm = fmax; *fmaxptr = fmax; if (kin_mem->kin_printfl > 1) KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINPicardAA", INFO_FMAX, fmax); /* print the current iter, fnorm, and nfe values if printfl > 0 */ if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINPicardAA", INFO_NNI, iter, kin_mem->kin_nfe, kin_mem->kin_fnorm); /* Check if the maximum number of iterations is reached */ if (iter >= kin_mem->kin_mxiter) { ret = KIN_MAXITER_REACHED; } if (fmax <= kin_mem->kin_fnormtol) { ret = KIN_SUCCESS; } /* Update with new iterate. */ N_VScale(ONE, kin_mem->kin_unew, kin_mem->kin_uu); if (ret == CONTINUE_ITERATIONS) { /* evaluate eta by calling the forcing term routine */ if (kin_mem->kin_callForcingTerm) KINForcingTerm(kin_mem, fnormp); } fflush(kin_mem->kin_errfp); } /* end of loop; return */ *iterp = iter; if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINPicardAA", INFO_RETVAL, ret); return(ret); } /* * KINPicardFcnEval * * This routine evaluates the Picard fixed point function * using the linear solver, gval = u - L^{-1}F(u). * The function assumes the user has defined L either through * a user-supplied matvec if using a SPILS solver or through * a supplied matrix if using a dense solver. This assumption is * tested by a check on the strategy and the requisite functionality * within the linear solve routines. * * This routine fills gval = uu - L^{-1}F(uu) given uu and fval = F(uu). */ static int KINPicardFcnEval(KINMem kin_mem, N_Vector gval, N_Vector uval, N_Vector fval1) { int retval; if ((kin_mem->kin_nni - kin_mem->kin_nnilset) >= kin_mem->kin_msbset) { kin_mem->kin_sthrsh = TWO; kin_mem->kin_update_fnorm_sub = SUNTRUE; } for(;;){ kin_mem->kin_jacCurrent = SUNFALSE; if ((kin_mem->kin_sthrsh > ONEPT5) && (kin_mem->kin_lsetup != NULL)) { retval = kin_mem->kin_lsetup(kin_mem); kin_mem->kin_jacCurrent = SUNTRUE; kin_mem->kin_nnilset = kin_mem->kin_nni; kin_mem->kin_nnilset_sub = kin_mem->kin_nni; if (retval != 0) return(KIN_LSETUP_FAIL); } /* call the generic 'lsolve' routine to solve the system Lx = -fval Note that we are using gval to hold x. */ N_VScale(-ONE, fval1, fval1); retval = kin_mem->kin_lsolve(kin_mem, gval, fval1, &(kin_mem->kin_sJpnorm), &(kin_mem->kin_sFdotJp)); if (retval == 0) { /* Update gval = uval + gval since gval = -L^{-1}F(uu) */ N_VLinearSum(ONE, uval, ONE, gval, gval); return(KIN_SUCCESS); } else if (retval < 0) return(KIN_LSOLVE_FAIL); else if ((kin_mem->kin_lsetup == NULL) || (kin_mem->kin_jacCurrent)) return(KIN_LINSOLV_NO_RECOVERY); /* loop back only if the linear solver setup is in use and matrix information is not current */ kin_mem->kin_sthrsh = TWO; } } /* * KINFP * * This routine is the main driver for the fixed point iteration with * Anderson Acceleration. */ static int KINFP(KINMem kin_mem, long int *iterp, realtype *R, realtype *gamma, realtype *fmaxptr) { int retval, ret; long int iter; realtype fmax; N_Vector delta; delta = kin_mem->kin_vtemp1; ret = CONTINUE_ITERATIONS; fmax = kin_mem->kin_fnormtol + ONE; iter = 0; while (ret == CONTINUE_ITERATIONS) { iter++; /* evaluate func(uu) and return if failed */ retval = kin_mem->kin_func(kin_mem->kin_uu, kin_mem->kin_fval, kin_mem->kin_user_data); kin_mem->kin_nfe++; if (retval < 0) { ret = KIN_SYSFUNC_FAIL; break; } if (kin_mem->kin_m_aa == 0) { N_VScale(ONE, kin_mem->kin_fval, kin_mem->kin_unew); } else { /* use Anderson, if desired */ AndersonAcc(kin_mem, kin_mem->kin_fval, delta, kin_mem->kin_unew, kin_mem->kin_uu, (int)(iter-1), R, gamma); } N_VLinearSum(ONE, kin_mem->kin_unew, -ONE, kin_mem->kin_uu, delta); fmax = KINScFNorm(kin_mem, delta, kin_mem->kin_fscale); /* measure || g(x)-x || */ if (kin_mem->kin_printfl > 1) KINPrintInfo(kin_mem, PRNT_FMAX, "KINSOL", "KINFP", INFO_FMAX, fmax); kin_mem->kin_fnorm = fmax; *fmaxptr = fmax; /* print the current iter, fnorm, and nfe values if printfl > 0 */ if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_NNI, "KINSOL", "KINFP", INFO_NNI, iter, kin_mem->kin_nfe, kin_mem->kin_fnorm); /* Check if the maximum number of iterations is reached */ if (iter >= kin_mem->kin_mxiter) { ret = KIN_MAXITER_REACHED; } if (fmax <= kin_mem->kin_fnormtol) { ret = KIN_SUCCESS; } if (ret == CONTINUE_ITERATIONS) { /* Only update solution if taking a next iteration. */ /* CSW Should put in a conditional to send back the newest iterate or the one consistent with the fval */ N_VScale(ONE, kin_mem->kin_unew, kin_mem->kin_uu); } fflush(kin_mem->kin_errfp); } /* end of loop; return */ *iterp = iter; if (kin_mem->kin_printfl > 0) KINPrintInfo(kin_mem, PRNT_RETVAL, "KINSOL", "KINFP", INFO_RETVAL, ret); return(ret); } /* ----------------------------------------------------------------- * Stopping tests * ----------------------------------------------------------------- */ /* * ======================================================================== * Anderson Acceleration * ======================================================================== */ static int AndersonAcc(KINMem kin_mem, N_Vector gval, N_Vector fv, N_Vector x, N_Vector xold, int iter, realtype *R, realtype *gamma) { int i_pt, i, j, lAA, retval; int *ipt_map; realtype alfa; realtype a, b, temp, c, s; /* local shortcuts for fused vector operation */ int nvec=0; realtype* cv=kin_mem->kin_cv; N_Vector* Xv=kin_mem->kin_Xv; ipt_map = kin_mem->kin_ipt_map; i_pt = iter-1 - ((iter-1)/kin_mem->kin_m_aa)*kin_mem->kin_m_aa; N_VLinearSum(ONE, gval, -1.0, xold, fv); if (iter > 0) { /* compute dg_new = gval -gval_old*/ N_VLinearSum(ONE, gval, -1.0, kin_mem->kin_gold_aa, kin_mem->kin_dg_aa[i_pt]); /* compute df_new = fval - fval_old */ N_VLinearSum(ONE, fv, -1.0, kin_mem->kin_fold_aa, kin_mem->kin_df_aa[i_pt]); } N_VScale(ONE, gval, kin_mem->kin_gold_aa); N_VScale(ONE, fv, kin_mem->kin_fold_aa); if (iter == 0) { N_VScale(ONE, gval, x); } else { if (iter == 1) { R[0] = sqrt(N_VDotProd(kin_mem->kin_df_aa[i_pt], kin_mem->kin_df_aa[i_pt])); alfa = 1/R[0]; N_VScale(alfa, kin_mem->kin_df_aa[i_pt], kin_mem->kin_q_aa[i_pt]); ipt_map[0] = 0; } else if (iter <= kin_mem->kin_m_aa) { N_VScale(ONE, kin_mem->kin_df_aa[i_pt], kin_mem->kin_vtemp2); for (j=0; j < (iter-1); j++) { ipt_map[j] = j; R[(iter-1)*kin_mem->kin_m_aa+j] = N_VDotProd(kin_mem->kin_q_aa[j], kin_mem->kin_vtemp2); N_VLinearSum(ONE,kin_mem->kin_vtemp2, -R[(iter-1)*kin_mem->kin_m_aa+j], kin_mem->kin_q_aa[j], kin_mem->kin_vtemp2); } R[(iter-1)*kin_mem->kin_m_aa+iter-1] = sqrt(N_VDotProd(kin_mem->kin_vtemp2, kin_mem->kin_vtemp2)); N_VScale((1/R[(iter-1)*kin_mem->kin_m_aa+iter-1]), kin_mem->kin_vtemp2, kin_mem->kin_q_aa[i_pt]); ipt_map[iter-1] = iter-1; } else { /* Delete left-most column vector from QR factorization */ for (i=0; i < kin_mem->kin_m_aa-1; i++) { a = R[(i+1)*kin_mem->kin_m_aa + i]; b = R[(i+1)*kin_mem->kin_m_aa + i+1]; temp = sqrt(a*a + b*b); c = a / temp; s = b / temp; R[(i+1)*kin_mem->kin_m_aa + i] = temp; R[(i+1)*kin_mem->kin_m_aa + i+1] = 0.0; /* OK to re-use temp */ if (i < kin_mem->kin_m_aa-1) { for (j = i+2; j < kin_mem->kin_m_aa; j++) { a = R[j*kin_mem->kin_m_aa + i]; b = R[j*kin_mem->kin_m_aa + i+1]; temp = c * a + s * b; R[j*kin_mem->kin_m_aa + i+1] = -s*a + c*b; R[j*kin_mem->kin_m_aa + i] = temp; } } N_VLinearSum(c, kin_mem->kin_q_aa[i], s, kin_mem->kin_q_aa[i+1], kin_mem->kin_vtemp2); N_VLinearSum(-s, kin_mem->kin_q_aa[i], c, kin_mem->kin_q_aa[i+1], kin_mem->kin_q_aa[i+1]); N_VScale(ONE, kin_mem->kin_vtemp2, kin_mem->kin_q_aa[i]); } /* Shift R to the left by one. */ for (i = 1; i < kin_mem->kin_m_aa; i++) { for (j = 0; j < kin_mem->kin_m_aa-1; j++) { R[(i-1)*kin_mem->kin_m_aa + j] = R[i*kin_mem->kin_m_aa + j]; } } /* Add the new df vector */ N_VScale(ONE, kin_mem->kin_df_aa[i_pt], kin_mem->kin_vtemp2); for (j=0; j < (kin_mem->kin_m_aa-1); j++) { R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+j] = N_VDotProd(kin_mem->kin_q_aa[j], kin_mem->kin_vtemp2); N_VLinearSum(ONE, kin_mem->kin_vtemp2, -R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+j], kin_mem->kin_q_aa[j],kin_mem->kin_vtemp2); } R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+kin_mem->kin_m_aa-1] = sqrt(N_VDotProd(kin_mem->kin_vtemp2, kin_mem->kin_vtemp2)); N_VScale((1/R[(kin_mem->kin_m_aa-1)*kin_mem->kin_m_aa+kin_mem->kin_m_aa-1]), kin_mem->kin_vtemp2, kin_mem->kin_q_aa[kin_mem->kin_m_aa-1]); /* Update the iteration map */ j = 0; for (i=i_pt+1; i < kin_mem->kin_m_aa; i++) ipt_map[j++] = i; for (i=0; i < (i_pt+1); i++) ipt_map[j++] = i; } /* Solve least squares problem and update solution */ lAA = iter; if (kin_mem->kin_m_aa < iter) lAA = kin_mem->kin_m_aa; retval = N_VDotProdMulti(lAA, fv, kin_mem->kin_q_aa, gamma); if (retval != KIN_SUCCESS) return(KIN_VECTOROP_ERR); /* set arrays for fused vector operation */ cv[0] = ONE; Xv[0] = gval; nvec = 1; for (i=lAA-1; i > -1; i--) { for (j=i+1; j < lAA; j++) { gamma[i] = gamma[i]-R[j*kin_mem->kin_m_aa+i]*gamma[j]; } gamma[i] = gamma[i]/R[i*kin_mem->kin_m_aa+i]; cv[nvec] = -gamma[i]; Xv[nvec] = kin_mem->kin_dg_aa[ipt_map[i]]; nvec += 1; } /* update solution */ retval = N_VLinearCombination(nvec, cv, Xv, x); if (retval != KIN_SUCCESS) return(KIN_VECTOROP_ERR); } return 0; } StanHeaders/src/kinsol/kinsol_impl.h0000644000176200001440000005565713766554457017302 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * KINSOL solver module header file (private version) * ----------------------------------------------------------------- */ #ifndef _KINSOL_IMPL_H #define _KINSOL_IMPL_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ================================================================= * M A I N S O L V E R M E M O R Y B L O C K * ================================================================= */ /* KINSOL default constants */ #define PRINTFL_DEFAULT 0 #define MXITER_DEFAULT 200 #define MXNBCF_DEFAULT 10 #define MSBSET_DEFAULT 10 #define MSBSET_SUB_DEFAULT 5 #define OMEGA_MIN RCONST(0.00001) #define OMEGA_MAX RCONST(0.9) /* * ----------------------------------------------------------------- * Types : struct KINMemRec and struct *KINMem * ----------------------------------------------------------------- * A variable declaration of type struct *KINMem denotes a * pointer to a data structure of type struct KINMemRec. The * KINMemRec structure contains numerous fields that must be * accessible by KINSOL solver module routines. * ----------------------------------------------------------------- */ typedef struct KINMemRec { realtype kin_uround; /* machine epsilon (or unit roundoff error) (defined in sundials_types.h) */ /* problem specification data */ KINSysFn kin_func; /* nonlinear system function implementation */ void *kin_user_data; /* work space available to func routine */ realtype kin_fnormtol; /* stopping tolerance on L2-norm of function value */ realtype kin_scsteptol; /* scaled step length tolerance */ int kin_globalstrategy; /* choices are KIN_NONE, KIN_LINESEARCH KIN_PICARD and KIN_FP */ int kin_printfl; /* level of verbosity of output */ long int kin_mxiter; /* maximum number of nonlinear iterations */ long int kin_msbset; /* maximum number of nonlinear iterations that may be performed between calls to the linear solver setup routine (lsetup) */ long int kin_msbset_sub; /* subinterval length for residual monitoring */ long int kin_mxnbcf; /* maximum number of beta condition failures */ int kin_etaflag; /* choices are KIN_ETACONSTANT, KIN_ETACHOICE1 and KIN_ETACHOICE2 */ booleantype kin_noMinEps; /* flag controlling whether or not the value of eps is bounded below */ booleantype kin_constraintsSet; /* flag indicating if constraints are being used */ booleantype kin_jacCurrent; /* flag indicating if the Jacobian info. used by the linear solver is current */ booleantype kin_callForcingTerm; /* flag set if using either KIN_ETACHOICE1 or KIN_ETACHOICE2 */ booleantype kin_noResMon; /* flag indicating if the nonlinear residual monitoring scheme should be used */ booleantype kin_retry_nni; /* flag indicating if nonlinear iteration should be retried (set by residual monitoring algorithm) */ booleantype kin_update_fnorm_sub; /* flag indicating if the fnorm associated with the subinterval needs to be updated (set by residual monitoring algorithm) */ realtype kin_mxnewtstep; /* maximum allowable scaled step length */ realtype kin_mxnstepin; /* input (or preset) value for mxnewtstep */ realtype kin_sqrt_relfunc; /* relative error bound for func(u) */ realtype kin_stepl; /* scaled length of current step */ realtype kin_stepmul; /* step scaling factor */ realtype kin_eps; /* current value of eps */ realtype kin_eta; /* current value of eta */ realtype kin_eta_gamma; /* gamma value used in eta calculation (choice #2) */ realtype kin_eta_alpha; /* alpha value used in eta calculation (choice #2) */ booleantype kin_noInitSetup; /* flag controlling whether or not the KINSol routine makes an initial call to the linear solver setup routine (lsetup) */ realtype kin_sthrsh; /* threshold value for calling the linear solver setup routine */ /* counters */ long int kin_nni; /* number of nonlinear iterations */ long int kin_nfe; /* number of calls made to func routine */ long int kin_nnilset; /* value of nni counter when the linear solver setup was last called */ long int kin_nnilset_sub; /* value of nni counter when the linear solver setup was last called (subinterval) */ long int kin_nbcf; /* number of times the beta-condition could not be met in KINLineSearch */ long int kin_nbktrk; /* number of backtracks performed by KINLineSearch */ long int kin_ncscmx; /* number of consecutive steps of size mxnewtstep taken */ /* vectors */ N_Vector kin_uu; /* solution vector/current iterate (initially contains initial guess, but holds approximate solution upon completion if no errors occurred) */ N_Vector kin_unew; /* next iterate (unew = uu+pp) */ N_Vector kin_fval; /* vector containing result of nonlinear system function evaluated at a given iterate (fval = func(uu)) */ N_Vector kin_gval; /* vector containing result of the fixed point function evaluated at a given iterate; used in KIN_PICARD strategy only. (gval = uu - L^{-1}fval(uu)) */ N_Vector kin_uscale; /* iterate scaling vector */ N_Vector kin_fscale; /* fval scaling vector */ N_Vector kin_pp; /* incremental change vector (pp = unew-uu) */ N_Vector kin_constraints; /* constraints vector */ N_Vector kin_vtemp1; /* scratch vector #1 */ N_Vector kin_vtemp2; /* scratch vector #2 */ /* space requirements for AA, Broyden and NLEN */ N_Vector kin_fold_aa; /* vector needed for AA, Broyden, and NLEN */ N_Vector kin_gold_aa; /* vector needed for AA, Broyden, and NLEN */ N_Vector *kin_df_aa; /* vector array needed for AA, Broyden, and NLEN */ N_Vector *kin_dg_aa; /* vector array needed for AA, Broyden and NLEN */ N_Vector *kin_q_aa; /* vector array needed for AA */ realtype *kin_gamma_aa; /* array of size maa used in AA */ realtype *kin_R_aa; /* array of size maa*maa used in AA */ int *kin_ipt_map; /* array of size maa used in AA */ sunindextype kin_m_aa; /* parameter for AA, Broyden or NLEN */ booleantype kin_aamem_aa; /* sets additional memory needed for Anderson Acc */ booleantype kin_setstop_aa; /* determines whether user will set stopping criterion */ realtype *kin_cv; /* scalar array for fused vector operations */ N_Vector *kin_Xv; /* vector array for fused vector operations */ /* space requirements for vector storage */ sunindextype kin_lrw1; /* number of realtype-sized memory blocks needed for a single N_Vector */ sunindextype kin_liw1; /* number of int-sized memory blocks needed for a single N_Vecotr */ long int kin_lrw; /* total number of realtype-sized memory blocks needed for all KINSOL work vectors */ long int kin_liw; /* total number of int-sized memory blocks needed for all KINSOL work vectors */ /* linear solver data */ /* function prototypes (pointers) */ int (*kin_linit)(struct KINMemRec *kin_mem); int (*kin_lsetup)(struct KINMemRec *kin_mem); int (*kin_lsolve)(struct KINMemRec *kin_mem, N_Vector xx, N_Vector bb, realtype *sJpnorm, realtype *sFdotJp); int (*kin_lfree)(struct KINMemRec *kin_mem); booleantype kin_inexact_ls; /* flag set by the linear solver module (in linit) indicating whether this is an iterative linear solver (SUNTRUE), or a direct linear solver (SUNFALSE) */ void *kin_lmem; /* pointer to linear solver memory block */ realtype kin_fnorm; /* value of L2-norm of fscale*fval */ realtype kin_f1norm; /* f1norm = 0.5*(fnorm)^2 */ realtype kin_sFdotJp; /* value of scaled F(u) vector (fscale*fval) dotted with scaled J(u)*pp vector (set by lsolve) */ realtype kin_sJpnorm; /* value of L2-norm of fscale*(J(u)*pp) (set by lsolve) */ realtype kin_fnorm_sub; /* value of L2-norm of fscale*fval (subinterval) */ booleantype kin_eval_omega; /* flag indicating that omega must be evaluated. */ realtype kin_omega; /* constant value for real scalar used in test to determine if reduction of norm of nonlinear residual is sufficient. Unless a valid constant value is specified by the user, omega is estimated from omega_min and omega_max at each iteration. */ realtype kin_omega_min; /* lower bound on omega */ realtype kin_omega_max; /* upper bound on omega */ /* * ----------------------------------------------------------------- * Note: The KINLineSearch subroutine scales the values of the * variables sFdotJp and sJpnorm by a factor rl (lambda) that is * chosen by the line search algorithm such that the sclaed Newton * step satisfies the following conditions: * * F(u_k+1) <= F(u_k) + alpha*(F(u_k)^T * J(u_k))*p*rl * * F(u_k+1) >= F(u_k) + beta*(F(u_k)^T * J(u_k))*p*rl * * where alpha = 1.0e-4, beta = 0.9, u_k+1 = u_k + rl*p, * 0 < rl <= 1, J denotes the system Jacobian, and F represents * the nonliner system function. * ----------------------------------------------------------------- */ booleantype kin_MallocDone; /* flag indicating if KINMalloc has been called yet */ /* message files */ /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ KINErrHandlerFn kin_ehfun; /* Error messages are handled by ehfun */ void *kin_eh_data; /* dats pointer passed to ehfun */ FILE *kin_errfp; /* KINSOL error messages are sent to errfp */ KINInfoHandlerFn kin_ihfun; /* Info messages are handled by ihfun */ void *kin_ih_data; /* dats pointer passed to ihfun */ FILE *kin_infofp; /* where KINSol info messages are sent */ } *KINMem; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R * ================================================================= */ /* * ----------------------------------------------------------------- * Function : int (*kin_linit)(KINMem kin_mem) * ----------------------------------------------------------------- * kin_linit initializes solver-specific data structures (including * variables used as counters or for storing statistical information), * but system memory allocation should be done by the subroutine * that actually initializes the environment for liner solver * package. If the linear system is to be preconditioned, then the * variable setupNonNull (type booleantype) should be set to SUNTRUE * (predefined constant) and the kin_lsetup routine should be * appropriately defined. * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * * If the necessary variables have been successfully initialized, * then the kin_linit function should return 0 (zero). Otherwise, * the subroutine should indicate a failure has occurred by * returning a non-zero integer value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : int (*kin_lsetup)(KINMem kin_mem) * ----------------------------------------------------------------- * kin_lsetup interfaces with the user-supplied pset subroutine (the * preconditioner setup routine), and updates relevant variable * values (see KINSpgmrSetup/KINSpbcgSetup). Simply stated, the * kin_lsetup routine prepares the linear solver for a subsequent * call to the user-supplied kin_lsolve function. * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * * If successful, the kin_lsetup routine should return 0 (zero). * Otherwise it should return a non-zero value. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : int (*kin_lsolve)(KINMem kin_mem, N_Vector xx, * N_Vector bb, realtype *sJpnorm, realtype *sFdotJp) * ----------------------------------------------------------------- * kin_lsolve interfaces with the subroutine implementing the * numerical method to be used to solve the linear system J*xx = bb, * and must increment the relevant counter variable values in * addition to computing certain values used by the global strategy * and forcing term routines (see KINInexactNewton, KINLineSearch, * KINForcingTerm, and KINSpgmrSolve/KINSpbcgSolve). * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * * xx vector (type N_Vector) set to initial guess by kin_lsolve * routine prior to calling the linear solver, but which upon * return contains an approximate solution of the linear * system J*xx = bb, where J denotes the system Jacobian * * bb vector (type N_Vector) set to -func(u) (negative of the * value of the system function evaluated at the current * iterate) by KINLinSolDrv before kin_lsolve is called * * sJpnorm holds the value of the L2-norm (Euclidean norm) of * fscale*(J(u)*pp) upon return * * sFdotJp holds the value of the scaled F(u) (fscale*F) dotted * with the scaled J(u)*pp vector upon return * * If successful, the kin_lsolve routine should return 0 (zero). * Otherwise it should return a positive value if a re-evaluation * of the lsetup function could recover, or a negative value if * no such recovery is possible. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : int (*kin_lfree)(KINMem kin_mem) * ----------------------------------------------------------------- * kin_lfree is called by KINFree and should free (deallocate) all * system memory resources allocated for the linear solver module * (see KINSpgmrFree/KINSpbcgFree). It should return 0 upon * success, nonzero on failure. * * kinmem pointer to an internal memory block allocated during * prior calls to KINCreate and KINMalloc * ----------------------------------------------------------------- */ /* * ================================================================= * K I N S O L I N T E R N A L F U N C T I O N S * ================================================================= */ /* High level error handler */ void KINProcessError(KINMem kin_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void KINErrHandler(int error_code, const char *module, const char *function, char *msg, void *user_data); /* High level info handler */ void KINPrintInfo(KINMem kin_mem, int info_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal infoHandler function */ void KINInfoHandler(const char *module, const char *function, char *msg, void *user_data); /* * ================================================================= * K I N S O L E R R O R M E S S A G E S * ================================================================= */ #define MSG_MEM_FAIL "A memory request failed." #define MSG_NO_MEM "kinsol_mem = NULL illegal." #define MSG_BAD_NVECTOR "A required vector operation is not implemented." #define MSG_FUNC_NULL "func = NULL illegal." #define MSG_NO_MALLOC "Attempt to call before KINMalloc illegal." #define MSG_BAD_PRINTFL "Illegal value for printfl." #define MSG_BAD_MXITER "Illegal value for mxiter." #define MSG_BAD_MSBSET "Illegal msbset < 0." #define MSG_BAD_MSBSETSUB "Illegal msbsetsub < 0." #define MSG_BAD_ETACHOICE "Illegal value for etachoice." #define MSG_BAD_ETACONST "eta out of range." #define MSG_BAD_GAMMA "gamma out of range." #define MSG_BAD_ALPHA "alpha out of range." #define MSG_BAD_MXNEWTSTEP "Illegal mxnewtstep < 0." #define MSG_BAD_RELFUNC "relfunc < 0 illegal." #define MSG_BAD_FNORMTOL "fnormtol < 0 illegal." #define MSG_BAD_SCSTEPTOL "scsteptol < 0 illegal." #define MSG_BAD_MXNBCF "mxbcf < 0 illegal." #define MSG_BAD_CONSTRAINTS "Illegal values in constraints vector." #define MSG_BAD_OMEGA "scalars < 0 illegal." #define MSG_BAD_MAA "maa < 0 illegal." #define MSG_ZERO_MAA "maa = 0 illegal." #define MSG_LSOLV_NO_MEM "The linear solver memory pointer is NULL." #define MSG_UU_NULL "uu = NULL illegal." #define MSG_BAD_GLSTRAT "Illegal value for global strategy." #define MSG_BAD_USCALE "uscale = NULL illegal." #define MSG_USCALE_NONPOSITIVE "uscale has nonpositive elements." #define MSG_BAD_FSCALE "fscale = NULL illegal." #define MSG_FSCALE_NONPOSITIVE "fscale has nonpositive elements." #define MSG_CONSTRAINTS_NOTOK "Constraints not allowed with fixed point or Picard iterations" #define MSG_INITIAL_CNSTRNT "Initial guess does NOT meet constraints." #define MSG_LINIT_FAIL "The linear solver's init routine failed." #define MSG_SYSFUNC_FAILED "The system function failed in an unrecoverable manner." #define MSG_SYSFUNC_FIRST "The system function failed at the first call." #define MSG_LSETUP_FAILED "The linear solver's setup function failed in an unrecoverable manner." #define MSG_LSOLVE_FAILED "The linear solver's solve function failed in an unrecoverable manner." #define MSG_LINSOLV_NO_RECOVERY "The linear solver's solve function failed recoverably, but the Jacobian data is already current." #define MSG_LINESEARCH_NONCONV "The line search algorithm was unable to find an iterate sufficiently distinct from the current iterate." #define MSG_LINESEARCH_BCFAIL "The line search algorithm was unable to satisfy the beta-condition for nbcfails iterations." #define MSG_MAXITER_REACHED "The maximum number of iterations was reached before convergence." #define MSG_MXNEWT_5X_EXCEEDED "Five consecutive steps have been taken that satisfy a scaled step length test." #define MSG_SYSFUNC_REPTD "Unable to correct repeated recoverable system function errors." #define MSG_NOL_FAIL "Unable to find user's Linear Jacobian, which is required for the KIN_PICARD Strategy" /* * ================================================================= * K I N S O L I N F O M E S S A G E S * ================================================================= */ #define INFO_RETVAL "Return value: %d" #define INFO_ADJ "no. of lambda adjustments = %ld" #if defined(SUNDIALS_EXTENDED_PRECISION) #define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16Lg" #define INFO_TOL "scsteptol = %12.3Lg fnormtol = %12.3Lg" #define INFO_FMAX "scaled f norm (for stopping) = %12.3Lg" #define INFO_PNORM "pnorm = %12.4Le" #define INFO_PNORM1 "(ivio=1) pnorm = %12.4Le" #define INFO_FNORM "fnorm(L2) = %20.8Le" #define INFO_LAM "min_lam = %11.4Le f1norm = %11.4Le pnorm = %11.4Le" #define INFO_ALPHA "fnorm = %15.8Le f1norm = %15.8Le alpha_cond = %15.8Le lam = %15.8Le" #define INFO_BETA "f1norm = %15.8Le beta_cond = %15.8Le lam = %15.8Le" #define INFO_ALPHABETA "f1norm = %15.8Le alpha_cond = %15.8Le beta_cond = %15.8Le lam = %15.8Le" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16lg" #define INFO_TOL "scsteptol = %12.3lg fnormtol = %12.3lg" #define INFO_FMAX "scaled f norm (for stopping) = %12.3lg" #define INFO_PNORM "pnorm = %12.4le" #define INFO_PNORM1 "(ivio=1) pnorm = %12.4le" #define INFO_FNORM "fnorm(L2) = %20.8le" #define INFO_LAM "min_lam = %11.4le f1norm = %11.4le pnorm = %11.4le" #define INFO_ALPHA "fnorm = %15.8le f1norm = %15.8le alpha_cond = %15.8le lam = %15.8le" #define INFO_BETA "f1norm = %15.8le beta_cond = %15.8le lam = %15.8le" #define INFO_ALPHABETA "f1norm = %15.8le alpha_cond = %15.8le beta_cond = %15.8le lam = %15.8le" #else #define INFO_NNI "nni = %4ld nfe = %6ld fnorm = %26.16g" #define INFO_TOL "scsteptol = %12.3g fnormtol = %12.3g" #define INFO_FMAX "scaled f norm (for stopping) = %12.3g" #define INFO_PNORM "pnorm = %12.4e" #define INFO_PNORM1 "(ivio=1) pnorm = %12.4e" #define INFO_FNORM "fnorm(L2) = %20.8e" #define INFO_LAM "min_lam = %11.4e f1norm = %11.4e pnorm = %11.4e" #define INFO_ALPHA "fnorm = %15.8e f1norm = %15.8e alpha_cond = %15.8e lam = %15.8e" #define INFO_BETA "f1norm = %15.8e beta_cond = %15.8e lam = %15.8e" #define INFO_ALPHABETA "f1norm = %15.8e alpha_cond = %15.8e beta_cond = %15.8e lam = %15.8e" #endif #ifdef __cplusplus } #endif #endif StanHeaders/src/kinsol/README0000644000176200001440000001047213766554457015453 0ustar liggesusers KINSOL Release 4.1.0, Feb 2019 Aaron Collier, Alan C. Hindmarsh, Radu Serban, and Carol S. Woodward Center for Applied Scientific Computing, LLNL KINSOL is a solver for nonlinear algebraic systems which can be described as F(u) = 0. It is written in the C language and based on the previous Fortran package NKSOL [4], written by Peter Brown and Youcef Saad. Nonlinear solver methods available include Newton-Krylov, Picard, and fixed point. Both Picard and fixed point can be accelerated with Anderson acceleration. KINSOL can be used both on serial and parallel computers. The difference is only in the NVECTOR module of vector functions. The desired version is obtained when compiling the example files by linking with the appropriate library of NVECTOR functions. In the parallel versions, communication between processes is done with MPI, with OpenMP, or with Pthreads. When used with the serial NVECTOR module, KINSOL provides both direct (dense and band) and preconditioned Krylov (iterative) linear solvers. Four different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), scaled preconditioned TFQMR (SPTFQMR), and scaled preconditioned Flexible GMRES (SPFGMR). When used with the parallel NVECTOR module, KINSOL provides a preconditioner module called KINBBDPRE, which provides a band-block-diagonal preconditioner for use with the Krylov linear solvers. However, within KINSOL any NVECTOR module may be combined with an appropriate user-supplied preconditioning module for acceleration of the Krylov solvers. KINSOL is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers. This suite consists of CVODE, CVODES, ARKode, KINSOL, IDA, and IDAS. The directory structure of the package supplied reflects this family relationship. For use with Fortran applications, a set of Fortran/C interface routines, called FKINSOL, is also supplied. These are written in C, but assume that the user calling program and all user-supplied routines are in Fortran. The notes below provide the location of documentation, directions for the installation of the KINSOL package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/kinsol/ contains PDF files for the KINSOL User Guide [1] (kin_guide.pdf) and the KINSOL Examples [2] (kin_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_GUIDE.pdf. For complete installation instructions see the "Installation Procedure" chapter in the KINSOL User Guide [1]. C. References ------------- [1] A. M. Collier, A. C. Hindmarsh, R. Serban, and C. S. Woodward, "User Documentation for KINSOL v2.9.0," LLNL technical report UCRL-SM-208116, March 2016. [2] A. M. Collier and R. Serban, "Example Programs for KINSOL v2.9.0," LLNL technical report UCRL-SM-208114, March 2016. [3] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. [4] Peter N. Brown and Youcef Saad, "Hybrid Krylov Methods for Nonlinear Systems of Equations," SIAM J. Sci. Stat. Comput., Vol 11, no 3, pp. 450-481, May 1990. [5] A. G. Taylor and A. C. Hindmarsh, "User Documentation for KINSOL, A Nonlinear Solver for Sequential and Parallel Computers," LLNL technical report UCRL-ID-131185, July 1998. D. Releases ----------- v. 4.1.0 - Feb. 2019 v. 4.0.2 - Jan. 2019 v. 4.0.1 - Dec. 2018 v. 4.0.0 - Dec. 2018 v. 3.2.1 - Oct. 2018 v. 3.2.0 - Sep. 2018 v. 3.1.2 - Jul. 2018 v. 3.1.1 - May 2018 v. 3.1.0 - Nov. 2017 v. 3.0.0 - Sep. 2017 v. 2.9.0 - Sep. 2016 v. 2.8.2 - Aug. 2015 v. 2.8.1 - Mar. 2015 v. 2.8.0 - Mar. 2015 v. 2.7.0 - Mar. 2012 v. 2.6.0 - May 2009 v. 2.5.0 - Nov. 2006 v. 2.4.0 - Mar. 2006 v. 2.3.0 - Apr. 2005 v. 2.2.2 - Mar. 2005 v. 2.2.1 - Jan. 2005 v. 2.2.0 - Dec. 2004 v. 2.0 - Jul. 2002 (first SUNDIALS release) v. 1.0 - Aug. 1998 (date written) StanHeaders/src/kinsol/CMakeLists.txt0000644000176200001440000001060413766554457017330 0ustar liggesusers# --------------------------------------------------------------- # Programmer(s): Daniel R. Reynolds @ SMU # Radu Serban @ LLNL # --------------------------------------------------------------- # SUNDIALS Copyright Start # Copyright (c) 2002-2019, Lawrence Livermore National Security # and Southern Methodist University. # All rights reserved. # # See the top-level LICENSE and NOTICE files for details. # # SPDX-License-Identifier: BSD-3-Clause # SUNDIALS Copyright End # --------------------------------------------------------------- # CMakeLists.txt file for the KINSOL library INSTALL(CODE "MESSAGE(\"\nInstall KINSOL\n\")") # Add variable kinsol_SOURCES with the sources for the KINSOL library SET(kinsol_SOURCES kinsol.c kinsol_bbdpre.c kinsol_direct.c kinsol_io.c kinsol_ls.c kinsol_spils.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the KINSOL library SET(shared_SOURCES ${sundials_SOURCE_DIR}/src/sundials/sundials_nvector.c ${sundials_SOURCE_DIR}/src/sundials/sundials_matrix.c ${sundials_SOURCE_DIR}/src/sundials/sundials_linearsolver.c ${sundials_SOURCE_DIR}/src/sundials/sundials_math.c ${sundials_SOURCE_DIR}/src/sundials/sundials_band.c ${sundials_SOURCE_DIR}/src/sundials/sundials_dense.c ${sundials_SOURCE_DIR}/src/sundials/sundials_direct.c ${sundials_SOURCE_DIR}/src/sundials/sundials_iterative.c ${sundials_SOURCE_DIR}/src/sundials/sundials_version.c ${sundials_SOURCE_DIR}/src/nvector/serial/nvector_serial.c ) # Add variable sunmatrix_SOURCES with the common SUNMatrix sources which will # also be included in the KINSOL library SET(sunmatrix_SOURCES ${sundials_SOURCE_DIR}/src/sunmatrix/band/sunmatrix_band.c ${sundials_SOURCE_DIR}/src/sunmatrix/dense/sunmatrix_dense.c ${sundials_SOURCE_DIR}/src/sunmatrix/sparse/sunmatrix_sparse.c ) # Add variable sunlinsol_SOURCES with the common SUNLinearSolver sources which will # also be included in the KINSOL library SET(sunlinsol_SOURCES ${sundials_SOURCE_DIR}/src/sunlinsol/band/sunlinsol_band.c ${sundials_SOURCE_DIR}/src/sunlinsol/dense/sunlinsol_dense.c ${sundials_SOURCE_DIR}/src/sunlinsol/spbcgs/sunlinsol_spbcgs.c ${sundials_SOURCE_DIR}/src/sunlinsol/spfgmr/sunlinsol_spfgmr.c ${sundials_SOURCE_DIR}/src/sunlinsol/spgmr/sunlinsol_spgmr.c ${sundials_SOURCE_DIR}/src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c ${sundials_SOURCE_DIR}/src/sunlinsol/pcg/sunlinsol_pcg.c ) # Add variable kinsol_HEADERS with the exported KINSOL header files SET(kinsol_HEADERS kinsol.h kinsol_bbdpre.h kinsol_direct.h kinsol_ls.h kinsol_spils.h ) # Add prefix with complete path to the KINSOL header files ADD_PREFIX(${sundials_SOURCE_DIR}/include/kinsol/ kinsol_HEADERS) # Add source directories to include directories for access to # implementation only header files. INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(../sundials) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Build the static library IF(BUILD_STATIC_LIBS) # Add the build target for the static KINSOL library ADD_LIBRARY(sundials_kinsol_static STATIC ${kinsol_SOURCES} ${shared_SOURCES} ${sunmatrix_SOURCES} ${sunlinsol_SOURCES}) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_kinsol_static PROPERTIES OUTPUT_NAME sundials_kinsol CLEAN_DIRECT_OUTPUT 1) # Install the KINSOL library INSTALL(TARGETS sundials_kinsol_static DESTINATION ${CMAKE_INSTALL_LIBDIR}) ENDIF(BUILD_STATIC_LIBS) # Build the shared library IF(BUILD_SHARED_LIBS) # Add the build target for the KINSOL library ADD_LIBRARY(sundials_kinsol_shared SHARED ${kinsol_SOURCES} ${shared_SOURCES} ${sunmatrix_SOURCES} ${sunlinsol_SOURCES}) IF(UNIX) TARGET_LINK_LIBRARIES(sundials_kinsol_shared m) ENDIF() # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_kinsol_shared PROPERTIES OUTPUT_NAME sundials_kinsol CLEAN_DIRECT_OUTPUT 1) # Set VERSION and SOVERSION for shared libraries SET_TARGET_PROPERTIES(sundials_kinsol_shared PROPERTIES VERSION ${kinsollib_VERSION} SOVERSION ${kinsollib_SOVERSION}) # Install the KINSOL library INSTALL(TARGETS sundials_kinsol_shared DESTINATION ${CMAKE_INSTALL_LIBDIR}) ENDIF(BUILD_SHARED_LIBS) # Install the KINSOL header files INSTALL(FILES ${kinsol_HEADERS} DESTINATION include/kinsol) # MESSAGE(STATUS "Added KINSOL module") StanHeaders/src/kinsol/LICENSE0000644000176200001440000000305013766554457015572 0ustar liggesusersBSD 3-Clause License Copyright (c) 2002-2019, Lawrence Livermore National Security and Southern Methodist University. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. StanHeaders/src/kinsol/kinsol_ls_impl.h0000644000176200001440000001526313766554457017765 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * David J. Gardner, Radu Serban and Aaron Collier @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation header file for KINSOL's linear solver interface. *-----------------------------------------------------------------*/ #ifndef _KINLS_IMPL_H #define _KINLS_IMPL_H #include #include "kinsol_impl.h" #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*------------------------------------------------------------------ keys for KINPrintInfo (do not use 1 -> conflict with PRNT_RETVAL) ------------------------------------------------------------------*/ #define PRNT_NLI 101 #define PRNT_EPS 102 /*------------------------------------------------------------------ Types : struct KINLsMemRec, struct *KINLsMem The type KINLsMem is a pointer to a KINLsMemRec, which is a structure containing fields that must be accessible by LS module routines. ------------------------------------------------------------------*/ typedef struct KINLsMemRec { /* Jacobian construction & storage */ booleantype jacDQ; /* SUNTRUE if using internal DQ Jacobian approx. */ KINLsJacFn jac; /* Jacobian routine to be called */ void *J_data; /* J_data is passed to jac */ /* Linear solver, matrix and vector objects/pointers */ SUNLinearSolver LS; /* generic iterative linear solver object */ SUNMatrix J; /* problem Jacobian */ /* Solver tolerance adjustment factor (if needed, see kinLsSolve) */ realtype tol_fac; /* Statistics and associated parameters */ long int nje; /* no. of calls to jac */ long int nfeDQ; /* no. of calls to F due to DQ Jacobian or J*v approximations */ long int npe; /* npe = total number of precond calls */ long int nli; /* nli = total number of linear iterations */ long int nps; /* nps = total number of psolve calls */ long int ncfl; /* ncfl = total number of convergence failures */ long int njtimes; /* njtimes = total number of calls to jtimes */ booleantype new_uu; /* flag indicating if the iterate has been updated - the Jacobian must be updated or reevaluated (meant to be used by a user-supplied jtimes function */ long int last_flag; /* last error return flag */ /* Preconditioner computation (a) user-provided: - pdata == user_data - pfree == NULL (the user dealocates memory) (b) internal preconditioner module - pdata == kin_mem - pfree == set by the prec. module and called in kinLsFree */ KINLsPrecSetupFn pset; KINLsPrecSolveFn psolve; int (*pfree)(KINMem kin_mem); void *pdata; /* Jacobian times vector compuation (a) jtimes function provided by the user: - jt_data == user_data - jtimesDQ == SUNFALSE (b) internal jtimes - jt_data == kin_mem - jtimesDQ == SUNTRUE */ booleantype jtimesDQ; KINLsJacTimesVecFn jtimes; void *jt_data; } *KINLsMem; /*------------------------------------------------------------------ Prototypes of internal functions ------------------------------------------------------------------*/ /* Interface routines called by system SUNLinearSolvers */ int kinLsATimes(void *kinmem, N_Vector v, N_Vector z); int kinLsPSetup(void *kinmem); int kinLsPSolve(void *kinmem, N_Vector r, N_Vector z, realtype tol, int lr); /* Difference quotient approximation for Jacobian times vector */ int kinLsDQJtimes(N_Vector v, N_Vector Jv, N_Vector u, booleantype *new_u, void *data); /* Difference-quotient Jacobian approximation routines */ int kinLsDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, void *data, N_Vector tmp1, N_Vector tmp2); int kinLsDenseDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, KINMem kin_mem, N_Vector tmp1, N_Vector tmp2); int kinLsBandDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, KINMem kin_mem, N_Vector tmp1, N_Vector tmp2); /* Generic linit/lsetup/lsolve/lfree interface routines for KINSOL to call */ int kinLsInitialize(KINMem kin_mem); int kinLsSetup(KINMem kin_mem); int kinLsSolve(KINMem kin_mem, N_Vector x, N_Vector b, realtype *sJpnorm, realtype *sFdotJp); int kinLsFree(KINMem kin_mem); /* Auxilliary functions */ int kinLsInitializeCounters(KINLsMem kinls_mem); int kinLs_AccessLMem(void* kinmem, const char *fname, KINMem* kin_mem, KINLsMem *kinls_mem); /*------------------------------------------------------------------ Error messages ------------------------------------------------------------------*/ #define MSG_LS_KINMEM_NULL "KINSOL memory is NULL." #define MSG_LS_MEM_FAIL "A memory request failed." #define MSG_LS_BAD_NVECTOR "A required vector operation is not implemented." #define MSG_LS_LMEM_NULL "Linear solver memory is NULL." #define MSG_LS_NEG_MAXRS "maxrs < 0 illegal." #define MSG_LS_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSG_LS_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #define MSG_LS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSG_LS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSG_LS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." #define MSG_LS_MATZERO_FAILED "The SUNMatZero routine failed in an unrecoverable manner." /*------------------------------------------------------------------ Info messages ------------------------------------------------------------------*/ #define INFO_NLI "nli_inc = %d" #if defined(SUNDIALS_EXTENDED_PRECISION) #define INFO_EPS "residual norm = %12.3Lg eps = %12.3Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define INFO_EPS "residual norm = %12.3lg eps = %12.3lg" #else #define INFO_EPS "residual norm = %12.3g eps = %12.3g" #endif #ifdef __cplusplus } #endif #endif StanHeaders/src/kinsol/kinsol_direct.c0000644000176200001440000000364313766554457017572 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation file for the deprecated direct linear solver interface in * KINSOL; these routines now just wrap the updated KINSOL generic * linear solver interface in kinsol_ls.h. *-----------------------------------------------------------------*/ #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Exported Functions (wrappers for equivalent routines in kinsol_ls.h) =================================================================*/ int KINDlsSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A) { return(KINSetLinearSolver(kinmem, LS, A)); } int KINDlsSetJacFn(void *kinmem, KINDlsJacFn jac) { return(KINSetJacFn(kinmem, jac)); } int KINDlsGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw) { return(KINGetLinWorkSpace(kinmem, lenrw, leniw)); } int KINDlsGetNumJacEvals(void *kinmem, long int *njevals) { return(KINGetNumJacEvals(kinmem, njevals)); } int KINDlsGetNumFuncEvals(void *kinmem, long int *nfevals) { return(KINGetNumLinFuncEvals(kinmem, nfevals)); } int KINDlsGetLastFlag(void *kinmem, long int *flag) { return(KINGetLastLinFlag(kinmem, flag)); } char *KINDlsGetReturnFlagName(long int flag) { return(KINGetLinReturnFlagName(flag)); } #ifdef __cplusplus } #endif StanHeaders/src/kinsol/kinsol_spils.c0000644000176200001440000000526513766554457017454 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Scott Cohen, Alan Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Header file for the deprecated Scaled Preconditioned Iterative * Linear Solver interface in KINSOL; these routines now just wrap * the updated KINSOL generic linear solver interface in kinsol_ls.h. *-----------------------------------------------------------------*/ #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Exported Functions (wrappers for equivalent routines in kinsol_ls.h) =================================================================*/ int KINSpilsSetLinearSolver(void *kinmem, SUNLinearSolver LS) { return(KINSetLinearSolver(kinmem, LS, NULL)); } int KINSpilsSetPreconditioner(void *kinmem, KINSpilsPrecSetupFn psetup, KINSpilsPrecSolveFn psolve) { return(KINSetPreconditioner(kinmem, psetup, psolve)); } int KINSpilsSetJacTimesVecFn(void *kinmem, KINSpilsJacTimesVecFn jtv) { return(KINSetJacTimesVecFn(kinmem, jtv)); } int KINSpilsGetWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS) { return(KINGetLinWorkSpace(kinmem, lenrwLS, leniwLS)); } int KINSpilsGetNumPrecEvals(void *kinmem, long int *npevals) { return(KINGetNumPrecEvals(kinmem, npevals)); } int KINSpilsGetNumPrecSolves(void *kinmem, long int *npsolves) { return(KINGetNumPrecSolves(kinmem, npsolves)); } int KINSpilsGetNumLinIters(void *kinmem, long int *nliters) { return(KINGetNumLinIters(kinmem, nliters)); } int KINSpilsGetNumConvFails(void *kinmem, long int *nlcfails) { return(KINGetNumLinConvFails(kinmem, nlcfails)); } int KINSpilsGetNumJtimesEvals(void *kinmem, long int *njvevals) { return(KINGetNumJtimesEvals(kinmem, njvevals)); } int KINSpilsGetNumFuncEvals(void *kinmem, long int *nfevals) { return(KINGetNumLinFuncEvals(kinmem, nfevals)); } int KINSpilsGetLastFlag(void *kinmem, long int *flag) { return(KINGetLastLinFlag(kinmem, flag)); } char *KINSpilsGetReturnFlagName(long int flag) { return(KINGetLinReturnFlagName(flag)); } #ifdef __cplusplus } #endif StanHeaders/src/kinsol/kinsol_bbdpre_impl.h0000644000176200001440000000517713766554457020610 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * KINBBDPRE module header file (private version) * -----------------------------------------------------------------*/ #ifndef _KINBBDPRE_IMPL_H #define _KINBBDPRE_IMPL_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*------------------------------------------------------------------ Definition of KBBDData ------------------------------------------------------------------*/ typedef struct KBBDPrecDataRec { /* passed by user to KINBBDPrecAlloc, used by pset/psolve functions */ sunindextype mudq, mldq, mukeep, mlkeep; realtype rel_uu; /* relative error for the Jacobian DQ routine */ KINBBDLocalFn gloc; KINBBDCommFn gcomm; /* set by KINBBDPrecSetup and used by KINBBDPrecSetup and KINBBDPrecSolve functions */ sunindextype n_local; SUNMatrix PP; SUNLinearSolver LS; N_Vector rlocal; N_Vector zlocal; N_Vector tempv1; N_Vector tempv2; N_Vector tempv3; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to KINSol memory */ void *kin_mem; } *KBBDPrecData; /* *----------------------------------------------------------------- * KINBBDPRE error messages *----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "KINSOL Memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." #define MSGBBD_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The gloc or gcomm routine failed in an unrecoverable manner." #ifdef __cplusplus } #endif #endif StanHeaders/src/kinsol/fcmix/0000755000176200001440000000000013766554135015666 5ustar liggesusersStanHeaders/src/kinsol/fcmix/fkinsol.h0000644000176200001440000010103213766554457017510 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * Daniel R. Reynolds @ SMU * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the FKINSOL Interface Package. * See below for usage details. * -----------------------------------------------------------------*/ /*************************************************************************** FKINSOL Interface Package The FKINSOL Interface Package is a package of C functions which support the use of the KINSOL solver for the solution of nonlinear systems f(u) = 0, in a mixed Fortran/C setting. While KINSOL is written in C, it is assumed here that the user's calling program and user-supplied problem-defining routines are written in Fortran. This package provides the necessary interface to KINSOL for the serial and parallel NVECTOR implementations. The user-callable functions, with the corresponding KINSOL functions, are as follows: FNVINITS, FNVINITP, FNVINITOMP, FNVINITPTS initialize serial, distributed memory parallel, or threaded vector computations FKINMALLOC interfaces to KINInit FKINCREATE interfaces to KINCreate FKININIT interfaces to KINInit FKINSETIIN, FKINSETRIN, FKINSETVIN interface to KINSet* functions FKINSOL interfaces to KINSol and KINGet* functions FKINFREE interfaces to KINFree FKINLSINIT interface to KINSetLinearSolver FKINDENSESETJAC interface to KINSetJacFn FKINBANDSETJAC interface to KINSetJacFn FKINSPARSESETJAC interface to KINSetJacFn FKINLSSETJAC interface to KINSetJacTimes FKINLSSETPREC interface to KINSetPreconditioner The user-supplied functions, each with the corresponding interface function which calls it (and its type within KINSOL), are as follows: FKFUN : called by the interface function FKINfunc of type KINSysFn FKDJAC : called by the interface function FKINDenseJac of type KINLsJacFn FKBJAC : called by the interface function FKINBandJac of type KINLsJacFn FKINSPJAC: called by the interface function FKINSparseJac of type KINLsJacFn FKJTIMES : called by the interface function FKINJtimes of type KINLsJacTimesVecFn FKPSOL : called by the interface function FKINPSol of type KINLsPrecSolveFn FKPSET : called by the interface function FKINPSet of type KINLsPrecSetupFn In contrast to the case of direct use of KINSOL, the names of all user-supplied routines here are fixed, in order to maximize portability for the resulting mixed-language program. Important note on portability: In this package, the names of the interface functions, and the names of the Fortran user routines called by them, appear as dummy names which are mapped to actual values by a series of definitions, in this and other header files. ========================================================================= Usage of the FKINSOL Interface Package The usage of FKINSOL requires calls to several interface functions, and to a few user-supplied routines which define the problem to be solved. These function calls and user routines are summarized separately below. Some details are omitted, and the user is referred to the KINSOL manual for more complete documentation. Information on the arguments of any given user-callable interface routine, or of a given user-supplied function called by an interface function, can be found in the documentation on the corresponding function in the KINSOL package. The number labels on the instructions below end with "s" for instructions that apply to the serial version of KINSOL only, and end with "p" for those that apply to the parallel version only. (1) User-supplied system routine: FKFUN The user must in all cases supply the following Fortran routine: SUBROUTINE FKFUN (UU, FVAL, IER) DIMENSION UU(*), FVAL(*) It must set the FVAL array to f(u), the system function, as a function of the array UU = u. Here UU and FVAL are arrays representing vectors, which are distributed vectors in the parallel case. IER is a return flag, which should be 0 if FKFUN was successful. Return IER > 0 if a recoverable error occurred (and KINSOL is to try to recover). Return IER < 0 if an unrecoverable error occurred. (2s) Optional user-supplied dense Jacobian approximation routine: FKDJAC As an option when using the DENSE linear solver, the user may supply a routine that computes a dense approximation of the system Jacobian J = df/dy. If supplied, it must have the following form: SUBROUTINE FKDJAC(N, UU, FU, DJAC, WK1, WK2, IER) DIMENSION UU(*), FU(*), DJAC(N,*), WK1(*), WK2(*) This routine must compute the Jacobian and store it columnwise in DJAC. FKDJAC should return IER = 0 if successful, or a nonzero IER otherwise. (3s) Optional user-supplied band Jacobian approximation routine: FKBJAC As an option when using the BAND linear solver, the user may supply a routine that computes a band approximation of the system Jacobian J = df/dy. If supplied, it must have the following form: SUBROUTINE FKBJAC(N, MU, ML, MDIM, UU, FU, BJAC, WK1, WK2, IER) DIMENSION UU(*), FU(*), BJAC(MDIM,*), WK1(*), WK2(*) This routine must load the MDIM by N array BJAC with the Jacobian matrix. FKBJAC should return IER = 0 if successful, or a nonzero IER otherwise. (4) Optional user-supplied Jacobian-vector product routine: FKJTIMES As an option, the user may supply a routine that computes the product of the system Jacobian and a given vector. This has the following form: SUBROUTINE FKJTIMES(V, Z, NEWU, UU, IER) DIMENSION V(*), Z(*), UU(*) This must set the array Z to the product J*V, where J is the Jacobian matrix J = dF/du, and V is a given array. Here UU is an array containing the current value of the unknown vector u. NEWU is an input integer indicating whether UU has changed since FKJTIMES was last called (1 = yes, 0 = no). If FKJTIMES computes and saves Jacobian data, then no such computation is necessary when NEWU = 0. Here V, Z, and UU are arrays of length NEQ, the problem size, or the local length of all distributed vectors in the parallel case. FKJTIMES should return IER = 0 if successful, or a nonzero IER otherwise. (4.1s) User-supplied sparse Jacobian approximation routine: FKINSPJAC Required when using the KINKLU or KINSuperLUMT linear solvers, the user must supply a routine that computes a compressed-sparse-column [or compressed-sparse-row] approximation of the system Jacobian J = dF(y)/dy. If supplied, it must have the following form: SUBROUTINE FKINSPJAC(Y, FY, N, NNZ, JDATA, JRVALS, & JCPTRS, WK1, WK2, IER) Typically this routine will use only N, NNZ, JDATA, JRVALS and JCPTRS. It must load the N by N compressed sparse column [or compressed sparse row] matrix with storage for NNZ nonzeros, stored in the arrays JDATA (nonzero values), JRVALS (row [or column] indices for each nonzero), JCOLPTRS (indices for start of each column [or row]), with the Jacobian matrix at the current (y) in CSC [or CSR] form (see sundials_sparse.h for more information). The arguments are: Y -- array containing state variables [realtype, input] FY -- array containing residual values [realtype, input] N -- number of matrix rows/columns in Jacobian [int, input] NNZ -- allocated length of nonzero storage [int, input] JDATA -- nonzero values in Jacobian [realtype of length NNZ, output] JRVALS -- row [or column] indices for each nonzero in Jacobian [int of length NNZ, output] JCPTRS -- pointers to each Jacobian column [or row] in preceding arrays [int of length N+1, output] WK* -- array containing temporary workspace of same size as Y [realtype, input] IER -- return flag [int, output]: 0 if successful, >0 if a recoverable error occurred, <0 if an unrecoverable error ocurred. (5) Initialization: FNVINITS/FNVINITP/FNVINITOMP/FNVINITPTS and FKINCREATE and FKININIT (5.1s) To initialize the serial machine environment, the user must make the following call: CALL FNVINITS (3, NEQ, IER) The arguments are: NEQ = size of vectors IER = return completion flag. Values are 0 = success, -1 = failure. (5.1p) To initialize the distributed memory parallel machine environment, the user must make the following call: CALL FNVINITP (3, NLOCAL, NGLOBAL, IER) The arguments are: NLOCAL = local size of vectors for this process NGLOBAL = the system size, and the global size of vectors (the sum of all values of NLOCAL) IER = return completion flag. Values are 0 = success, -1 = failure. (5.1omp) To initialize the openMP threaded vector kernel, the user must make the following call: CALL FNVINITOMP (3, NEQ, NUM_THREADS, IER) The arguments are: NEQ = size of vectors NUM_THREADS = number of threads IER = return completion flag. Values are 0 = success, -1 = failure. (5.1pts) To initialize the Pthreads threaded vector kernel, the user must make the following call: CALL FNVINITOMP (3, NEQ, NUM_THREADS, IER) The arguments are: NEQ = size of vectors NUM_THREADS = number of threads IER = return completion flag. Values are 0 = success, -1 = failure. (5.2) To create the internal memory structure, make the following call: CALL FKINCREATE(IER) The arguments are: IER = return completion flag. Values are 0 = success, and -1 = failure. Note: See printed message for details in case of failure. (5.3) To set various integer optional inputs, make the folowing call: CALL FKINSETIIN(KEY, VALUE, IER) to set the optional input specified by the character key KEY to the integer value VALUE. KEY is one of the following: 'PRNT_LEVEL', 'MAX_NITERS', 'ETA_FORM', 'MAA', 'MAX_SETUPS', 'MAX_SP_SETUPS', 'NO_INIT_SETUP', 'NO_MIN_EPS', 'NO_RES_MON'. To set various real optional inputs, make the folowing call: CALL FKINSETRIN(KEY, VALUE, IER) to set the optional input specified by the character key KEY to the real value VALUE. KEY is one of the following: 'FNORM_TOL', 'SSTEP_TOL', 'MAX_STEP', 'RERR_FUNC', 'ETA_CONST', 'ETA_PARAMS', 'RMON_CONST', 'RMON_PARAMS'. Note that if KEY is 'ETA_PARAMS' or 'RMON_PARAMS', then VALUE must be an array of dimension 2. To set the vector of constraints on the solution, make the following call: CALL FKINSETVIN(KEY, ARRAY, IER) where ARRAY is an array of reals and KEY is 'CONSTR_VEC'. FKINSETIIN, FKINSETRIN, and FKINSETVIN return IER=0 if successful and IER<0 if an error occured. (5.4) To allocate and initialize the internal memory structure, make the following call: CALL FKININIT(IOUT, ROUT, IER) The arguments are: IOUT = array of length at least 16 for integer optional outputs (declare as INTEGER*8) ROUT = array of length at least 2 for real optional outputs IER = return completion flag. Values are 0 = success, and -1 = failure. Note: See printed message for details in case of failure. (6) Specification of linear system solution method: The solution method in KINSOL involves the solution of linear systems related to the Jacobian J = dF/du of the nonlinear system. (6.1s) DENSE treatment of the linear systems (NVECTOR_SERIAL only): To initialize a dense matrix structure for storing the system Jacobian and for use within a direct linear solver, the user must call: CALL FSUNDENSEMATINIT(3, M, N, IER) The integer 3 is the KINSOL solver ID and the other arguments are: M = the number of rows of the matrix [long int, input] N = the number of columns of the matrix [long int, input] IER = return completion flag [int, output]: 0 = success, -1 = failure. To initialize a dense linear solver structure the user must call the following to use the SUNDIALS or LAPACK dense solvers: CALL FSUNDENSELINSOLINIT(3, IER) OR CALL FSUNLAPACKDENSEINIT(3, IER) In the above routines, 3 is the KINSOL solver ID and IER is the return return completion flag (0 = success and -1 = failure). To attach the dense linear solver structure the user must call the following: CALL FKINLSINIT(IER) The arguments are: IER = return completion flag [int, output]: 0 = SUCCESS, -1 = failure (see printed message for failure details). If the user program includes the FKDJAC routine for the evaluation of the dense approximation to the system Jacobian, the following call must be made: CALL FKINDENSESETJAC(FLAG, IER) with FLAG = 1 to specify that FKDJAC is provided. (FLAG = 0 specifies using the internal finite difference approximation to the Jacobian.) (6.2s) BAND treatment of the linear systems (NVECTOR_SERIAL only): To initialize a banded matrix structure for stroing the system Jacobian and for use within a banded linear solver, the user must call: CALL FSUNBANDMATINIT(3, N, MU, ML, SMU, IER) The integer 3 is the KINSOL solver ID and the other arguments are: N = the number of columns of the matrix [long int, input] MU = the number of upper bands (diagonal not included) in a banded matrix [long int, input] ML = the number of lower bands (diagonal not included) in a banded matrix [long int, input] SMU = the number of upper bands to store (diagonal not included) for factorization of a banded matrix [long int, input] To initialize a banded linear solver structure the user must call the following to use the SUNDIALS or LAPACK banded solvers: CALL FSUNBANDLINSOLINIT(3, IER) OR CALL FSUNLAPACKBANDINIT(3, IER) In the above routines, 3 is the KINSOL solver ID and IER is the return return completion flag (0 = success and -1 = failure). To attach the banded linear solver structure the user must call the following: CALL FKINLSINIT(IER) The arguments are: IER = return completion flag [int, output]: 0 = SUCCESS, -1 = failure (see printed message for failure details). If the user program includes the FKBJAC routine for the evaluation of the band approximation to the system Jacobian, the following call must be made: CALL FKINBANDSETJAC(FLAG, IER) with FLAG = 1 to specify that FKBJAC is provided. (FLAG = 0 specifies using the internal finite difference approximation to the Jacobian.) (6.3s) SPARSE treatment of the linear system using the KLU or SuperLU_MT solver. To initialize a sparse matrix structure for stroing the system Jacobian and for use within a sparse linear solver, the user must call: CALL FSUNSPARSEMATINIT(3, M, N, NNZ, SPARSETYPE, IER) The integer 3 is the KINSOL solver ID and the other arguments are: M = the number of rows of the matrix [long int, input] N = the number of columns of the matrix [long int, input] NNZ = the storage size (upper bound on the number of nonzeros) for a sparse matrix [long int, input] SPARSETYPE = integer denoting use of CSC (0) vs CSR (1) storage for a sparse matrix [int, input] IER = return completion flag [int, output]: 0 = success, -1 = failure. To initialize a sparse linear solver structure the user must call the following to use the KLU or SuperLU_MT sparse solvers: CALL FSUNKLUINIT(3, IER) OR CALL FSUNSUPERLUMTINIT(3, NUM_THREADS, IER) In the above routines, 3 is the KINSOL solver ID, NUM_THREADS is the number of threads, and IER is the return completion flag (0 = success and -1 = failure). To attach the sparse linear solver structure the user must call the following: CALL FKINLSINIT(IER) The arguments are: IER = return completion flag [int, output]: 0 = SUCCESS, -1 = failure (see printed message for failure details). When using a sparse solver the user must provide the FKINSPJAC routine for the evalution of the sparse approximation to the Jacobian. To indicate that this routine has been provided, after the call to FKINKLU, the following call must be made CALL FKINSPARSESETJAC(IER) The int return flag IER=0 if successful, and nonzero otherwise. The KLU solver will reuse much of the factorization information from one nonlinear iteration to the next. If at any time the user wants to force a full refactorization or if the number of nonzeros in the Jacobian matrix changes, the user should make the call: CALL FKINKLUREINIT(NEQ, NNZ, REINIT_TYPE) The arguments are: NEQ = the problem size [int; input] NNZ = the maximum number of nonzeros [int; input] REINIT_TYPE = 1 or 2. For a value of 1, the matrix will be destroyed and a new one will be allocated with NNZ nonzeros. For a value of 2, only symbolic and numeric factorizations will be completed. At this time, there is no reinitialization capability for the SUNDIALS interface to the SuperLUMT solver. Once these the solvers have been initialized, their solver parameters may be modified via calls to the functions: CALL FSUNKLUSETORDERING(3, ORD_CHOICE, IER) CALL FSUNSUPERLUMTSETORDERING(3, ORD_CHOICE, IER) In the above routines, 3 is the KINSOL solver ID and ORD_CHOICE is an integer denoting ordering choice (see SUNKLUSetOrdering and SUNSuperLUMTSetOrdering documentation for details), and IER is the return completion flag (0 = success and -1 = failure). (6.4) Scaled Preconditioned Iterative linear Solvers (SPILS): To initialize a SPILS treatment of the linear system, the user must call one of the following: CALL FSUNPCGINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPBCGSINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPFGMRINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPGMRINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPTFQMRINIT(3, PRETYPE, MAXL, IER) The integer 3 is the KINSOL solver ID and the other arguments are: PRETYPE = type of preconditioning to perform (0=none, 1=left, 2=right, 3=both) [int, input] MAXL = maximum Krylov subspace dimension [int, input] IER = return completion flag [int, output]: 0 = success, -1 = failure. To attach the iterative linear solver structure the user must call the following: CALL FKINLSINIT(IER) The arguments are: IER = return completion flag [int, output]: 0 = SUCCESS, -1 = failure (see printed message for failure details). Once these the solvers have been initialized, their solver parameters may be modified via calls to the functions: CALL FSUNPCGSETPRECTYPE(3, PRETYPE, IER) CALL FSUNPCGSETMAXL(3, MAXL, IER) CALL FSUNSPBCGSSETPRECTYPE(3, PRETYPE, IER) CALL FSUNSPBCGSSETMAXL(3, MAXL, IER) CALL FSUNSPFGMRSETGSTYPE(3, GSTYPE, IER) CALL FSUNSPFGMRSETPRECTYPE(3, PRETYPE, IER) CALL FSUNSPGMRSETGSTYPE(3, GSTYPE, IER) CALL FSUNSPGMRSETPRECTYPE(3, PRETYPE, IER) CALL FSUNSPTFQMRSETPRECTYPE(3, PRETYPE, IER) CALL FSUNSPTFQMRSETMAXL(3, MAXL, IER) The integer 3 is the KINSOL solver ID and the other arguments are: PRETYPE = type of preconditioning to perform (0=none, 1=left, 2=right, 3=both) [int, input] GSTYPE = choice of Gram-Schmidt orthogonalization algorithm (0=modified, 1=classical) [int, input] IER = return completion flag [int, output]: 0 = success, -1 = failure. (6.5) Specifying user-provided functions for the iterative linear solvers (SPILS) If the user program includes the FKJTIMES routine for the evaluation of the Jacobian-vector product, the following call must be made: CALL FKINLSSETJAC(FLAG, IER) The argument FLAG = 0 specifies using the internal finite differences approximation to the Jacobian-vector product, while FLAG = 1 specifies that FKJTIMES is provided. Usage of the user-supplied routines FKPSET and FKPSOL for the setup and solution of the preconditioned linear system is specified by calling: CALL FKINLSSETPREC(FLAG, IER) where FLAG = 0 indicates no FKPSET or FKPSOL (default) and FLAG = 1 specifies using FKPSET and FKPSOL. The user-supplied routines FKPSET and FKPSOL must be of the form: SUBROUTINE FKPSET (UU, USCALE, FVAL, FSCALE, IER) DIMENSION UU(*), USCALE(*), FVAL(*), FSCALE(*) It must perform any evaluation of Jacobian-related data and preprocessing needed for the solution of the preconditioned linear systems by FKPSOL. The variables UU through FSCALE are for use in the preconditioning setup process. Typically, the system function FKFUN is called, so that FVAL will have been updated. UU is the current solution iterate. If scaling is being used, USCALE and FSCALE are available for those operatins requiring scaling. On return, set IER = 0 if FKPSET was successful, set IER = 1 if an error occurred. SUBROUTINE FKPSOL (UU, USCALE, FVAL, FSCALE, VTEM, IER) DIMENSION UU(*), USCALE(*), FVAL(*), FSCALE(*), VTEM(*) Typically this routine will use only UU, FVAL, and VTEM. It must solve the preconditioned linear system Pz = r, where r = VTEM is input, and store the solution z in VTEM as well. Here P is the right preconditioner. If scaling is being used, the routine supplied must also account for scaling on either coordinate or function value. (7) The solver: FKINSOL Solving the nonlinear system is accomplished by making the following call: CALL FKINSOL (UU, GLOBALSTRAT, USCALE, FSCALE, IER) The arguments are: UU = array containing the initial guess on input, and the solution on return GLOBALSTRAT = (INTEGER) a number defining the global strategy choice: 0 = No globalization, 1 = LineSearch, 2 = Picard, 3 = Fixed Point USCALE = array of scaling factors for the UU vector FSCALE = array of scaling factors for the FVAL (function) vector IER = INTEGER error flag as returned by KINSOL: 0 means success, 1 means initial guess satisfies f(u) = 0 (approx.), 2 means apparent stalling (small step), a value < 0 means other error or failure. Note: See KINSOL documentation for detailed information. (8) Memory freeing: FKINFREE To the free the internal memory created by the calls to FKINCREATE and FKININIT and any FNVINIT**, make the following call: CALL FKINFREE (9) Optional outputs: IOUT/ROUT The optional outputs available by way of IOUT and ROUT have the following names, locations, and descriptions. For further details see the KINSOL documentation. LENRW = IOUT(1) = real workspace size LENRW = IOUT(2) = real workspace size NNI = IOUT(3) = number of Newton iterations NFE = IOUT(4) = number of f evaluations NBCF = IOUT(5) = number of line search beta condition failures NBKTRK = IOUT(6) = number of line search backtracks FNORM = ROUT(1) = final scaled norm of f(u) STEPL = ROUT(2) = scaled last step length The following optional outputs arise from the KINLS module: LRW = IOUT( 7) = real workspace size for the linear solver module LIW = IOUT( 8) = integer workspace size for the linear solver module LSTF = IOUT( 9) = last flag returned by linear solver NFE = IOUT(10) = number of f evaluations for DQ Jacobian or Jacobian*vector approximation NJE = IOUT(11) = number of Jacobian evaluations NJT = IOUT(12) = number of Jacobian-vector product evaluations NPE = IOUT(13) = number of preconditioner evaluations NPS = IOUT(14) = number of preconditioner solves NLI = IOUT(15) = number of linear (Krylov) iterations NCFL = IOUT(16) = number of linear convergence failures *******************************************************************************/ #ifndef _FKINSOL_H #define _FKINSOL_H /*------------------------------------------------------------------ header files ------------------------------------------------------------------*/ #include #include /* definition of SUNLinearSolver */ #include /* definition of SUNMatrix */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*------------------------------------------------------------------ generic names are translated through the define statements below ------------------------------------------------------------------*/ #if defined(SUNDIALS_F77_FUNC) #define FKIN_MALLOC SUNDIALS_F77_FUNC(fkinmalloc, FKINMALLOC) #define FKIN_CREATE SUNDIALS_F77_FUNC(fkincreate, FKINCREATE) #define FKIN_INIT SUNDIALS_F77_FUNC(fkininit, FKININIT) #define FKIN_SETIIN SUNDIALS_F77_FUNC(fkinsetiin, FKINSETIIN) #define FKIN_SETRIN SUNDIALS_F77_FUNC(fkinsetrin, FKINSETRIN) #define FKIN_SETVIN SUNDIALS_F77_FUNC(fkinsetvin, FKINSETVIN) #define FKIN_SOL SUNDIALS_F77_FUNC(fkinsol, FKINSOL) #define FKIN_FREE SUNDIALS_F77_FUNC(fkinfree, FKINFREE) #define FKIN_LSINIT SUNDIALS_F77_FUNC(fkinlsinit, FKINLSINIT) #define FKIN_LSSETJAC SUNDIALS_F77_FUNC(fkinlssetjac, FKINLSSETJAC) #define FKIN_LSSETPREC SUNDIALS_F77_FUNC(fkinlssetprec, FKINLSSETPREC) #define FK_PSET SUNDIALS_F77_FUNC(fkpset, FKPSET) #define FK_PSOL SUNDIALS_F77_FUNC(fkpsol, FKPSOL) #define FKIN_DENSESETJAC SUNDIALS_F77_FUNC(fkindensesetjac, FKINDENSESETJAC) #define FK_DJAC SUNDIALS_F77_FUNC(fkdjac, FKDJAC) #define FKIN_BANDSETJAC SUNDIALS_F77_FUNC(fkinbandsetjac, FKINBANDSETJAC) #define FK_BJAC SUNDIALS_F77_FUNC(fkbjac, FKBJAC) #define FKIN_SPARSESETJAC SUNDIALS_F77_FUNC(fkinsparsesetjac, FKINSPARSESETJAC) #define FKIN_SPJAC SUNDIALS_F77_FUNC(fkinspjac, FKINSPJAC) #define FK_JTIMES SUNDIALS_F77_FUNC(fkjtimes, FKJTIMES) #define FK_FUN SUNDIALS_F77_FUNC(fkfun, FKFUN) /*---DEPRECATED---*/ #define FKIN_DLSINIT SUNDIALS_F77_FUNC(fkindlsinit, FKINDLSINIT) #define FKIN_SPILSINIT SUNDIALS_F77_FUNC(fkinspilsinit, FKINSPILSINIT) #define FKIN_SPILSSETJAC SUNDIALS_F77_FUNC(fkinspilssetjac, FKINSPILSSETJAC) #define FKIN_SPILSSETPREC SUNDIALS_F77_FUNC(fkinspilssetprec, FKINSPILSSETPREC) /*----------------*/ #else #define FKIN_MALLOC fkinmalloc_ #define FKIN_CREATE fkincreate_ #define FKIN_INIT fkininit_ #define FKIN_SETIIN fkinsetiin_ #define FKIN_SETRIN fkinsetrin_ #define FKIN_SETVIN fkinsetvin_ #define FKIN_SOL fkinsol_ #define FKIN_FREE fkinfree_ #define FKIN_LSINIT fkinlsinit_ #define FKIN_LSSETJAC fkinlssetjac_ #define FK_JTIMES fkjtimes_ #define FKIN_LSSETPREC fkinlssetprec_ #define FKIN_DENSESETJAC fkindensesetjac_ #define FK_DJAC fkdjac_ #define FKIN_BANDSETJAC fkinbandsetjac_ #define FK_BJAC fkbjac_ #define FKIN_SPARSESETJAC fkinsparsesetjac_ #define FKIN_SPJAC fkinspjac_ #define FK_PSET fkpset_ #define FK_PSOL fkpsol_ #define FK_FUN fkfun_ /*---DEPRECATED---*/ #define FKIN_DLSINIT fkindlsinit_ #define FKIN_SPILSINIT fkinspilsinit_ #define FKIN_SPILSSETJAC fkinspilssetjac_ #define FKIN_SPILSSETPREC fkinspilssetprec_ /*----------------*/ #endif /*------------------------------------------------------------------ Prototypes : exported functions ------------------------------------------------------------------*/ void FKIN_MALLOC(long int *iout, realtype *rout, int *ier); void FKIN_CREATE(int *ier); void FKIN_INIT(long int *iout, realtype *rout, int *ier); void FKIN_SETIIN(char key_name[], long int *ival, int *ier); void FKIN_SETRIN(char key_name[], realtype *rval, int *ier); void FKIN_SETVIN(char key_name[], realtype *vval, int *ier); void FKIN_LSINIT(int *ier); void FKIN_LSSETJAC(int *flag, int *ier); void FKIN_LSSETPREC(int *flag, int *ier); void FKIN_DENSESETJAC(int *flag, int *ier); void FKIN_BANDSETJAC(int *flag, int *ier); void FKIN_SPARSESETJAC(int *ier); /*---DEPRECATED---*/ void FKIN_DLSINIT(int *ier); void FKIN_SPILSINIT(int *ier); void FKIN_SPILSSETJAC(int *flag, int *ier); void FKIN_SPILSSETPREC(int *flag, int *ier); /*----------------*/ void FKIN_SOL(realtype *uu, int *globalstrategy, realtype *uscale , realtype *fscale, int *ier); void FKIN_FREE(void); /*------------------------------------------------------------------ Prototypes : functions called by the solver ------------------------------------------------------------------*/ int FKINfunc(N_Vector uu, N_Vector fval, void *user_data); int FKINDenseJac(N_Vector uu, N_Vector fval, SUNMatrix J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINBandJac(N_Vector uu, N_Vector fval, SUNMatrix J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINSparseJac(N_Vector uu, N_Vector fval, SUNMatrix J, void *user_data, N_Vector vtemp1, N_Vector vtemp2); int FKINJtimes(N_Vector v, N_Vector Jv, N_Vector uu, booleantype *new_uu, void *user_data); int FKINPSet(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *user_data); int FKINPSol(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data); void FKINNullMatrix(); void FKINNullLinsol(); /*------------------------------------------------------------------ declarations for global variables shared amongst various routines ------------------------------------------------------------------*/ extern N_Vector F2C_KINSOL_vec; /* defined in FNVECTOR module */ extern SUNMatrix F2C_KINSOL_matrix; /* defined in FSUNMATRIX module */ extern SUNLinearSolver F2C_KINSOL_linsol; /* defined in FSUNLINSOL module */ extern void *KIN_kinmem; /* defined in fkinsol.c */ extern long int *KIN_iout; /* defined in fkinsol.c */ extern realtype *KIN_rout; /* defined in fkinsol.c */ #ifdef __cplusplus } #endif #endif StanHeaders/src/kinsol/fcmix/fkinnulllinsol.c0000644000176200001440000000253013766554457021104 0ustar liggesusers/*--------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *--------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *--------------------------------------------------------------- * File that provides a globally-defined, but NULL-valued, * SUNLinearSolver object, to ensure that F2C_KINSOL_linsol is * defined for cases when no linear solver object is linked in * with the main executable. *--------------------------------------------------------------*/ #include #include #include "fkinsol.h" #include "kinsol_impl.h" /*=============================================================*/ /* Define global linear solver variable */ SUNLinearSolver F2C_KINSOL_linsol; /*=============================================================*/ /* C routine that is called when using fixed-point solver */ void FKINNullLinsol() { F2C_KINSOL_linsol = NULL; } /*=============================================================== EOF ===============================================================*/ StanHeaders/src/kinsol/fcmix/CMakeLists.txt0000644000176200001440000000643713766554457020447 0ustar liggesusers# --------------------------------------------------------------- # Programmer: Daniel R. Reynolds @ SMU # --------------------------------------------------------------- # SUNDIALS Copyright Start # Copyright (c) 2002-2019, Lawrence Livermore National Security # and Southern Methodist University. # All rights reserved. # # See the top-level LICENSE and NOTICE files for details. # # SPDX-License-Identifier: BSD-3-Clause # SUNDIALS Copyright End # --------------------------------------------------------------- # CMakeLists.txt file for the FKINSOL library # Add variable fcvode_SOURCES with the sources for the FCVODE library SET(fkinsol_SOURCES fkinband.c fkinbbd.c fkindense.c fkinjtimes.c fkinnullmatrix.c fkinnulllinsol.c fkinpreco.c fkinsol.c fkinsparse.c ) # Add variable shared_SOURCES with the common SUNDIALS sources which will # also be included in the ARKODE library SET(shared_SOURCES ${sundials_SOURCE_DIR}/src/nvector/serial/fnvector_serial.c ) # Add variable sunmatrix_SOURCES with the common SUNMatrix sources which will # also be included in the ARKODE library SET(sunmatrix_SOURCES ${sundials_SOURCE_DIR}/src/sunmatrix/band/fsunmatrix_band.c ${sundials_SOURCE_DIR}/src/sunmatrix/dense/fsunmatrix_dense.c ${sundials_SOURCE_DIR}/src/sunmatrix/sparse/fsunmatrix_sparse.c ) # Add variable sunlinsol_SOURCES with the common SUNLinearSolver sources which will # also be included in the ARKODE library SET(sunlinsol_SOURCES ${sundials_SOURCE_DIR}/src/sunlinsol/band/fsunlinsol_band.c ${sundials_SOURCE_DIR}/src/sunlinsol/dense/fsunlinsol_dense.c ${sundials_SOURCE_DIR}/src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c ${sundials_SOURCE_DIR}/src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c ${sundials_SOURCE_DIR}/src/sunlinsol/spgmr/fsunlinsol_spgmr.c ${sundials_SOURCE_DIR}/src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c ${sundials_SOURCE_DIR}/src/sunlinsol/pcg/fsunlinsol_pcg.c ) IF(KLU_FOUND) LIST(APPEND sunlinsol_SOURCES ${sundials_SOURCE_DIR}/src/sunlinsol/klu/fsunlinsol_klu.c ) ENDIF() IF(SUPERLUMT_FOUND) LIST(APPEND sunlinsol_SOURCES ${sundials_SOURCE_DIR}/src/sunlinsol/superlumt/fsunlinsol_superlumt.c ) ENDIF() IF(LAPACK_FOUND) LIST(APPEND sunlinsol_SOURCES ${sundials_SOURCE_DIR}/src/sunlinsol/lapackband/fsunlinsol_lapackband.c ${sundials_SOURCE_DIR}/src/sunlinsol/lapackdense/fsunlinsol_lapackdense.c ) ENDIF() # Add source directories to include directories for access to # implementation only header files (both for fkinsol and kinsol) INCLUDE_DIRECTORIES(.) INCLUDE_DIRECTORIES(..) # Define C preprocessor flag -DBUILD_SUNDIALS_LIBRARY ADD_DEFINITIONS(-DBUILD_SUNDIALS_LIBRARY) # Only build STATIC libraries (we cannot build shared libraries # for the FCMIX interfaces due to unresolved symbol errors # coming from inexistent user-provided functions) # Add the build target for the FKINSOL library ADD_LIBRARY(sundials_fkinsol_static STATIC ${fkinsol_SOURCES} ${shared_SOURCES} ${sunmatrix_SOURCES} ${sunlinsol_SOURCES} ) # Set the library name and make sure it is not deleted SET_TARGET_PROPERTIES(sundials_fkinsol_static PROPERTIES OUTPUT_NAME sundials_fkinsol CLEAN_DIRECT_OUTPUT 1) # Install the FKINSOL library INSTALL(TARGETS sundials_fkinsol_static DESTINATION ${CMAKE_INSTALL_LIBDIR}) # MESSAGE(STATUS "Added KINSOL FCMIX module") StanHeaders/src/kinsol/fcmix/fkinbbd.h0000644000176200001440000003310313766554457017445 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the Fortran interface include file for the BBD * preconditioner module KINBBDPRE. * -----------------------------------------------------------------*/ /******************************************************************************* FKINBBD Interface Package The FKINBBD Interface Package is a package of C functions which support the use of the KINSOL solver and MPI-parallel N_Vector module, along with the KINBBDPRE preconditioner module, for the solution of nonlinear systems in a mixed Fortran/C setting. The combination of KINSOL and KINBBDPRE solves systems linear system arising from the solution of f(u) = 0 using a Krylov iterative linear solver via the KINSPILS interface, and with a preconditioner that is block-diagonal with banded blocks. While KINSOL and KINBBDPRE are written in C, it is assumed here that the user's calling program and user-supplied problem-defining routines are written in Fortran. The user-callable functions in this package, with the corresponding KINSOL and KINBBDPRE functions, are as follows: FKINBBDINIT : interfaces to KINBBDPrecInit FKINBBDOPT : accesses optional outputs FKINBBDFREE : interfaces to KINBBDPrecFree In addition to the Fortran system function FKFUN, and optional Jacobian vector product routine FKJTIMES, the following are the user-supplied functions required by this package, each with the corresponding interface function which calls it (and its type within KINBBDPRE): FKLOCFN : called by the interface function FKINgloc of type KINBBDLocalFn FKCOMMFN : called by the interface function FKINgcomm of type KINBBDCommFn Note: The names of all user-supplied routines here are fixed, in order to maximize portability for the resulting mixed-language program. Note: The names used within this interface package make use of the preprocessor to expand them appropriately for different machines/platforms. Later in this file, each name is expanded appropriately. For example, FKIN_BBDINIT is replaced with either fkinbbdinit, fkinbbdinit_, or fkinbbdinit__ depending upon the platform. ============================================================================== Usage of the FKINSOL/FKINBBD Interface Packages The usage of combined interface packages FKINSOL and FKINBBD requires calls to several interface functions, and a few user-supplied routines which define the problem to be solved and indirectly define the preconditioner. These function calls and user routines are summarized separately below. Some details have been omitted, and the user is referred to the KINSOL User Guide for more complete information. (1) User-supplied system function routine: FKFUN The user must in all cases supply the following Fortran routine: SUBROUTINE FKFUN (UU, FVAL, IER) DIMENSION UU(*), FVAL(*) It must set the FVAL array to f(u), the system function, as a function of the array UU = u. Here UU and FVAL are vectors (distributed in the parallel case). IER is a return flag (currently not used). (2) Optional user-supplied Jacobian-vector product routine: FKJTIMES As an option, the user may supply a routine that computes the product of the system Jacobian and a given vector. The user-supplied function must have the following form: SUBROUTINE FKJTIMES (V, Z, NEWU, UU, IER) DIMENSION V(*), Z(*), UU(*) This must set the array Z to the product J*V, where J is the Jacobian matrix J = dF/du, and V is a given array. Here UU is an array containing the current value of the unknown vector u, and NEWU is an input integer indicating whether UU has changed since FKJTIMES was last called (1 = yes, 0 = no). If FKJTIMES computes and saves Jacobian data, then no such computation is necessary when NEWU = 0. Here V, Z, and UU are arrays of length NLOC - the local length of all distributed vectors. FKJTIMES should return IER = 0 if successful, or a nonzero IER otherwise. (3) User-supplied routines to define preconditoner: FKLOCFN and FKCOMMFN The routines in the KINBBDPRE (kinbbdpre.c) module provide a preconditioner matrix for KINSOL that is block-diagonal with banded blocks. The blocking corresponds to the distribution of the dependent variable vector u amongst the processes. Each preconditioner block is generated from the Jacobian of the local part (associated with the current process) of a given function g(u) approximating f(u). The blocks are generated by a difference quotient scheme (independently by each process), utilizing the assumed banded structure with given half-bandwidths. (3.1) Local approximate function: FKLOCFN The user must supply a subroutine of the following form: SUBROUTINE FKLOCFN (NLOC, ULOC, GLOC, IER) DIMENSION ULOC(*), GLOC(*) The routine is used to compute the function g(u) which approximates the system function f(u). This function is to be computed locally, i.e. without inter-process communication. Note: The case where g is mathematically identical to f is allowed. It takes as input the local vector length (NLOC) and the local real solution array ULOC. It is to compute the local part of g(u) and store the result in the realtype array GLOC. IER is a return flag (currently not used). (3.2) Communication function: FKCOMMFN The user must also supply a subroutine of the following form: SUBROUTINE FKCOMMFN (NLOC, ULOC, IER) DIMENSION ULOC(*) The routine is used to perform all inter-process communication necessary to evaluate the approximate system function g described above. This function takes as input the local vector length (NLOC), and the local real dependent variable array ULOC. It is expected to save communicated data in work space defined by the user, and made available to FKLOCFN. Each call to the FKCOMMFN function is preceded by a call to FKFUN with the same arguments. Thus FKCOMMFN can omit any communications done by FKFUN if relevant to the evaluation of g. IER is a return flag (currently not used). (4) Initialization: FNVINITP, FKINMALLOC, FKINBBDINIT, and FKINBBDSP* (4.1) To initialize the parallel machine environment, the user must make the following call: CALL FNVINITP (5, NLOCAL, NGLOBAL, IER) The arguments are: NLOCAL = local size of vectors associated with process NGLOBAL = the system size, and the global size of vectors (the sum of all values of NLOCAL) IER = return completion flag. Values are 0 = success, and -1 = failure. (4.2) To allocate internal memory for KINSOL, make the following call: CALL FKINMALLOC (MSBPRE, FNORMTOL, SCSTEPTOL, CONSTRAINTS, OPTIN, IOPT, ROPT, IER) The arguments are: MSBPRE = maximum number of preconditioning solve calls without calling the preconditioning setup routine Note: 0 indicates default (10). FNORMTOL = tolerance on the norm of f(u) to accept convergence SCSTEPTOL = tolerance on minimum scaled step size CONSTRAINTS = array of constraint values on components of the solution vector UU INOPT = integer used as a flag to indicate whether possible input values in IOPT[] array are to be used for input: 0 = no and 1 = yes. IOPT = array for integer optional inputs and outputs (declare as INTEGER*8 ROPT = array of real optional inputs and outputs IER = return completion flag. Values are 0 = success, and -1 = failure. Note: See printed message for details in case of failure. (4.3) Initialize and attach one of the SPILS linear solvers. Make one of the following calls to initialize a solver (see fkinsol.h for more details): CALL FSUNPCGINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPBCGSINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPFGMRINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPGMRINIT(3, PRETYPE, MAXL, IER) CALL FSUNSPTFQMRINIT(3, PRETYPE, MAXL, IER) Then to attach the iterative linear solver structure the user must call: CALL FKINSPILSINIT(IER) (4.4) To allocate memory and initialize data associated with the BBD preconditioner, make the following call: CALL FKINBBDINIT(NLOCAL, MUDQ, MLDQ, MU, ML, IER) The arguments are: NLOCAL = local vector size on this process [long int, input] MUDQ = upper half-bandwidth to be used in the computation of the local Jacobian blocks by difference quotients. These may be smaller than the true half-bandwidths of the Jacobian of the local block of g, when smaller values may provide greater efficiency [long int, input] MLDQ = lower half-bandwidth to be used in the computation of the local Jacobian blocks by difference quotients [long int, input] MU = upper half-bandwidth of the band matrix that is retained as an approximation of the local Jacobian block (may be smaller than MUDQ) [long int, input] ML = lower half-bandwidth of the band matrix that is retained as an approximation of the local Jacobian block (may be smaller than MLDQ) [long int, input] IER = return completion flag [int, output]: 0 = success <0 = an error occurred (5) To solve the system, make the following call: CALL FKINSOL (UU, GLOBALSTRAT, USCALE, FSCALE, IER) The arguments are: UU = array containing the initial guess when called and the solution upon termination GLOBALSTRAT = (INTEGER) a number defining the global strategy choice: 1 = inexact Newton, 2 = line search. USCALE = array of scaling factors for the UU vector FSCALE = array of scaling factors for the FVAL (function) vector IER = integer error flag as returned by KINSOL. Note: See the KINSOL documentation for further information. (6) Optional outputs: FKINBBDOPT In addition to the optional inputs and outputs available with the FKINSOL interface package, there are optional outputs specific to the KINBBDPRE module. These are accessed by making the following call: CALL FKINBBDOPT (LENRPW, LENIPW, NGE) The arguments returned are: LENRPW = length of real preconditioner work space, in realtype words Note: This size is local to the current process. LENIPW = length of integer preconditioner work space, in integer words Note: This size is local to the current process. NGE = number of g(u) evaluations (calls to FKLOCFN) (7) Memory freeing: FKINFREE To the free the internal memory created by the calls to FNVINITP and FKINMALLOC, make the following call: CALL FKINFREE *******************************************************************************/ #ifndef _FKINBBD_H #define _FKINBBD_H /* * ----------------------------------------------------------------- * header files * ----------------------------------------------------------------- */ #include /* definition of type N_Vector */ #include /* definition of type realtype */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * generic names are translated through the define statements below * ----------------------------------------------------------------- */ #if defined(SUNDIALS_F77_FUNC) #define FKIN_BBDINIT SUNDIALS_F77_FUNC(fkinbbdinit, FKINBBDINIT) #define FKIN_BBDOPT SUNDIALS_F77_FUNC(fkinbbdopt, FKINBBDOPT) #define FK_COMMFN SUNDIALS_F77_FUNC(fkcommfn, FKCOMMFN) #define FK_LOCFN SUNDIALS_F77_FUNC(fklocfn, FKLOCFN) #else #define FKIN_BBDINIT fkinbbdinit_ #define FKIN_BBDOPT fkinbbdopt_ #define FK_COMMFN fkcommfn_ #define FK_LOCFN fklocfn_ #endif /* * ----------------------------------------------------------------- * Prototypes: exported functions * ----------------------------------------------------------------- */ void FKIN_BBDINIT(long int *nlocal, long int *mudq, long int *mldq, long int *mu, long int *ml, int *ier); void FKIN_BBDOPT(long int *lenrpw, long int *lenipw, long int *nge); /* * ----------------------------------------------------------------- * Prototypes: FKINgloc and FKINgcomm * ----------------------------------------------------------------- */ int FKINgloc(long int Nloc, N_Vector uu, N_Vector gval, void *user_data); int FKINgcomm(long int Nloc, N_Vector uu, void *user_data); #ifdef __cplusplus } #endif #endif StanHeaders/src/kinsol/fcmix/fkinsol.c0000644000176200001440000003002413766554457017505 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the Fortran interface to * the KINSOL package. See fkinsol.h for usage. * * Note: Some routines are necessarily stored elsewhere to avoid * linking problems. See also, therefore, fkinpreco.c, fkinjtimes.c, * and fkinbbd.c. * -----------------------------------------------------------------*/ #include #include #include #include "fkinsol.h" /* prototypes of interfaces and global vars. */ #include "kinsol_impl.h" /* definition of KINMem type */ #include /* KINLS interface routine prototypes */ /*------------------------------------------------------------------ definitions of global variables shared amongst various routines ------------------------------------------------------------------*/ void *KIN_kinmem; long int *KIN_iout; realtype *KIN_rout; /*------------------------------------------------------------------ private constants ------------------------------------------------------------------*/ #define ZERO RCONST(0.0) /*------------------------------------------------------------------ prototype of user-supplied fortran routine ------------------------------------------------------------------*/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_FUN(realtype*, realtype*, int*); #ifdef __cplusplus } #endif /*------------------------------------------------------------------ Function : FKIN_CREATE ------------------------------------------------------------------*/ void FKIN_CREATE(int *ier) { *ier = 0; /* check for required vector operations */ if ((F2C_KINSOL_vec->ops->nvgetarraypointer == NULL) || (F2C_KINSOL_vec->ops->nvsetarraypointer == NULL)) { *ier = -1; fprintf(stderr, "FKINCREATE: A required vector operation is not implemented.\n\n"); return; } /* Initialize pointers to NULL */ KIN_kinmem = NULL; /* Create KINSOL object */ KIN_kinmem = KINCreate(); if (KIN_kinmem == NULL) { *ier = -1; return; } } /*------------------------------------------------------------------ Function : FKIN_INIT ------------------------------------------------------------------*/ void FKIN_INIT(long int *iout, realtype *rout, int *ier) { /* Call KINInit */ *ier = 0; *ier = KINInit(KIN_kinmem, FKINfunc, F2C_KINSOL_vec); /* On failure, exit */ if (*ier != KIN_SUCCESS) { *ier = -1; return; } /* Grab optional output arrays and store them in global variables */ KIN_iout = iout; KIN_rout = rout; return; } /*------------------------------------------------------------------ Function : FKIN_MALLOC ------------------------------------------------------------------*/ void FKIN_MALLOC(long int *iout, realtype *rout, int *ier) { /* check for required vector operations */ if ((F2C_KINSOL_vec->ops->nvgetarraypointer == NULL) || (F2C_KINSOL_vec->ops->nvsetarraypointer == NULL)) { *ier = -1; fprintf(stderr, "A required vector operation is not implemented.\n\n"); return; } /* Initialize pointers to NULL */ KIN_kinmem = NULL; /* Create KINSOL object */ KIN_kinmem = KINCreate(); if (KIN_kinmem == NULL) { *ier = -1; return; } /* Call KINInit */ *ier = 0; *ier = KINInit(KIN_kinmem, FKINfunc, F2C_KINSOL_vec); /* On failure, exit */ if (*ier != KIN_SUCCESS) { *ier = -1; return; } /* Grab optional output arrays and store them in global variables */ KIN_iout = iout; KIN_rout = rout; return; } /*------------------------------------------------------------------ Function : FKIN_SETIIN ------------------------------------------------------------------*/ void FKIN_SETIIN(char key_name[], long int *ival, int *ier) { if (!strncmp(key_name,"PRNT_LEVEL",10)) *ier = KINSetPrintLevel(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"MAX_NITERS",10)) *ier = KINSetNumMaxIters(KIN_kinmem, (long int) *ival); else if (!strncmp(key_name,"ETA_FORM",8)) *ier = KINSetEtaForm(KIN_kinmem, (int) *ival); else if (!strncmp(key_name,"MAA",3)) *ier = KINSetMAA(KIN_kinmem, (long int) *ival); else if (!strncmp(key_name,"MAX_SETUPS",10)) *ier = KINSetMaxSetupCalls(KIN_kinmem, (long int) *ival); else if (!strncmp(key_name,"MAX_SP_SETUPS",13)) *ier = KINSetMaxSubSetupCalls(KIN_kinmem, (long int) *ival); else if (!strncmp(key_name,"NO_INIT_SETUP",13)) *ier = KINSetNoInitSetup(KIN_kinmem, (booleantype) *ival); else if (!strncmp(key_name,"NO_MIN_EPS",10)) *ier = KINSetNoMinEps(KIN_kinmem, (booleantype) *ival); else if (!strncmp(key_name,"NO_RES_MON",10)) *ier = KINSetNoResMon(KIN_kinmem, (booleantype) *ival); else { *ier = -99; fprintf(stderr, "FKINSETIIN: Unrecognized key.\n\n"); } } /*------------------------------------------------------------------ Function : FKIN_SETRIN ------------------------------------------------------------------*/ void FKIN_SETRIN(char key_name[], realtype *rval, int *ier) { if (!strncmp(key_name,"FNORM_TOL",9)) *ier = KINSetFuncNormTol(KIN_kinmem, *rval); else if (!strncmp(key_name,"SSTEP_TOL",9)) *ier = KINSetScaledStepTol(KIN_kinmem, *rval); else if (!strncmp(key_name,"MAX_STEP",8)) *ier = KINSetMaxNewtonStep(KIN_kinmem, *rval); else if (!strncmp(key_name,"RERR_FUNC",9)) *ier = KINSetRelErrFunc(KIN_kinmem, *rval); else if (!strncmp(key_name,"ETA_CONST",9)) *ier = KINSetEtaConstValue(KIN_kinmem, *rval); else if (!strncmp(key_name,"ETA_PARAMS",10)) *ier = KINSetEtaParams(KIN_kinmem, rval[0], rval[1]); else if (!strncmp(key_name,"RMON_CONST",10)) *ier = KINSetResMonConstValue(KIN_kinmem, *rval); else if (!strncmp(key_name,"RMON_PARAMS",11)) *ier = KINSetResMonParams(KIN_kinmem, rval[0], rval[1]); else { *ier = -99; fprintf(stderr, "FKINSETRIN: Unrecognized key.\n\n"); } } /*------------------------------------------------------------------ Function : FKIN_SETVIN ------------------------------------------------------------------*/ void FKIN_SETVIN(char key_name[], realtype *vval, int *ier) { N_Vector Vec; if (!strncmp(key_name,"CONSTR_VEC",10)) { Vec = NULL; Vec = N_VCloneEmpty(F2C_KINSOL_vec); if (Vec == NULL) { *ier = -1; return; } *ier = 0; N_VSetArrayPointer(vval, Vec); KINSetConstraints(KIN_kinmem, Vec); N_VDestroy(Vec); } else { *ier = -99; fprintf(stderr, "FKINSETVIN: Unrecognized key.\n\n"); } } /*------------------------------------------------------------------ Function : FKIN_LSINIT ------------------------------------------------------------------*/ /* Fortran interface to C routine KINSetLinearSolver */ void FKIN_LSINIT(int *ier) { if ( (KIN_kinmem == NULL) || (F2C_KINSOL_linsol == NULL) ) { *ier = -1; return; } *ier = KINSetLinearSolver(KIN_kinmem, F2C_KINSOL_linsol, F2C_KINSOL_matrix); return; } /*------------------------------------------------------------------ Function : FKIN_DLSINIT -- DEPRECATED ------------------------------------------------------------------*/ void FKIN_DLSINIT(int *ier) { FKIN_LSINIT(ier); } /*------------------------------------------------------------------ Function : FKIN_SPILSINIT -- DEPRECATED ------------------------------------------------------------------*/ void FKIN_SPILSINIT(int *ier) { FKIN_LSINIT(ier); } /*------------------------------------------------------------------ Function : FKIN_SOL ------------------------------------------------------------------*/ void FKIN_SOL(realtype *uu, int *globalstrategy, realtype *uscale , realtype *fscale, int *ier) { N_Vector uuvec, uscalevec, fscalevec; *ier = 0; uuvec = uscalevec = fscalevec = NULL; uuvec = F2C_KINSOL_vec; N_VSetArrayPointer(uu, uuvec); uscalevec = NULL; uscalevec = N_VCloneEmpty(F2C_KINSOL_vec); if (uscalevec == NULL) { *ier = -4; /* KIN_MEM_FAIL */ return; } N_VSetArrayPointer(uscale, uscalevec); fscalevec = NULL; fscalevec = N_VCloneEmpty(F2C_KINSOL_vec); if (fscalevec == NULL) { N_VDestroy(uscalevec); *ier = -4; /* KIN_MEM_FAIL */ return; } N_VSetArrayPointer(fscale, fscalevec); /* If using the fixed-point solver, initialize F2C_KINSOL_linsol and F2C_KINSOL_matrix to NULL */ if (*globalstrategy == KIN_FP) { FKINNullMatrix(); FKINNullLinsol(); } /* Call main solver function */ *ier = KINSol(KIN_kinmem, uuvec, *globalstrategy, uscalevec, fscalevec); N_VSetArrayPointer(NULL, uuvec); N_VSetArrayPointer(NULL, uscalevec); N_VDestroy(uscalevec); N_VSetArrayPointer(NULL, fscalevec); N_VDestroy(fscalevec); /* load optional outputs into iout[] and rout[] */ KINGetWorkSpace(KIN_kinmem, &KIN_iout[0], &KIN_iout[1]); /* LENRW & LENIW */ KINGetNumNonlinSolvIters(KIN_kinmem, &KIN_iout[2]); /* NNI */ KINGetNumFuncEvals(KIN_kinmem, &KIN_iout[3]); /* NFE */ KINGetNumBetaCondFails(KIN_kinmem, &KIN_iout[4]); /* NBCF */ KINGetNumBacktrackOps(KIN_kinmem, &KIN_iout[5]); /* NBCKTRK */ KINGetFuncNorm(KIN_kinmem, &KIN_rout[0]); /* FNORM */ KINGetStepLength(KIN_kinmem, &KIN_rout[1]); /* SSTEP */ KINGetLinWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */ KINGetLastLinFlag(KIN_kinmem, &KIN_iout[8]); /* LSTF */ KINGetNumLinFuncEvals(KIN_kinmem, &KIN_iout[9]); /* NFE */ KINGetNumJacEvals(KIN_kinmem, &KIN_iout[10]); /* NJE */ KINGetNumJtimesEvals(KIN_kinmem, &KIN_iout[11]); /* NJT */ KINGetNumPrecEvals(KIN_kinmem, &KIN_iout[12]); /* NPE */ KINGetNumPrecSolves(KIN_kinmem, &KIN_iout[13]); /* NPS */ KINGetNumLinIters(KIN_kinmem, &KIN_iout[14]); /* NLI */ KINGetNumLinConvFails(KIN_kinmem, &KIN_iout[15]); /* NCFL */ return; } /*------------------------------------------------------------------ Function : FKIN_FREE ------------------------------------------------------------------*/ void FKIN_FREE(void) { KINMem kin_mem; kin_mem = (KINMem) KIN_kinmem; /* free LS interface */ if (kin_mem->kin_lfree) kin_mem->kin_lfree(kin_mem); kin_mem->kin_lmem = NULL; /* free user_data structure */ if (kin_mem->kin_user_data) free(kin_mem->kin_user_data); kin_mem->kin_user_data = NULL; /* free main solver memory structure */ KINFree(&KIN_kinmem); /* free interface vectors / matrices / linear solvers */ N_VSetArrayPointer(NULL, F2C_KINSOL_vec); N_VDestroy(F2C_KINSOL_vec); if (F2C_KINSOL_matrix) SUNMatDestroy(F2C_KINSOL_matrix); if (F2C_KINSOL_linsol) SUNLinSolFree(F2C_KINSOL_linsol); return; } /*------------------------------------------------------------------ Function : FKINfunc ------------------------------------------------------------------ The C function FKINfunc acts as an interface between KINSOL and the Fortran user-supplied subroutine FKFUN. Addresses of the data uu and fdata are passed to FKFUN, using the routine N_VGetArrayPointer from the NVECTOR module. The data in the returned N_Vector fval is set using N_VSetArrayPointer. Auxiliary data is assumed to be communicated by 'Common'. ------------------------------------------------------------------*/ int FKINfunc(N_Vector uu, N_Vector fval, void *user_data) { realtype *udata, *fdata; int ier; udata = N_VGetArrayPointer(uu); fdata = N_VGetArrayPointer(fval); FK_FUN(udata, fdata, &ier); return(ier); } StanHeaders/src/kinsol/fcmix/fkinpreco.c0000644000176200001440000001141613766554457020024 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file contains the interfaces between KINSOL and the * user-supplied Fortran routines FK_PSET and FK_PSOL. * * The C function FKINPSet is used to interface between KINSOL and * the Fortran user-supplied preconditioner setup routine. * * The C function FKINPSol is used to interface between KINSOL and * the Fortran user-supplied preconditioner solve routine. * * Note: The use of the generic names FK_PSET and FK_PSOL below. * -----------------------------------------------------------------*/ #include #include #include "fkinsol.h" #include "kinsol_impl.h" #include /*------------------------------------------------------------------ prototype of the user-supplied fortran routine ------------------------------------------------------------------*/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_PSET(realtype* uudata, realtype* uscaledata, realtype* fvaldata, realtype* fscaledata, int* ier); extern void FK_PSOL(realtype* uudata, realtype* uscaledata, realtype* fvaldata, realtype* fscaledata, realtype* vvdata, int* ier); #ifdef __cplusplus } #endif /*------------------------------------------------------------------ Function : FKIN_LSSETPREC ------------------------------------------------------------------*/ void FKIN_LSSETPREC(int *flag, int *ier) { if ((*flag) == 0) { *ier = KINSetPreconditioner(KIN_kinmem, NULL, NULL); } else { *ier = KINSetPreconditioner(KIN_kinmem, FKINPSet, FKINPSol); } return; } /*------------------------------------------------------------------ Function : FKIN_SPILSSETPREC -- DEPRECATED ------------------------------------------------------------------*/ void FKIN_SPILSSETPREC(int *flag, int *ier) { FKIN_LSSETPREC(flag,ier); } /*------------------------------------------------------------------ Function : FKINPSet ------------------------------------------------------------------ C function FKINPSet is used to interface between FK_PSET and the user-supplied Fortran preconditioner setup routine. ------------------------------------------------------------------*/ int FKINPSet(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *user_data) { realtype *udata, *uscaledata, *fdata, *fscaledata; int ier; /* Initialize all pointers to NULL */ udata = uscaledata = fdata = fscaledata = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ udata = N_VGetArrayPointer(uu); uscaledata = N_VGetArrayPointer(uscale); fdata = N_VGetArrayPointer(fval); fscaledata = N_VGetArrayPointer(fscale); /* Call user-supplied routine */ FK_PSET(udata, uscaledata, fdata, fscaledata, &ier); return(ier); } /*------------------------------------------------------------------ Function : FKINPSol ------------------------------------------------------------------ C function FKINPSol is used to interface between FK_PSOL and the user-supplied Fortran preconditioner solve routine. ------------------------------------------------------------------*/ int FKINPSol(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data) { realtype *udata, *uscaledata, *fdata, *fscaledata, *vvdata; int ier; /* Initialize all pointers to NULL */ udata = uscaledata = fdata = fscaledata = vvdata = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ udata = N_VGetArrayPointer(uu); uscaledata = N_VGetArrayPointer(uscale); fdata = N_VGetArrayPointer(fval); fscaledata = N_VGetArrayPointer(fscale); vvdata = N_VGetArrayPointer(vv); /* Call user-supplied routine */ FK_PSOL(udata, uscaledata, fdata, fscaledata, vvdata, &ier); return(ier); } StanHeaders/src/kinsol/fcmix/fkinbbd.c0000644000176200001440000001116013766554457017437 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This module contains the routines necessary to interface with * the KINBBDPRE module and user-supplied Fortran routines. Generic * names are used (e.g. FK_COMMFN). The routines here call the * generically named routines and provide a standard interface to * the C code of the KINBBDPRE package. * ----------------------------------------------------------------*/ #include #include #include "fkinsol.h" /* standard interfaces and global variables */ #include "fkinbbd.h" /* prototypes of interfaces to KINBBDPRE */ #include /* prototypes of KINBBDPRE functions and macros */ /* * ---------------------------------------------------------------- * private constants * ---------------------------------------------------------------- */ #define ZERO RCONST(0.0) /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_LOCFN(long int* NLOC, realtype* ULOC, realtype* GLOC, int* IER); extern void FK_COMMFN(long int* NLOC, realtype* ULOC, int* IER); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_BBDINIT * ---------------------------------------------------------------- */ void FKIN_BBDINIT(long int *nlocal, long int *mudq, long int *mldq, long int *mu, long int *ml, int *ier) { *ier = KINBBDPrecInit(KIN_kinmem, *nlocal, *mudq, *mldq, *mu, *ml, ZERO, (KINBBDLocalFn) FKINgloc, (KINBBDCommFn) FKINgcomm); return; } /* * ---------------------------------------------------------------- * Function : FKINgloc * ---------------------------------------------------------------- * C function FKINgloc is the interface between the KINBBDPRE * module and the Fortran subroutine FK_LOCFN. * ---------------------------------------------------------------- */ int FKINgloc(long int Nloc, N_Vector uu, N_Vector gval, void *user_data) { realtype *uloc, *gloc; int ier; /* Initialize all pointers to NULL */ uloc = gloc = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uloc = N_VGetArrayPointer(uu); gloc = N_VGetArrayPointer(gval); /* Call user-supplied routine */ FK_LOCFN(&Nloc, uloc, gloc, &ier); return(ier); } /* * ---------------------------------------------------------------- * Function : FKINgcomm * ---------------------------------------------------------------- * C function FKINgcomm is the interface between the KINBBDPRE * module and the Fortran subroutine FK_COMMFN. * ---------------------------------------------------------------- */ int FKINgcomm(long int Nloc, N_Vector uu, void *user_data) { realtype *uloc; int ier; /* Initialize all pointers to NULL */ uloc = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uloc = N_VGetArrayPointer(uu); /* Call user-supplied routine */ FK_COMMFN(&Nloc, uloc, &ier); return(ier); } /* * ---------------------------------------------------------------- * Function : FKIN_BBDOPT * ---------------------------------------------------------------- * C function FKIN_BBDOPT is used to access optional outputs * realated to the BBD preconditioner. * ---------------------------------------------------------------- */ void FKIN_BBDOPT(long int *lenrpw, long int *lenipw, long int *nge) { KINBBDPrecGetWorkSpace(KIN_kinmem, lenrpw, lenipw); KINBBDPrecGetNumGfnEvals(KIN_kinmem, nge); return; } StanHeaders/src/kinsol/fcmix/fkindense.c0000644000176200001440000000640713766554457020016 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINLS, for the case * of a user-supplied Jacobian approximation routine. * -----------------------------------------------------------------*/ #include #include #include "fkinsol.h" /* prototypes of standard interfaces and global vars.*/ #include "kinsol_impl.h" /* definition of KINMem type */ #include #include /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_DJAC(long int* N, realtype* uudata , realtype* fdata, realtype* jacdata, realtype* v1, realtype* v2, int* ier); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_DENSESETJAC * ---------------------------------------------------------------- */ void FKIN_DENSESETJAC(int *flag, int *ier) { if (*flag == 0) { *ier = KINSetJacFn(KIN_kinmem, NULL); } else { *ier = KINSetJacFn(KIN_kinmem, FKINDenseJac); } return; } /* * ---------------------------------------------------------------- * Function : FKINDenseJac * ---------------------------------------------------------------- * C function FKINDenseJac interfaces between KINSOL and a Fortran * subroutine FKDJAC for solution of a linear system with dense * Jacobian approximation. Addresses are passed to FKDJAC, using * the SUNDenseMatrix_Columns function. Auxiliary data is assumed * to be communicated by Common. * ---------------------------------------------------------------- */ int FKINDenseJac(N_Vector uu, N_Vector fval, SUNMatrix J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *uu_data, *fval_data, *jacdata, *v1_data, *v2_data; long int N; int ier; /* Initialize all pointers to NULL */ uu_data = fval_data = jacdata = v1_data = v2_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uu_data = N_VGetArrayPointer(uu); fval_data = N_VGetArrayPointer(fval); v1_data = N_VGetArrayPointer(vtemp1); v2_data = N_VGetArrayPointer(vtemp2); N = SUNDenseMatrix_Columns(J); jacdata = SUNDenseMatrix_Column(J,0); /* Call user-supplied routine */ FK_DJAC(&N, uu_data, fval_data, jacdata, v1_data, v2_data, &ier); return(ier); } StanHeaders/src/kinsol/fcmix/fkinnullmatrix.c0000644000176200001440000000255213766554457021114 0ustar liggesusers/*--------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *--------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *--------------------------------------------------------------- * File that provides a globally-defined, but NULL-valued, * SUNMatrix object, to ensure that F2C_KINSOL_matrix is defined * for cases when no matrix object is linked in with the main * executable. *--------------------------------------------------------------*/ #include #include #include "fkinsol.h" #include "kinsol_impl.h" /*=============================================================*/ /* Define global matrix variable */ SUNMatrix F2C_KINSOL_matrix; /*=============================================================*/ /* C routine that is called when using matrix-free linear solvers or fixed-point nonlinear solver */ void FKINNullMatrix() { F2C_KINSOL_matrix = NULL; } /*=============================================================== EOF ===============================================================*/ StanHeaders/src/kinsol/fcmix/fkinsparse.c0000644000176200001440000000515313766554457020212 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Carol Woodward @ LLNL * Daniel R. Reynolds @ SMU * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * -----------------------------------------------------------------*/ #include #include #include "fkinsol.h" #include "kinsol_impl.h" #include #include /*=============================================================*/ /* Prototype of the Fortran routine */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FKIN_SPJAC(realtype *Y, realtype *FY, long int *N, long int *NNZ, realtype *JDATA, sunindextype *JRVALS, sunindextype *JCPTRS, realtype *V1, realtype *V2, int *ier); #ifdef __cplusplus } #endif /*=============================================================*/ /* Fortran interface to C routine KINSlsSetSparseJacFn; see fkinsol.h for further information */ void FKIN_SPARSESETJAC(int *ier) { #if defined(SUNDIALS_INT32_T) KINProcessError((KINMem) KIN_kinmem, KIN_ILL_INPUT, "KIN", "FKINSPARSESETJAC", "Sparse Fortran users must configure SUNDIALS with 64-bit integers."); *ier = 1; #else *ier = KINSetJacFn(KIN_kinmem, FKINSparseJac); #endif } /*=============================================================*/ /* C interface to user-supplied Fortran routine FKINSPJAC; see fkinsol.h for additional information */ int FKINSparseJac(N_Vector y, N_Vector fy, SUNMatrix J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { int ier; realtype *ydata, *fydata, *v1data, *v2data, *Jdata; long int NP, NNZ; sunindextype *indexvals, *indexptrs; ydata = N_VGetArrayPointer(y); fydata = N_VGetArrayPointer(fy); v1data = N_VGetArrayPointer(vtemp1); v2data = N_VGetArrayPointer(vtemp2); NP = SUNSparseMatrix_NP(J); NNZ = SUNSparseMatrix_NNZ(J); Jdata = SUNSparseMatrix_Data(J); indexvals = SUNSparseMatrix_IndexValues(J); indexptrs = SUNSparseMatrix_IndexPointers(J); FKIN_SPJAC(ydata, fydata, &NP, &NNZ, Jdata, indexvals, indexptrs, v1data, v2data, &ier); return(ier); } StanHeaders/src/kinsol/fcmix/fkinjtimes.c0000644000176200001440000000523513766554457020211 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh and * Radu Serban @ LLNL * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Routines used to interface between KINSOL and a Fortran * user-supplied routine FKJTIMES (Jacobian J times vector v). * -----------------------------------------------------------------*/ #include #include #include "fkinsol.h" #include "kinsol_impl.h" #include /*------------------------------------------------------------------ prototype of the user-supplied fortran routine ------------------------------------------------------------------*/ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_JTIMES(realtype* vdata, realtype* Jvdata, int* new_uu, realtype* uudata, int* ier); #ifdef __cplusplus } #endif /*------------------------------------------------------------------ Function : FKIN_LSSETJAC ------------------------------------------------------------------*/ void FKIN_LSSETJAC(int *flag, int *ier) { if ((*flag) == 0) KINSetJacTimesVecFn(KIN_kinmem, NULL); else KINSetJacTimesVecFn(KIN_kinmem, FKINJtimes); return; } /*------------------------------------------------------------------ Function : FKIN_SPILSSETJAC -- DEPRECATED ------------------------------------------------------------------*/ void FKIN_SPILSSETJAC(int *flag, int *ier) { FKIN_LSSETJAC(flag, ier); } /*------------------------------------------------------------------ Function : FKINJtimes ------------------------------------------------------------------ C function FKINJtimes is used to interface between KINSp* / KINSp*JTimes and FK_JTIMES (user-supplied Fortran routine). ------------------------------------------------------------------*/ int FKINJtimes(N_Vector v, N_Vector Jv, N_Vector uu, booleantype *new_uu, void *user_data) { int retcode; realtype *vdata, *Jvdata, *uudata; vdata = Jvdata = uudata = NULL; vdata = N_VGetArrayPointer(v); uudata = N_VGetArrayPointer(uu); Jvdata = N_VGetArrayPointer(Jv); FK_JTIMES(vdata, Jvdata, (int *) new_uu, uudata, &retcode); return(retcode); } StanHeaders/src/kinsol/fcmix/fkinband.c0000644000176200001440000000711213766554457017616 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Fortran/C interface routines for KINSOL/KINLS, for the case * of a user-supplied Jacobian approximation routine. * -----------------------------------------------------------------*/ #include #include #include "fkinsol.h" /* standard interfaces and global vars.*/ #include "kinsol_impl.h" /* definition of KINMem type */ #include #include /* * ---------------------------------------------------------------- * prototypes of the user-supplied fortran routines * ---------------------------------------------------------------- */ #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif extern void FK_BJAC(long int* N, long int* MU, long int* ML, long int* EBAND, realtype* UU, realtype* FU, realtype* BJAC, realtype* WK1, realtype* WK2, int* IER); #ifdef __cplusplus } #endif /* * ---------------------------------------------------------------- * Function : FKIN_BANDSETJAC * ---------------------------------------------------------------- */ void FKIN_BANDSETJAC(int *flag, int *ier) { if (*flag == 0) { *ier = KINSetJacFn(KIN_kinmem, NULL); } else { *ier = KINSetJacFn(KIN_kinmem, FKINBandJac); } return; } /* * ---------------------------------------------------------------- * Function : FKINBandJac * ---------------------------------------------------------------- * C function FKINBandJac interfaces between KINSOL and a Fortran * subroutine FKBJAC for solution of a linear system with band * Jacobian approximation. Addresses are passed to FKBJAC for * the banded Jacobian and vector data. * Auxiliary data is assumed to be communicated by common blocks. * ---------------------------------------------------------------- */ int FKINBandJac(N_Vector uu, N_Vector fval, SUNMatrix J, void *user_data, N_Vector vtemp1, N_Vector vtemp2) { realtype *uu_data, *fval_data, *jacdata, *v1_data, *v2_data; long int N, mupper, mlower, smu, eband; int ier; /* Initialize all pointers to NULL */ uu_data = fval_data = jacdata = v1_data = v2_data = NULL; /* NOTE: The user-supplied routine should set ier to an appropriate value, but we preset the value to zero (meaning SUCCESS) so the user need only reset the value if an error occurred */ ier = 0; /* Get pointers to vector data */ uu_data = N_VGetArrayPointer(uu); fval_data = N_VGetArrayPointer(fval); v1_data = N_VGetArrayPointer(vtemp1); v2_data = N_VGetArrayPointer(vtemp2); N = SUNBandMatrix_Columns(J); mupper = SUNBandMatrix_UpperBandwidth(J); mlower = SUNBandMatrix_LowerBandwidth(J); smu = SUNBandMatrix_StoredUpperBandwidth(J); eband = smu + mlower + 1; jacdata = SUNBandMatrix_Column(J,0) - mupper; /* Call user-supplied routine */ FK_BJAC(&N, &mupper, &mlower, &eband, uu_data, fval_data, jacdata, v1_data, v2_data, &ier); return(ier); } StanHeaders/src/kinsol/NOTICE0000644000176200001440000000221613766554457015474 0ustar liggesusersThis work was produced under the auspices of the U.S. Department of Energy by Lawrence Livermore National Laboratory under Contract DE-AC52-07NA27344. This work was prepared as an account of work sponsored by an agency of the United States Government. Neither the United States Government nor Lawrence Livermore National Security, LLC, nor any of their employees makes any warranty, expressed or implied, or assumes any legal liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately owned rights. Reference herein to any specific commercial product, process, or service by trade name, trademark, manufacturer, or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or Lawrence Livermore National Security, LLC. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or Lawrence Livermore National Security, LLC, and shall not be used for advertising or product endorsement purposes.StanHeaders/src/kinsol/kinsol_ls.c0000644000176200001440000013053713766554457016741 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * David J. Gardner, Radu Serban and Aaron Collier @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation file for KINSOL's linear solver interface. *-----------------------------------------------------------------*/ #include #include #include #include #include "kinsol_impl.h" #include "kinsol_ls_impl.h" #include #include #include #include /* constants */ #define MIN_INC_MULT RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /*================================================================== KINLS Exported functions -- Required ==================================================================*/ /*--------------------------------------------------------------- KINSetLinearSolver specifies the linear solver ---------------------------------------------------------------*/ int KINSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A) { KINMem kin_mem; KINLsMem kinls_mem; int retval, LSType; /* Return immediately if either kinmem or LS inputs are NULL */ if (kinmem == NULL) { KINProcessError(NULL, KINLS_MEM_NULL, "KINLS", "KINSetLinearSolver", MSG_LS_KINMEM_NULL); return(KINLS_MEM_NULL); } if (LS == NULL) { KINProcessError(NULL, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", "LS must be non-NULL"); return(KINLS_ILL_INPUT); } kin_mem = (KINMem) kinmem; /* Test if solver is compatible with LS interface */ if ( (LS->ops->gettype == NULL) || (LS->ops->initialize == NULL) || (LS->ops->setup == NULL) || (LS->ops->solve == NULL) ) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", "LS object is missing a required operation"); return(KINLS_ILL_INPUT); } /* check for required vector operations for KINLS interface */ if ( (kin_mem->kin_vtemp1->ops->nvconst == NULL) || (kin_mem->kin_vtemp1->ops->nvdotprod == NULL) ) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", MSG_LS_BAD_NVECTOR); return(KINLS_ILL_INPUT); } /* Retrieve the LS type */ LSType = SUNLinSolGetType(LS); /* Check for compatible LS type, matrix and "atimes" support */ if ((LSType == SUNLINEARSOLVER_ITERATIVE) && (LS->ops->setatimes == NULL)) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", "Incompatible inputs: iterative LS must support ATimes routine"); return(KINLS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_DIRECT) && (A == NULL)) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", "Incompatible inputs: direct LS requires non-NULL matrix"); return(KINLS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) && (A == NULL)) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetLinearSolver", "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); return(KINLS_ILL_INPUT); } /* free any existing system solver attached to KIN */ if (kin_mem->kin_lfree) kin_mem->kin_lfree(kin_mem); /* Determine if this is an iterative linear solver */ kin_mem->kin_inexact_ls = ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ); /* Set four main system linear solver function fields in kin_mem */ kin_mem->kin_linit = kinLsInitialize; kin_mem->kin_lsetup = kinLsSetup; kin_mem->kin_lsolve = kinLsSolve; kin_mem->kin_lfree = kinLsFree; /* Get memory for KINLsMemRec */ kinls_mem = NULL; kinls_mem = (KINLsMem) malloc(sizeof(struct KINLsMemRec)); if (kinls_mem == NULL) { KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINLS", "KINSetLinearSolver", MSG_LS_MEM_FAIL); return(KINLS_MEM_FAIL); } memset(kinls_mem, 0, sizeof(struct KINLsMemRec)); /* set SUNLinearSolver pointer */ kinls_mem->LS = LS; /* Set defaults for Jacobian-related fields */ if (A != NULL) { kinls_mem->jacDQ = SUNTRUE; kinls_mem->jac = kinLsDQJac; kinls_mem->J_data = kin_mem; } else { kinls_mem->jacDQ = SUNFALSE; kinls_mem->jac = NULL; kinls_mem->J_data = NULL; } kinls_mem->jtimesDQ = SUNTRUE; kinls_mem->jtimes = kinLsDQJtimes; kinls_mem->jt_data = kin_mem; /* Set defaults for preconditioner-related fields */ kinls_mem->pset = NULL; kinls_mem->psolve = NULL; kinls_mem->pfree = NULL; kinls_mem->pdata = kin_mem->kin_user_data; /* Initialize counters */ kinLsInitializeCounters(kinls_mem); /* Set default values for the rest of the LS parameters */ kinls_mem->last_flag = KINLS_SUCCESS; /* If LS supports ATimes, attach KINLs routine */ if (LS->ops->setatimes) { retval = SUNLinSolSetATimes(LS, kin_mem, kinLsATimes); if (retval != SUNLS_SUCCESS) { KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", "KINSetLinearSolver", "Error in calling SUNLinSolSetATimes"); free(kinls_mem); kinls_mem = NULL; return(KINLS_SUNLS_FAIL); } } /* If LS supports preconditioning, initialize pset/psol to NULL */ if (LS->ops->setpreconditioner) { retval = SUNLinSolSetPreconditioner(LS, kin_mem, NULL, NULL); if (retval != SUNLS_SUCCESS) { KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", "KINSetLinearSolver", "Error in calling SUNLinSolSetPreconditioner"); free(kinls_mem); kinls_mem = NULL; return(KINLS_SUNLS_FAIL); } } /* initialize tolerance scaling factor */ kinls_mem->tol_fac = -ONE; /* set SUNMatrix pointer (can be NULL) */ kinls_mem->J = A; /* Attach linear solver memory to integrator memory */ kin_mem->kin_lmem = kinls_mem; return(KINLS_SUCCESS); } /*================================================================== Optional input/output routines ==================================================================*/ /*------------------------------------------------------------------ KINSetJacFn specifies the Jacobian function ------------------------------------------------------------------*/ int KINSetJacFn(void *kinmem, KINLsJacFn jac) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "KINSetJacFn", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* return with failure if jac cannot be used */ if ((jac != NULL) && (kinls_mem->J == NULL)) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetJacFn", "Jacobian routine cannot be supplied for NULL SUNMatrix"); return(KINLS_ILL_INPUT); } if (jac != NULL) { kinls_mem->jacDQ = SUNFALSE; kinls_mem->jac = jac; kinls_mem->J_data = kin_mem->kin_user_data; } else { kinls_mem->jacDQ = SUNTRUE; kinls_mem->jac = kinLsDQJac; kinls_mem->J_data = kin_mem; } return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINSetPreconditioner sets the preconditioner setup and solve functions ------------------------------------------------------------------*/ int KINSetPreconditioner(void *kinmem, KINLsPrecSetupFn psetup, KINLsPrecSolveFn psolve) { KINMem kin_mem; KINLsMem kinls_mem; PSetupFn kinls_psetup; PSolveFn kinls_psolve; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "KINSetPreconditioner", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* store function pointers for user-supplied routines in KINLS interface */ kinls_mem->pset = psetup; kinls_mem->psolve = psolve; /* issue error if LS object does not support user-supplied preconditioning */ if (kinls_mem->LS->ops->setpreconditioner == NULL) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetPreconditioner", "SUNLinearSolver object does not support user-supplied preconditioning"); return(KINLS_ILL_INPUT); } /* notify iterative linear solver to call KINLs interface routines */ kinls_psetup = (psetup == NULL) ? NULL : kinLsPSetup; kinls_psolve = (psolve == NULL) ? NULL : kinLsPSolve; retval = SUNLinSolSetPreconditioner(kinls_mem->LS, kin_mem, kinls_psetup, kinls_psolve); if (retval != SUNLS_SUCCESS) { KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", "KINSetPreconditioner", "Error in calling SUNLinSolSetPreconditioner"); return(KINLS_SUNLS_FAIL); } return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINSetJacTimesVecFn sets the matrix-vector product function ------------------------------------------------------------------*/ int KINSetJacTimesVecFn(void *kinmem, KINLsJacTimesVecFn jtv) { int retval; KINMem kin_mem; KINLsMem kinls_mem; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "KINSetJacTimesVecFn", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* issue error if LS object does not support user-supplied ATimes */ if (kinls_mem->LS->ops->setatimes == NULL) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "KINSetJacTimesVecFn", "SUNLinearSolver object does not support user-supplied ATimes routine"); return(KINLS_ILL_INPUT); } /* store function pointers for user-supplied routine in KINLs interface (NULL jtimes implies use of DQ default) */ if (jtv != NULL) { kinls_mem->jtimesDQ = SUNFALSE; kinls_mem->jtimes = jtv; kinls_mem->jt_data = kin_mem->kin_user_data; } else { kinls_mem->jtimesDQ = SUNTRUE; kinls_mem->jtimes = kinLsDQJtimes; kinls_mem->jt_data = kin_mem; } return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetLinWorkSpace returns the integer and real workspace size ------------------------------------------------------------------*/ int KINGetLinWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS) { KINMem kin_mem; KINLsMem kinls_mem; sunindextype lrw1, liw1; long int lrw, liw; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "KINGetLinWorkSpace", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* start with fixed sizes plus vector/matrix pointers */ *lenrwLS = 1; *leniwLS = 21; /* add N_Vector sizes */ if (kin_mem->kin_vtemp1->ops->nvspace) { N_VSpace(kin_mem->kin_vtemp1, &lrw1, &liw1); *lenrwLS += lrw1; *leniwLS += liw1; } /* add LS sizes */ if (kinls_mem->LS->ops->space) { retval = SUNLinSolSpace(kinls_mem->LS, &lrw, &liw); if (retval == 0) { *lenrwLS += lrw; *leniwLS += liw; } } return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumJacEvals returns the number of Jacobian evaluations ------------------------------------------------------------------*/ int KINGetNumJacEvals(void *kinmem, long int *njevals) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumJacEvals", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *njevals = kinls_mem->nje; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumPrecEvals returns the total number of preconditioner evaluations ------------------------------------------------------------------*/ int KINGetNumPrecEvals(void *kinmem, long int *npevals) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumPrecEvals", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *npevals = kinls_mem->npe; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumPrecSolves returns the total number of times the preconditioner was applied ------------------------------------------------------------------*/ int KINGetNumPrecSolves(void *kinmem, long int *npsolves) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumPrecSolves", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *npsolves = kinls_mem->nps; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumLinIters returns the total number of linear iterations ------------------------------------------------------------------*/ int KINGetNumLinIters(void *kinmem, long int *nliters) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumLinIters", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *nliters = kinls_mem->nli; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumLinConvFails returns the total numbe of convergence failures ------------------------------------------------------------------*/ int KINGetNumLinConvFails(void *kinmem, long int *nlcfails) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumLinConvFails", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *nlcfails = kinls_mem->ncfl; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumJtimesEvals returns the number of times the matrix vector product was computed ------------------------------------------------------------------*/ int KINGetNumJtimesEvals(void *kinmem, long int *njvevals) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumJtimesEvals", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *njvevals = kinls_mem->njtimes; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetNumLinFuncEvals returns the number of calls to the user's F routine by the linear solver module ------------------------------------------------------------------*/ int KINGetNumLinFuncEvals(void *kinmem, long int *nfevals) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetNumLinFuncEvals", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *nfevals = kinls_mem->nfeDQ; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetLastLinFlag returns the last flag set in the KINLS function ------------------------------------------------------------------*/ int KINGetLastLinFlag(void *kinmem, long int *flag) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure; set output value and return */ retval = kinLs_AccessLMem(kinmem, "KINGetLastLinFlag", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); *flag = kinls_mem->last_flag; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINGetLinReturnFlagName ------------------------------------------------------------------*/ char *KINGetLinReturnFlagName(long int flag) { char *name; name = (char *)malloc(30*sizeof(char)); switch(flag) { case KINLS_SUCCESS: sprintf(name, "KINLS_SUCCESS"); break; case KINLS_MEM_NULL: sprintf(name, "KINLS_MEM_NULL"); break; case KINLS_LMEM_NULL: sprintf(name, "KINLS_LMEM_NULL"); break; case KINLS_ILL_INPUT: sprintf(name, "KINLS_ILL_INPUT"); break; case KINLS_MEM_FAIL: sprintf(name, "KINLS_MEM_FAIL"); break; case KINLS_PMEM_NULL: sprintf(name, "KINLS_PMEM_NULL"); break; case KINLS_JACFUNC_ERR: sprintf(name,"KINLS_JACFUNC_ERR"); break; case KINLS_SUNMAT_FAIL: sprintf(name,"KINLS_SUNMAT_FAIL"); break; case KINLS_SUNLS_FAIL: sprintf(name,"KINLS_SUNLS_FAIL"); break; default: sprintf(name, "NONE"); } return(name); } /*================================================================== KINLS Private functions ==================================================================*/ /*------------------------------------------------------------------ kinLsATimes This routine coordinates the generation of the matrix-vector product z = J*v by calling either kinLsDQJtimes, which uses a difference quotient approximation for J*v, or by calling the user-supplied routine KINLsJacTimesVecFn if it is non-null. ------------------------------------------------------------------*/ int kinLsATimes(void *kinmem, N_Vector v, N_Vector z) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "kinLsATimes", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* call Jacobian-times-vector product routine (either user-supplied or internal DQ) */ retval = kinls_mem->jtimes(v, z, kin_mem->kin_uu, &(kinls_mem->new_uu), kinls_mem->jt_data); kinls_mem->njtimes++; return(retval); } /*--------------------------------------------------------------- kinLsPSetup: This routine interfaces between the generic iterative linear solvers and the user's psetup routine. It passes to psetup all required state information from kin_mem. Its return value is the same as that returned by psetup. Note that the generic iterative linear solvers guarantee that kinLsPSetup will only be called in the case that the user's psetup routine is non-NULL. ---------------------------------------------------------------*/ int kinLsPSetup(void *kinmem) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "kinLsPSetup", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* Call user pset routine to update preconditioner */ retval = kinls_mem->pset(kin_mem->kin_uu, kin_mem->kin_uscale, kin_mem->kin_fval, kin_mem->kin_fscale, kinls_mem->pdata); kinls_mem->npe++; return(retval); } /*------------------------------------------------------------------ kinLsPSolve This routine interfaces between the generic iterative linear solvers and the user's psolve routine. It passes to psolve all required state information from kinsol_mem. Its return value is the same as that returned by psolve. Note that the generic SUNLinSol solver guarantees that kinLsPSolve will not be called in the case in which preconditioning is not done. This is the only case in which the user's psolve routine is allowed to be NULL. ------------------------------------------------------------------*/ int kinLsPSolve(void *kinmem, N_Vector r, N_Vector z, realtype tol, int lr) { KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "kinLsPSolve", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* copy the rhs into z before the psolve call */ /* Note: z returns with the solution */ N_VScale(ONE, r, z); /* note: user-supplied preconditioning with KINSOL does not support either the 'tol' or 'lr' inputs */ retval = kinls_mem->psolve(kin_mem->kin_uu, kin_mem->kin_uscale, kin_mem->kin_fval, kin_mem->kin_fscale, z, kinls_mem->pdata); kinls_mem->nps++; return(retval); } /*------------------------------------------------------------------ kinLsDQJac This routine is a wrapper for the Dense and Band implementations of the difference quotient Jacobian approximation routines. ------------------------------------------------------------------*/ int kinLsDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, void *kinmem, N_Vector tmp1, N_Vector tmp2) { KINMem kin_mem; int retval; /* access KINMem structure */ if (kinmem == NULL) { KINProcessError(NULL, KINLS_MEM_NULL, "KINLS", "kinLsDQJac", MSG_LS_KINMEM_NULL); return(KINLS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* verify that Jac is non-NULL */ if (Jac == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", "kinLsDQJac", MSG_LS_LMEM_NULL); return(KINLS_LMEM_NULL); } /* Call the matrix-structure-specific DQ approximation routine */ if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { retval = kinLsDenseDQJac(u, fu, Jac, kin_mem, tmp1, tmp2); } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { retval = kinLsBandDQJac(u, fu, Jac, kin_mem, tmp1, tmp2); } else { KINProcessError(kin_mem, KIN_ILL_INPUT, "KINLS", "kinLsDQJac", "unrecognized matrix type for kinLsDQJac"); retval = KIN_ILL_INPUT; } return(retval); } /*------------------------------------------------------------------ kinLsDenseDQJac This routine generates a dense difference quotient approximation to the Jacobian of F(u). It assumes a dense SUNMatrix input stored column-wise, and that elements within each column are contiguous. The address of the jth column of J is obtained via the function SUNDenseMatrix_Column() and this pointer is associated with an N_Vector using the N_VGetArrayPointer and N_VSetArrayPointer functions. Finally, the actual computation of the jth column of the Jacobian is done with a call to N_VLinearSum. The increment used in the finite-difference approximation J_ij = ( F_i(u+sigma_j * e_j) - F_i(u) ) / sigma_j is sigma_j = max{|u_j|, |1/uscale_j|} * sqrt(uround) Note: uscale_j = 1/typ(u_j) NOTE: Any type of failure of the system function here leads to an unrecoverable failure of the Jacobian function and thus of the linear solver setup function, stopping KINSOL. ------------------------------------------------------------------*/ int kinLsDenseDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, KINMem kin_mem, N_Vector tmp1, N_Vector tmp2) { realtype inc, inc_inv, ujsaved, ujscale, sign; realtype *tmp2_data, *u_data, *uscale_data; N_Vector ftemp, jthCol; sunindextype j, N; KINLsMem kinls_mem; int retval = 0; /* access LsMem interface structure */ kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* access matrix dimension */ N = SUNDenseMatrix_Rows(Jac); /* Save pointer to the array in tmp2 */ tmp2_data = N_VGetArrayPointer(tmp2); /* Rename work vectors for readibility */ ftemp = tmp1; jthCol = tmp2; /* Obtain pointers to the data for u and uscale */ u_data = N_VGetArrayPointer(u); uscale_data = N_VGetArrayPointer(kin_mem->kin_uscale); /* This is the only for loop for 0..N-1 in KINSOL */ for (j = 0; j < N; j++) { /* Generate the jth col of J(u) */ /* Set data address of jthCol, and save u_j values and scaling */ N_VSetArrayPointer(SUNDenseMatrix_Column(Jac,j), jthCol); ujsaved = u_data[j]; ujscale = ONE/uscale_data[j]; /* Compute increment */ sign = (ujsaved >= ZERO) ? ONE : -ONE; inc = kin_mem->kin_sqrt_relfunc*SUNMAX(SUNRabs(ujsaved), ujscale)*sign; /* Increment u_j, call F(u), and return if error occurs */ u_data[j] += inc; retval = kin_mem->kin_func(u, ftemp, kin_mem->kin_user_data); kinls_mem->nfeDQ++; if (retval != 0) break; /* reset u_j */ u_data[j] = ujsaved; /* Construct difference quotient in jthCol */ inc_inv = ONE/inc; N_VLinearSum(inc_inv, ftemp, -inc_inv, fu, jthCol); } /* Restore original array pointer in tmp2 */ N_VSetArrayPointer(tmp2_data, tmp2); return(retval); } /*------------------------------------------------------------------ kinLsBandDQJac This routine generates a banded difference quotient approximation to the Jacobian of F(u). It assumes a SUNBandMatrix input stored column-wise, and that elements within each column are contiguous. This makes it possible to get the address of a column of J via the function SUNBandMatrix_Column() and to write a simple for loop to set each of the elements of a column in succession. NOTE: Any type of failure of the system function her leads to an unrecoverable failure of the Jacobian function and thus of the linear solver setup function, stopping KINSOL. ------------------------------------------------------------------*/ int kinLsBandDQJac(N_Vector u, N_Vector fu, SUNMatrix Jac, KINMem kin_mem, N_Vector tmp1, N_Vector tmp2) { realtype inc, inc_inv; N_Vector futemp, utemp; sunindextype group, i, j, width, ngroups, i1, i2; sunindextype N, mupper, mlower; realtype *col_j, *fu_data, *futemp_data, *u_data, *utemp_data, *uscale_data; KINLsMem kinls_mem; int retval = 0; /* access LsMem interface structure */ kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* access matrix dimensions */ N = SUNBandMatrix_Columns(Jac); mupper = SUNBandMatrix_UpperBandwidth(Jac); mlower = SUNBandMatrix_LowerBandwidth(Jac); /* Rename work vectors for use as temporary values of u and fu */ futemp = tmp1; utemp = tmp2; /* Obtain pointers to the data for ewt, fy, futemp, y, ytemp */ fu_data = N_VGetArrayPointer(fu); futemp_data = N_VGetArrayPointer(futemp); u_data = N_VGetArrayPointer(u); uscale_data = N_VGetArrayPointer(kin_mem->kin_uscale); utemp_data = N_VGetArrayPointer(utemp); /* Load utemp with u */ N_VScale(ONE, u, utemp); /* Set bandwidth and number of column groups for band differencing */ width = mlower + mupper + 1; ngroups = SUNMIN(width, N); for (group=1; group <= ngroups; group++) { /* Increment all utemp components in group */ for(j=group-1; j < N; j+=width) { inc = kin_mem->kin_sqrt_relfunc*SUNMAX(SUNRabs(u_data[j]), ONE/SUNRabs(uscale_data[j])); utemp_data[j] += inc; } /* Evaluate f with incremented u */ retval = kin_mem->kin_func(utemp, futemp, kin_mem->kin_user_data); if (retval != 0) return(retval); /* Restore utemp components, then form and load difference quotients */ for (j=group-1; j < N; j+=width) { utemp_data[j] = u_data[j]; col_j = SUNBandMatrix_Column(Jac, j); inc = kin_mem->kin_sqrt_relfunc*SUNMAX(SUNRabs(u_data[j]), ONE/SUNRabs(uscale_data[j])); inc_inv = ONE/inc; i1 = SUNMAX(0, j-mupper); i2 = SUNMIN(j+mlower, N-1); for (i=i1; i <= i2; i++) SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (futemp_data[i] - fu_data[i]); } } /* Increment counter nfeDQ */ kinls_mem->nfeDQ += ngroups; return(0); } /*------------------------------------------------------------------ kinLsDQJtimes This routine generates the matrix-vector product z = J*v using a difference quotient approximation. The approximation is J*v = [func(uu + sigma*v) - func(uu)]/sigma. Here sigma is based on the dot products (uscale*uu, uscale*v) and (uscale*v, uscale*v), the L1Norm(uscale*v), and on sqrt_relfunc (the square root of the relative error in the function). Note that v in the argument list has already been both preconditioned and unscaled. NOTE: Unlike the DQ Jacobian functions for direct linear solvers (which are called from within the lsetup function), this function is called from within the lsolve function and thus a recovery may still be possible even if the system function fails (recoverably). ------------------------------------------------------------------*/ int kinLsDQJtimes(N_Vector v, N_Vector Jv, N_Vector u, booleantype *new_u, void *kinmem) { realtype sigma, sigma_inv, sutsv, sq1norm, sign, vtv; KINMem kin_mem; KINLsMem kinls_mem; int retval; /* access KINLsMem structure */ retval = kinLs_AccessLMem(kinmem, "kinLsDQJtimes", &kin_mem, &kinls_mem); if (retval != KIN_SUCCESS) return(retval); /* ensure that NVector supplies requisite routines */ if ( (v->ops->nvprod == NULL) || (v->ops->nvdotprod == NULL) || (v->ops->nvl1norm == NULL) || (v->ops->nvlinearsum == NULL) ){ KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "kinLsDQJtimes", MSG_LS_BAD_NVECTOR); return(KINLS_ILL_INPUT); } /* scale the vector v and put Du*v into vtemp1 */ N_VProd(v, kin_mem->kin_uscale, kin_mem->kin_vtemp1); /* scale u and put into Jv (used as a temporary storage) */ N_VProd(u, kin_mem->kin_uscale, Jv); /* compute dot product (Du*u).(Du*v) */ sutsv = N_VDotProd(Jv, kin_mem->kin_vtemp1); /* compute dot product (Du*v).(Du*v) */ vtv = N_VDotProd(kin_mem->kin_vtemp1, kin_mem->kin_vtemp1); /* compute differencing factor -- this is from p. 469, Brown and Saad paper */ sq1norm = N_VL1Norm(kin_mem->kin_vtemp1); sign = (sutsv >= ZERO) ? ONE : -ONE ; sigma = sign*(kin_mem->kin_sqrt_relfunc)*SUNMAX(SUNRabs(sutsv),sq1norm)/vtv; sigma_inv = ONE/sigma; /* compute the u-prime at which to evaluate the function func */ N_VLinearSum(ONE, u, sigma, v, kin_mem->kin_vtemp1); /* call the system function to calculate func(u+sigma*v) */ retval = kin_mem->kin_func(kin_mem->kin_vtemp1, kin_mem->kin_vtemp2, kin_mem->kin_user_data); kinls_mem->nfeDQ++; if (retval != 0) return(retval); /* finish the computation of the difference quotient */ N_VLinearSum(sigma_inv, kin_mem->kin_vtemp2, -sigma_inv, kin_mem->kin_fval, Jv); return(0); } /*------------------------------------------------------------------ kinLsInitialize performs remaining initializations specific to the iterative linear solver interface (and solver itself) ------------------------------------------------------------------*/ int kinLsInitialize(KINMem kin_mem) { KINLsMem kinls_mem; int retval, LSType; /* Access KINLsMem structure */ if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", "kinLsInitialize", MSG_LS_LMEM_NULL); return(KINLS_LMEM_NULL); } kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* Retrieve the LS type */ LSType = SUNLinSolGetType(kinls_mem->LS); /* Test for valid combinations of matrix & Jacobian routines: */ if (kinls_mem->J == NULL) { /* If SUNMatrix A is NULL: ensure 'jac' function pointer is NULL */ kinls_mem->jacDQ = SUNFALSE; kinls_mem->jac = NULL; kinls_mem->J_data = NULL; } else if (kinls_mem->jacDQ) { /* If J is non-NULL, and 'jac' is not user-supplied: - if A is dense or band, ensure that our DQ approx. is used - otherwise => error */ retval = 0; if (kinls_mem->J->ops->getid) { if ( (SUNMatGetID(kinls_mem->J) == SUNMATRIX_DENSE) || (SUNMatGetID(kinls_mem->J) == SUNMATRIX_BAND) ) { kinls_mem->jac = kinLsDQJac; kinls_mem->J_data = kin_mem; } else { retval++; } } else { retval++; } if (retval) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "kinLsInitialize", "No Jacobian constructor available for SUNMatrix type"); kinls_mem->last_flag = KINLS_ILL_INPUT; return(KINLS_ILL_INPUT); } /* check for required vector operations for kinLsDQJac routine */ if ( (kin_mem->kin_vtemp1->ops->nvlinearsum == NULL) || (kin_mem->kin_vtemp1->ops->nvscale == NULL) || (kin_mem->kin_vtemp1->ops->nvgetarraypointer == NULL) || (kin_mem->kin_vtemp1->ops->nvsetarraypointer == NULL) ) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "kinLsInitialize", MSG_LS_BAD_NVECTOR); return(KINLS_ILL_INPUT); } } else { /* If J is non-NULL, and 'jac' is user-supplied, reset J_data pointer (just in case) */ kinls_mem->J_data = kin_mem->kin_user_data; } /* Prohibit Picard iteration with DQ Jacobian approximation or difference-quotient J*v */ if ( (kin_mem->kin_globalstrategy == KIN_PICARD) && kinls_mem->jacDQ && kinls_mem->jtimesDQ ) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINLS", "kinLsInitialize", MSG_NOL_FAIL); return(KINLS_ILL_INPUT); } /** error-checking is complete, begin initializtions **/ /* Initialize counters */ kinLsInitializeCounters(kinls_mem); /* Set Jacobian-related fields, based on jtimesDQ */ if (kinls_mem->jtimesDQ) { kinls_mem->jtimes = kinLsDQJtimes; kinls_mem->jt_data = kin_mem; } else { kinls_mem->jt_data = kin_mem->kin_user_data; } /* if J is NULL and: NOT preconditioning or do NOT need to setup the preconditioner, then set the lsetup function to NULL */ if (kinls_mem->J == NULL) if ((kinls_mem->psolve == NULL) || (kinls_mem->pset == NULL)) kin_mem->kin_lsetup = NULL; /* Set scaling vectors assuming RIGHT preconditioning */ /* NOTE: retval is non-zero only if LS == NULL */ if (kinls_mem->LS->ops->setscalingvectors) { retval = SUNLinSolSetScalingVectors(kinls_mem->LS, kin_mem->kin_fscale, kin_mem->kin_fscale); if (retval != SUNLS_SUCCESS) { KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINLS", "kinLsInitialize", "Error in calling SUNLinSolSetScalingVectors"); return(KINLS_SUNLS_FAIL); } } /* If the linear solver is iterative or matrix-iterative, and if left/right scaling are not supported, we must update linear solver tolerances in an attempt to account for the fscale vector. We make the following assumptions: 1. fscale_i = fs_mean, for i=0,...,n-1 (i.e. the weights are homogeneous) 2. the linear solver uses a basic 2-norm to measure convergence Hence (using the notation from sunlinsol_spgmr.h, with S = diag(fscale)), || bbar - Abar xbar ||_2 < tol <=> || S b - S A x ||_2 < tol <=> || S (b - A x) ||_2 < tol <=> \sum_{i=0}^{n-1} (fscale_i (b - A x)_i)^2 < tol^2 <=> fs_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / fs_mean^2 <=> || b - A x ||_2 < tol / fs_mean <=> || b - A x ||_2 < tol * tol_fac So we compute tol_fac = 1 / ||fscale||_RMS = sqrt(n) / ||fscale||_2, for scaling desired tolerances */ if ( ((LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) && (kinls_mem->LS->ops->setscalingvectors == NULL) ) { /* compute tol_fac = ||1||_2 / ||fscale||_2 */ N_VConst(ONE, kin_mem->kin_vtemp1); kinls_mem->tol_fac = SUNRsqrt( N_VDotProd(kin_mem->kin_vtemp1, kin_mem->kin_vtemp1) ) / SUNRsqrt( N_VDotProd(kin_mem->kin_fscale, kin_mem->kin_fscale) ); } else { kinls_mem->tol_fac = ONE; } /* Call LS initialize routine, and return result */ kinls_mem->last_flag = SUNLinSolInitialize(kinls_mem->LS); return(kinls_mem->last_flag); } /*------------------------------------------------------------------ kinLsSetup call the LS setup routine ------------------------------------------------------------------*/ int kinLsSetup(KINMem kin_mem) { KINLsMem kinls_mem; int retval; /* Access KINLsMem structure */ if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", "kinLsSetup", MSG_LS_LMEM_NULL); return(KINLS_LMEM_NULL); } kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* recompute if J if it is non-NULL */ if (kinls_mem->J) { /* Increment nje counter. */ kinls_mem->nje++; /* Zero out J */ retval = SUNMatZero(kinls_mem->J); if (retval != 0) { KINProcessError(kin_mem, KINLS_SUNMAT_FAIL, "KINLS", "kinLsSetup", MSG_LS_MATZERO_FAILED); kinls_mem->last_flag = KINLS_SUNMAT_FAIL; return(kinls_mem->last_flag); } /* Call Jacobian routine */ retval = kinls_mem->jac(kin_mem->kin_uu, kin_mem->kin_fval, kinls_mem->J, kinls_mem->J_data, kin_mem->kin_vtemp1, kin_mem->kin_vtemp2); if (retval != 0) { KINProcessError(kin_mem, KINLS_JACFUNC_ERR, "KINLS", "kinLsSetup", MSG_LS_JACFUNC_FAILED); kinls_mem->last_flag = KINLS_JACFUNC_ERR; return(kinls_mem->last_flag); } } /* Call LS setup routine -- the LS will call kinLsPSetup (if applicable) */ kinls_mem->last_flag = SUNLinSolSetup(kinls_mem->LS, kinls_mem->J); /* save nni value from most recent lsetup call */ kin_mem->kin_nnilset = kin_mem->kin_nni; return(kinls_mem->last_flag); } /*------------------------------------------------------------------ kinLsSolve interfaces between KINSOL and the generic SUNLinearSolver object ------------------------------------------------------------------*/ int kinLsSolve(KINMem kin_mem, N_Vector xx, N_Vector bb, realtype *sJpnorm, realtype *sFdotJp) { KINLsMem kinls_mem; int nli_inc, retval; realtype res_norm, tol, LSType; /* Access KINLsMem structure */ if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINLS", "kinLsSolve", MSG_LS_LMEM_NULL); return(KINLS_LMEM_NULL); } kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* Retrieve the LS type */ LSType = SUNLinSolGetType(kinls_mem->LS); /* Set linear solver tolerance as input value times scaling factor (to account for possible lack of support for left/right scaling vectors in SUNLinSol object) */ tol = kin_mem->kin_eps * kinls_mem->tol_fac; /* Set initial guess x = 0 to LS */ N_VConst(ZERO, xx); /* set flag required for user-supplied J*v routine */ kinls_mem->new_uu = SUNTRUE; /* Call solver */ retval = SUNLinSolSolve(kinls_mem->LS, kinls_mem->J, xx, bb, tol); /* Retrieve solver statistics */ res_norm = ZERO; if (kinls_mem->LS->ops->resnorm) res_norm = SUNLinSolResNorm(kinls_mem->LS); nli_inc = 0; if (kinls_mem->LS->ops->numiters) nli_inc = SUNLinSolNumIters(kinls_mem->LS); if ( ((LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) && (kin_mem->kin_printfl > 2) ) KINPrintInfo(kin_mem, PRNT_NLI, "KINLS", "kinLsSolve", INFO_NLI, nli_inc); /* Increment counters nli and ncfl */ kinls_mem->nli += nli_inc; if (retval != SUNLS_SUCCESS) kinls_mem->ncfl++; /* Interpret solver return value */ kinls_mem->last_flag = retval; if ( (retval != 0) && (retval != SUNLS_RES_REDUCED) ) { switch(retval) { case SUNLS_ATIMES_FAIL_REC: case SUNLS_PSOLVE_FAIL_REC: return(1); break; case SUNLS_MEM_NULL: case SUNLS_ILL_INPUT: case SUNLS_MEM_FAIL: case SUNLS_GS_FAIL: case SUNLS_CONV_FAIL: case SUNLS_QRFACT_FAIL: case SUNLS_LUFACT_FAIL: case SUNLS_QRSOL_FAIL: break; case SUNLS_PACKAGE_FAIL_REC: KINProcessError(kin_mem, SUNLS_PACKAGE_FAIL_REC, "KINLS", "kinLsSolve", "Failure in SUNLinSol external package"); break; case SUNLS_PACKAGE_FAIL_UNREC: KINProcessError(kin_mem, SUNLS_PACKAGE_FAIL_UNREC, "KINLS", "kinLsSolve", "Failure in SUNLinSol external package"); break; case SUNLS_ATIMES_FAIL_UNREC: KINProcessError(kin_mem, SUNLS_ATIMES_FAIL_UNREC, "KINLS", "kinLsSolve", MSG_LS_JTIMES_FAILED); break; case SUNLS_PSOLVE_FAIL_UNREC: KINProcessError(kin_mem, SUNLS_PSOLVE_FAIL_UNREC, "KINLS", "kinLsSolve", MSG_LS_PSOLVE_FAILED); break; } return(retval); } /* SUNLinSolSolve returned SUNLS_SUCCESS or SUNLS_RES_REDUCED Compute auxiliary values for use in the linesearch and in KINForcingTerm. These will be subsequently corrected if the step is reduced by constraints or the linesearch. */ /* sJpnorm is the norm of the scaled product (scaled by fscale) of the current Jacobian matrix J and the step vector p (= solution vector xx). Only compute this if KINForcingTerm will eventually be called */ if ( (kin_mem->kin_globalstrategy != KIN_PICARD) && (kin_mem->kin_globalstrategy != KIN_FP) && (kin_mem->kin_callForcingTerm) ) { retval = kinLsATimes(kin_mem, xx, bb); if (retval > 0) { kinls_mem->last_flag = SUNLS_ATIMES_FAIL_REC; return(1); } else if (retval < 0) { kinls_mem->last_flag = SUNLS_ATIMES_FAIL_UNREC; return(-1); } *sJpnorm = N_VWL2Norm(bb, kin_mem->kin_fscale); } /* sFdotJp is the dot product of the scaled f vector and the scaled vector J*p, where the scaling uses fscale */ N_VProd(bb, kin_mem->kin_fscale, bb); N_VProd(bb, kin_mem->kin_fscale, bb); *sFdotJp = N_VDotProd(kin_mem->kin_fval, bb); if ( ((LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) && (kin_mem->kin_printfl > 2) ) KINPrintInfo(kin_mem, PRNT_EPS, "KINLS", "kinLsSolve", INFO_EPS, res_norm, kin_mem->kin_eps); return(0); } /*------------------------------------------------------------------ kinLsFree frees memory associated with the KINLs system solver interface ------------------------------------------------------------------*/ int kinLsFree(KINMem kin_mem) { KINLsMem kinls_mem; /* Return immediately if kin_mem or kin_mem->kin_lmem are NULL */ if (kin_mem == NULL) return (KINLS_SUCCESS); if (kin_mem->kin_lmem == NULL) return(KINLS_SUCCESS); kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* Nullify SUNMatrix pointer */ kinls_mem->J = NULL; /* Free preconditioner memory (if applicable) */ if (kinls_mem->pfree) kinls_mem->pfree(kin_mem); /* free KINLs interface structure */ free(kin_mem->kin_lmem); return(KINLS_SUCCESS); } /*------------------------------------------------------------------ kinLsInitializeCounters resets counters for the LS interface ------------------------------------------------------------------*/ int kinLsInitializeCounters(KINLsMem kinls_mem) { kinls_mem->nje = 0; kinls_mem->nfeDQ = 0; kinls_mem->npe = 0; kinls_mem->nli = 0; kinls_mem->nps = 0; kinls_mem->ncfl = 0; kinls_mem->njtimes = 0; return(0); } /*--------------------------------------------------------------- kinLs_AccessLMem This routine unpacks the kin_mem and ls_mem structures from void* pointer. If either is missing it returns KINLS_MEM_NULL or KINLS_LMEM_NULL. ---------------------------------------------------------------*/ int kinLs_AccessLMem(void* kinmem, const char *fname, KINMem *kin_mem, KINLsMem *kinls_mem) { if (kinmem==NULL) { KINProcessError(NULL, KINLS_MEM_NULL, "KINLS", fname, MSG_LS_KINMEM_NULL); return(KINLS_MEM_NULL); } *kin_mem = (KINMem) kinmem; if ((*kin_mem)->kin_lmem==NULL) { KINProcessError(*kin_mem, KINLS_LMEM_NULL, "KINLS", fname, MSG_LS_LMEM_NULL); return(KINLS_LMEM_NULL); } *kinls_mem = (KINLsMem) (*kin_mem)->kin_lmem; return(KINLS_SUCCESS); } /*--------------------------------------------------------------- EOF ---------------------------------------------------------------*/ StanHeaders/src/kinsol/kinsol_bbdpre.c0000644000176200001440000004451713766554457017563 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with KINSol and the * KINLS linear solver interface. * * Note: With only one process, a banded matrix results * rather than a b-b-d matrix with banded blocks. Diagonal * blocking occurs at the process level. * -----------------------------------------------------------------*/ #include #include #include "kinsol_impl.h" #include "kinsol_ls_impl.h" #include "kinsol_bbdpre_impl.h" #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* Prototypes of functions KINBBDPrecSetup and KINBBDPrecSolve */ static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *pdata); static int KINBBDPrecSolve(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *pdata); /* Prototype for KINBBDPrecFree */ static int KINBBDPrecFree(KINMem kin_mem); /* Prototype for difference quotient jacobian calculation routine */ static int KBBDDQJac(KBBDPrecData pdata, N_Vector uu, N_Vector uscale, N_Vector gu, N_Vector gtemp, N_Vector utemp); /*------------------------------------------------------------------ user-callable functions ------------------------------------------------------------------*/ /*------------------------------------------------------------------ KINBBDPrecInit ------------------------------------------------------------------*/ int KINBBDPrecInit(void *kinmem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dq_rel_uu, KINBBDLocalFn gloc, KINBBDCommFn gcomm) { KINMem kin_mem; KINLsMem kinls_mem; KBBDPrecData pdata; sunindextype muk, mlk, storage_mu, lrw1, liw1; long int lrw, liw; int flag; if (kinmem == NULL) { KINProcessError(NULL, KINLS_MEM_NULL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_NULL); return(KINLS_MEM_NULL); } kin_mem = (KINMem) kinmem; /* Test if the LS linear solver interface has been created */ if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_LMEM_NULL); return(KINLS_LMEM_NULL); } kinls_mem = (KINLsMem) kin_mem->kin_lmem; /* Test compatibility of NVECTOR package with the BBD preconditioner */ /* Note: Do NOT need to check for N_VScale since has already been checked for in KINSOL */ if (kin_mem->kin_vtemp1->ops->nvgetarraypointer == NULL) { KINProcessError(kin_mem, KINLS_ILL_INPUT, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_BAD_NVECTOR); return(KINLS_ILL_INPUT); } /* Allocate data memory */ pdata = NULL; pdata = (KBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } /* Set pointers to gloc and gcomm; load half-bandwidths */ pdata->kin_mem = kinmem; pdata->gloc = gloc; pdata->gcomm = gcomm; pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep)); mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Set extended upper half-bandwidth for PP (required for pivoting) */ storage_mu = SUNMIN(Nlocal-1, muk+mlk); /* Allocate memory for preconditioner matrix */ pdata->PP = NULL; pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } /* Allocate memory for temporary N_Vectors */ pdata->zlocal = NULL; pdata->zlocal = N_VNew_Serial(Nlocal); if (pdata->zlocal == NULL) { SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } pdata->rlocal = NULL; pdata->rlocal = N_VNewEmpty_Serial(Nlocal); /* empty vector */ if (pdata->rlocal == NULL) { N_VDestroy(pdata->zlocal); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } pdata->tempv1 = NULL; pdata->tempv1 = N_VClone(kin_mem->kin_vtemp1); if (pdata->tempv1 == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } pdata->tempv2 = NULL; pdata->tempv2 = N_VClone(kin_mem->kin_vtemp1); if (pdata->tempv2 == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } pdata->tempv3 = NULL; pdata->tempv3 = N_VClone(kin_mem->kin_vtemp1); if (pdata->tempv3 == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } /* Allocate memory for banded linear solver */ pdata->LS = NULL; pdata->LS = SUNLinSol_Band(pdata->zlocal, pdata->PP); if (pdata->LS == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_MEM_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_MEM_FAIL); return(KINLS_MEM_FAIL); } /* initialize band linear solver object */ flag = SUNLinSolInitialize(pdata->LS); if (flag != SUNLS_SUCCESS) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); SUNMatDestroy(pdata->PP); SUNLinSolFree(pdata->LS); free(pdata); pdata = NULL; KINProcessError(kin_mem, KINLS_SUNLS_FAIL, "KINBBDPRE", "KINBBDPrecInit", MSGBBD_SUNLS_FAIL); return(KINLS_SUNLS_FAIL); } /* Set rel_uu based on input value dq_rel_uu (0 implies default) */ pdata->rel_uu = (dq_rel_uu > ZERO) ? dq_rel_uu : SUNRsqrt(kin_mem->kin_uround); /* Store Nlocal to be used in KINBBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge */ pdata->rpwsize = 0; pdata->ipwsize = 0; if (kin_mem->kin_vtemp1->ops->nvspace) { N_VSpace(kin_mem->kin_vtemp1, &lrw1, &liw1); pdata->rpwsize += 3*lrw1; pdata->ipwsize += 3*liw1; } if (pdata->zlocal->ops->nvspace) { N_VSpace(pdata->zlocal, &lrw1, &liw1); pdata->rpwsize += lrw1; pdata->ipwsize += liw1; } if (pdata->rlocal->ops->nvspace) { N_VSpace(pdata->rlocal, &lrw1, &liw1); pdata->rpwsize += lrw1; pdata->ipwsize += liw1; } if (pdata->PP->ops->space) { flag = SUNMatSpace(pdata->PP, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } if (pdata->LS->ops->space) { flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } pdata->nge = 0; /* make sure pdata is free from any previous allocations */ if (kinls_mem->pfree != NULL) kinls_mem->pfree(kin_mem); /* Point to the new pdata field in the LS memory */ kinls_mem->pdata = pdata; /* Attach the pfree function */ kinls_mem->pfree = KINBBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = KINSetPreconditioner(kinmem, KINBBDPrecSetup, KINBBDPrecSolve); return(flag); } /*------------------------------------------------------------------ KINBBDPrecGetWorkSpace ------------------------------------------------------------------*/ int KINBBDPrecGetWorkSpace(void *kinmem, long int *lenrwBBDP, long int *leniwBBDP) { KINMem kin_mem; KINLsMem kinls_mem; KBBDPrecData pdata; if (kinmem == NULL) { KINProcessError(NULL, KINLS_MEM_NULL, "KINBBDPRE", "KINBBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(KINLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(KINLS_LMEM_NULL); } kinls_mem = (KINLsMem) kin_mem->kin_lmem; if (kinls_mem->pdata == NULL) { KINProcessError(kin_mem, KINLS_PMEM_NULL, "KINBBDPRE", "KINBBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(KINLS_PMEM_NULL); } pdata = (KBBDPrecData) kinls_mem->pdata; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINBBDPrecGetNumGfnEvals -------------------------------------------------------------------*/ int KINBBDPrecGetNumGfnEvals(void *kinmem, long int *ngevalsBBDP) { KINMem kin_mem; KINLsMem kinls_mem; KBBDPrecData pdata; if (kinmem == NULL) { KINProcessError(NULL, KINLS_MEM_NULL, "KINBBDPRE", "KINBBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(KINLS_MEM_NULL); } kin_mem = (KINMem) kinmem; if (kin_mem->kin_lmem == NULL) { KINProcessError(kin_mem, KINLS_LMEM_NULL, "KINBBDPRE", "KINBBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(KINLS_LMEM_NULL); } kinls_mem = (KINLsMem) kin_mem->kin_lmem; if (kinls_mem->pdata == NULL) { KINProcessError(kin_mem, KINLS_PMEM_NULL, "KINBBDPRE", "KINBBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(KINLS_PMEM_NULL); } pdata = (KBBDPrecData) kinls_mem->pdata; *ngevalsBBDP = pdata->nge; return(KINLS_SUCCESS); } /*------------------------------------------------------------------ KINBBDPrecSetup KINBBDPrecSetup generates and factors a banded block of the preconditioner matrix on each processor, via calls to the user-supplied gloc and gcomm functions. It uses difference quotient approximations to the Jacobian elements. KINBBDPrecSetup calculates a new Jacobian, stored in banded matrix PP and does an LU factorization of P in place in PP. The parameters of KINBBDPrecSetup are as follows: uu is the current value of the dependent variable vector, namely the solutin to func(uu)=0 uscale is the dependent variable scaling vector (i.e. uu) fval is the vector f(u) fscale is the function scaling vector bbd_data is the pointer to BBD data set by KINBBDInit. Note: The value to be returned by the KINBBDPrecSetup function is a flag indicating whether it was successful. This value is: 0 if successful, > 0 for a recoverable error - step will be retried. ------------------------------------------------------------------*/ static int KINBBDPrecSetup(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *bbd_data) { KBBDPrecData pdata; KINMem kin_mem; int retval; pdata = (KBBDPrecData) bbd_data; kin_mem = (KINMem) pdata->kin_mem; /* Call KBBDDQJac for a new Jacobian calculation and store in PP */ retval = SUNMatZero(pdata->PP); if (retval != 0) { KINProcessError(kin_mem, -1, "KINBBDPRE", "KINBBDPrecSetup", MSGBBD_SUNMAT_FAIL); return(-1); } retval = KBBDDQJac(pdata, uu, uscale, pdata->tempv1, pdata->tempv2, pdata->tempv3); if (retval != 0) { KINProcessError(kin_mem, -1, "KINBBDPRE", "KINBBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } /* Do LU factorization of P and return error flag */ retval = SUNLinSolSetup_Band(pdata->LS, pdata->PP); return(retval); } /*------------------------------------------------------------------ INBBDPrecSolve KINBBDPrecSolve solves a linear system P z = r, with the banded blocked preconditioner matrix P generated and factored by KINBBDPrecSetup. Here, r comes in as vv and z is returned in vv as well. The parameters for KINBBDPrecSolve are as follows: uu an N_Vector giving the current iterate for the system uscale an N_Vector giving the diagonal entries of the uu scaling matrix fval an N_Vector giving the current function value fscale an N_Vector giving the diagonal entries of the function scaling matrix vv vector initially set to the right-hand side vector r, but which upon return contains a solution of the linear system P*z = r bbd_data is the pointer to BBD data set by KINBBDInit. Note: The value returned by the KINBBDPrecSolve function is a flag returned from the lienar solver object. ------------------------------------------------------------------*/ static int KINBBDPrecSolve(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *bbd_data) { KBBDPrecData pdata; realtype *vd; realtype *zd; int i, retval; pdata = (KBBDPrecData) bbd_data; /* Get data pointers */ vd = N_VGetArrayPointer(vv); zd = N_VGetArrayPointer(pdata->zlocal); /* Attach local data array for vv to rlocal */ N_VSetArrayPointer(vd, pdata->rlocal); /* Call banded solver object to do the work */ retval = SUNLinSolSolve(pdata->LS, pdata->PP, pdata->zlocal, pdata->rlocal, ZERO); /* Copy result into vv */ for (i=0; in_local; i++) vd[i] = zd[i]; return(retval); } /*------------------------------------------------------------------ KINBBDPrecFree ------------------------------------------------------------------*/ static int KINBBDPrecFree(KINMem kin_mem) { KINLsMem kinls_mem; KBBDPrecData pdata; if (kin_mem->kin_lmem == NULL) return(0); kinls_mem = (KINLsMem) kin_mem->kin_lmem; if (kinls_mem->pdata == NULL) return(0); pdata = (KBBDPrecData) kinls_mem->pdata; SUNLinSolFree(pdata->LS); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; return(0); } /*------------------------------------------------------------------ KBBDDQJac This routine generates a banded difference quotient approximation to the Jacobian of f(u). It assumes that a band matrix of type SUNMatrix is stored column-wise, and that elements within each column are contiguous. All matrix elements are generated as difference quotients, by way of calls to the user routine gloc. By virtue of the band structure, the number of these calls is bandwidth + 1, where bandwidth = ml + mu + 1. This routine also assumes that the local elements of a vector are stored contiguously. ------------------------------------------------------------------*/ static int KBBDDQJac(KBBDPrecData pdata, N_Vector uu, N_Vector uscale, N_Vector gu, N_Vector gtemp, N_Vector utemp) { KINMem kin_mem; realtype inc, inc_inv; int retval; sunindextype group, i, j, width, ngroups, i1, i2; realtype *udata, *uscdata, *gudata, *gtempdata, *utempdata, *col_j; kin_mem = (KINMem) pdata->kin_mem; /* load utemp with uu = predicted solution vector */ N_VScale(ONE, uu, utemp); /* set pointers to the data for all vectors */ udata = N_VGetArrayPointer(uu); uscdata = N_VGetArrayPointer(uscale); gudata = N_VGetArrayPointer(gu); gtempdata = N_VGetArrayPointer(gtemp); utempdata = N_VGetArrayPointer(utemp); /* Call gcomm and gloc to get base value of g(uu) */ if (pdata->gcomm != NULL) { retval = pdata->gcomm(pdata->n_local, uu, kin_mem->kin_user_data); if (retval != 0) return(retval); } retval = pdata->gloc(pdata->n_local, uu, gu, kin_mem->kin_user_data); pdata->nge++; if (retval != 0) return(retval); /* Set bandwidth and number of column groups for band differencing */ width = pdata->mldq + pdata->mudq + 1; ngroups = SUNMIN(width, pdata->n_local); /* Loop over groups */ for(group = 1; group <= ngroups; group++) { /* increment all u_j in group */ for(j = group - 1; j < pdata->n_local; j += width) { inc = pdata->rel_uu * SUNMAX(SUNRabs(udata[j]), (ONE / uscdata[j])); utempdata[j] += inc; } /* Evaluate g with incremented u */ retval = pdata->gloc(pdata->n_local, utemp, gtemp, kin_mem->kin_user_data); pdata->nge++; if (retval != 0) return(retval); /* restore utemp, then form and load difference quotients */ for (j = group - 1; j < pdata->n_local; j += width) { utempdata[j] = udata[j]; col_j = SUNBandMatrix_Column(pdata->PP,j); inc = pdata->rel_uu * SUNMAX(SUNRabs(udata[j]) , (ONE / uscdata[j])); inc_inv = ONE / inc; i1 = SUNMAX(0, (j - pdata->mukeep)); i2 = SUNMIN((j + pdata->mlkeep), (pdata->n_local - 1)); for (i = i1; i <= i2; i++) SM_COLUMN_ELEMENT_B(col_j, i, j) = inc_inv * (gtempdata[i] - gudata[i]); } } return(0); } StanHeaders/src/kinsol/kinsol_io.c0000644000176200001440000006147113766554457016732 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the KINSOL solver. * ----------------------------------------------------------------- */ #include #include #include "kinsol_impl.h" #include #include #define ZERO RCONST(0.0) #define POINT1 RCONST(0.1) #define ONETHIRD RCONST(0.3333333333333333) #define HALF RCONST(0.5) #define TWOTHIRDS RCONST(0.6666666666666667) #define POINT9 RCONST(0.9) #define ONE RCONST(1.0) #define TWO RCONST(2.0) #define TWOPT5 RCONST(2.5) #define liw (kin_mem->kin_liw) #define lrw (kin_mem->kin_lrw) #define liw1 (kin_mem->kin_liw1) #define lrw1 (kin_mem->kin_lrw1) /* * ================================================================= * KINSOL optional input functions * ================================================================= */ /* * ----------------------------------------------------------------- * KINSetErrHandlerFn * ----------------------------------------------------------------- */ int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, void *eh_data) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrHandlerFn", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_ehfun = ehfun; kin_mem->kin_eh_data = eh_data; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetErrFile * ----------------------------------------------------------------- */ int KINSetErrFile(void *kinmem, FILE *errfp) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetErrFile", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_errfp = errfp; return(KIN_SUCCESS); } #define errfp (kin_mem->kin_errfp) /* * ----------------------------------------------------------------- * Function : KINSetPrintLevel * ----------------------------------------------------------------- */ int KINSetPrintLevel(void *kinmem, int printfl) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetPrintLevel", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((printfl < 0) || (printfl > 3)) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetPrintLevel", MSG_BAD_PRINTFL); return(KIN_ILL_INPUT); } kin_mem->kin_printfl = printfl; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * KINSetInfoHandlerFn * ----------------------------------------------------------------- */ int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, void *ih_data) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoHandlerFn", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_ihfun = ihfun; kin_mem->kin_ih_data = ih_data; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetInfoFile * ----------------------------------------------------------------- */ int KINSetInfoFile(void *kinmem, FILE *infofp) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetInfoFile", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_infofp = infofp; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetUserData * ----------------------------------------------------------------- */ int KINSetUserData(void *kinmem, void *user_data) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetUserData", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_user_data = user_data; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMAA * ----------------------------------------------------------------- */ int KINSetMAA(void *kinmem, long int maa) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMAA", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (maa < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMAA", MSG_BAD_MAA); return(KIN_ILL_INPUT); } if (maa > kin_mem->kin_mxiter) maa = kin_mem->kin_mxiter; kin_mem = (KINMem) kinmem; kin_mem->kin_m_aa = maa; kin_mem->kin_aamem_aa = (maa == 0) ? SUNFALSE : SUNTRUE; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetAAStopCrit * ----------------------------------------------------------------- */ /* CSW: This function is currently not supported. int KINSetAAStopCrit(void *kinmem, booleantype setstop) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetAAStopCrit", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_setstop_aa = setstop; return(KIN_SUCCESS); } */ /* * ----------------------------------------------------------------- * Function : KINSetNumMaxIters * ----------------------------------------------------------------- */ int KINSetNumMaxIters(void *kinmem, long int mxiter) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNumMaxIters", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (mxiter < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetNumMaxIters", MSG_BAD_MXITER); return(KIN_ILL_INPUT); } if (mxiter == 0) kin_mem->kin_mxiter = MXITER_DEFAULT; else kin_mem->kin_mxiter = mxiter; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNoInitSetup * ----------------------------------------------------------------- */ int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoInitSetup", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_noInitSetup = noInitSetup; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNoResMon * ----------------------------------------------------------------- */ int KINSetNoResMon(void *kinmem, booleantype noResMon) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoResMon", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_noResMon = noResMon; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxSetupCalls * ----------------------------------------------------------------- */ int KINSetMaxSetupCalls(void *kinmem, long int msbset) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSetupCalls", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (msbset < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSetupCalls", MSG_BAD_MSBSET); return(KIN_ILL_INPUT); } if (msbset == 0) kin_mem->kin_msbset = MSBSET_DEFAULT; else kin_mem->kin_msbset = msbset; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxSubSetupCalls * ----------------------------------------------------------------- */ int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxSubSetupCalls", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (msbsetsub < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxSubSetupCalls", MSG_BAD_MSBSETSUB); return(KIN_ILL_INPUT); } if (msbsetsub == 0) kin_mem->kin_msbset_sub = MSBSET_SUB_DEFAULT; else kin_mem->kin_msbset_sub = msbsetsub; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetEtaForm * ----------------------------------------------------------------- */ int KINSetEtaForm(void *kinmem, int etachoice) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaForm", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((etachoice != KIN_ETACONSTANT) && (etachoice != KIN_ETACHOICE1) && (etachoice != KIN_ETACHOICE2)) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaForm", MSG_BAD_ETACHOICE); return(KIN_ILL_INPUT); } kin_mem->kin_etaflag = etachoice; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetEtaConstValue * ----------------------------------------------------------------- */ int KINSetEtaConstValue(void *kinmem, realtype eta) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaConstValue", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((eta < ZERO) || (eta > ONE)) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaConstValue", MSG_BAD_ETACONST); return(KIN_ILL_INPUT); } if (eta == ZERO) kin_mem->kin_eta = POINT1; else kin_mem->kin_eta = eta; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetEtaParams * ----------------------------------------------------------------- */ int KINSetEtaParams(void *kinmem, realtype egamma, realtype ealpha) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetEtaParams", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if ((ealpha <= ONE) || (ealpha > TWO)) if (ealpha != ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_ALPHA); return(KIN_ILL_INPUT); } if (ealpha == ZERO) kin_mem->kin_eta_alpha = TWO; else kin_mem->kin_eta_alpha = ealpha; if ((egamma <= ZERO) || (egamma > ONE)) if (egamma != ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetEtaParams", MSG_BAD_GAMMA); return(KIN_ILL_INPUT); } if (egamma == ZERO) kin_mem->kin_eta_gamma = POINT9; else kin_mem->kin_eta_gamma = egamma; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetResMonParams * ----------------------------------------------------------------- */ int KINSetResMonParams(void *kinmem, realtype omegamin, realtype omegamax) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonParams", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check omegamin */ if (omegamin < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } if (omegamin == ZERO) kin_mem->kin_omega_min = OMEGA_MIN; else kin_mem->kin_omega_min = omegamin; /* check omegamax */ if (omegamax < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } if (omegamax == ZERO) { if (kin_mem->kin_omega_min > OMEGA_MAX) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } else kin_mem->kin_omega_max = OMEGA_MAX; } else { if (kin_mem->kin_omega_min > omegamax) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonParams", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } else kin_mem->kin_omega_max = omegamax; } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetResMonConstValue * ----------------------------------------------------------------- */ int KINSetResMonConstValue(void *kinmem, realtype omegaconst) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetResMonConstValue", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; /* check omegaconst */ if (omegaconst < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetResMonConstValue", MSG_BAD_OMEGA); return(KIN_ILL_INPUT); } /* Load omega value. A value of 0 will force using omega_min and omega_max */ kin_mem->kin_omega = omegaconst; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetNoMinEps * ----------------------------------------------------------------- */ int KINSetNoMinEps(void *kinmem, booleantype noMinEps) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetNoMinEps", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; kin_mem->kin_noMinEps = noMinEps; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxNewtonStep * ----------------------------------------------------------------- */ int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxNewtonStep", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (mxnewtstep < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxNewtonStep", MSG_BAD_MXNEWTSTEP); return(KIN_ILL_INPUT); } /* Note: passing a value of 0.0 will use the default value (computed in KINSolInit) */ kin_mem->kin_mxnstepin = mxnewtstep; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetMaxBetaFails * ----------------------------------------------------------------- */ int KINSetMaxBetaFails(void *kinmem, long int mxnbcf) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetMaxBetaFails", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (mxnbcf < 0) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetMaxBetaFails", MSG_BAD_MXNBCF); return(KIN_ILL_INPUT); } if (mxnbcf == 0) kin_mem->kin_mxnbcf = MXNBCF_DEFAULT; else kin_mem->kin_mxnbcf = mxnbcf; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetRelErrFunc * ----------------------------------------------------------------- */ int KINSetRelErrFunc(void *kinmem, realtype relfunc) { KINMem kin_mem; realtype uround; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetRelErrFunc", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (relfunc < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetRelErrFunc", MSG_BAD_RELFUNC); return(KIN_ILL_INPUT); } if (relfunc == ZERO) { uround = kin_mem->kin_uround; kin_mem->kin_sqrt_relfunc = SUNRsqrt(uround); } else { kin_mem->kin_sqrt_relfunc = SUNRsqrt(relfunc); } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetFuncNormTol * ----------------------------------------------------------------- */ int KINSetFuncNormTol(void *kinmem, realtype fnormtol) { KINMem kin_mem; realtype uround; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetFuncNormTol", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (fnormtol < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetFuncNormTol", MSG_BAD_FNORMTOL); return(KIN_ILL_INPUT); } if (fnormtol == ZERO) { uround = kin_mem->kin_uround; kin_mem->kin_fnormtol = SUNRpowerR(uround,ONETHIRD); } else { kin_mem->kin_fnormtol = fnormtol; } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetScaledStepTol * ----------------------------------------------------------------- */ int KINSetScaledStepTol(void *kinmem, realtype scsteptol) { KINMem kin_mem; realtype uround; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetScaledStepTol", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (scsteptol < ZERO) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetScaledStepTol", MSG_BAD_SCSTEPTOL); return(KIN_ILL_INPUT); } if (scsteptol == ZERO) { uround = kin_mem->kin_uround; kin_mem->kin_scsteptol = SUNRpowerR(uround,TWOTHIRDS); } else { kin_mem->kin_scsteptol = scsteptol; } return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetConstraints * ----------------------------------------------------------------- */ int KINSetConstraints(void *kinmem, N_Vector constraints) { KINMem kin_mem; realtype temptest; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetConstraints", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (constraints == NULL) { if (kin_mem->kin_constraintsSet) { N_VDestroy(kin_mem->kin_constraints); lrw -= lrw1; liw -= liw1; } kin_mem->kin_constraintsSet = SUNFALSE; return(KIN_SUCCESS); } /* Check the constraints vector */ temptest = N_VMaxNorm(constraints); if (temptest > TWOPT5){ KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetConstraints", MSG_BAD_CONSTRAINTS); return(KIN_ILL_INPUT); } if (!kin_mem->kin_constraintsSet) { kin_mem->kin_constraints = N_VClone(constraints); lrw += lrw1; liw += liw1; kin_mem->kin_constraintsSet = SUNTRUE; } /* Load the constraint vector */ N_VScale(ONE, constraints, kin_mem->kin_constraints); return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINSetSysFunc * ----------------------------------------------------------------- */ int KINSetSysFunc(void *kinmem, KINSysFn func) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINSetSysFunc", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; if (func == NULL) { KINProcessError(NULL, KIN_ILL_INPUT, "KINSOL", "KINSetSysFunc", MSG_FUNC_NULL); return(KIN_ILL_INPUT); } kin_mem->kin_func = func; return(KIN_SUCCESS); } /* * ================================================================= * Readability constants * ================================================================= */ #define nni (kin_mem->kin_nni) #define nfe (kin_mem->kin_nfe) #define nbcf (kin_mem->kin_nbcf) #define nbktrk (kin_mem->kin_nbktrk) #define stepl (kin_mem->kin_stepl) #define fnorm (kin_mem->kin_fnorm) #define liw (kin_mem->kin_liw) #define lrw (kin_mem->kin_lrw) /* * ================================================================= * KINSOL optional input functions * ================================================================= */ /* * ----------------------------------------------------------------- * Function : KINGetWorkSpace * ----------------------------------------------------------------- */ int KINGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetWorkSpace", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *lenrw = lrw; *leniw = liw; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumNonlinSolvIters * ----------------------------------------------------------------- */ int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumNonlinSolvIters", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nniters = nni; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumFuncEvals * ----------------------------------------------------------------- */ int KINGetNumFuncEvals(void *kinmem, long int *nfevals) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumFuncEvals", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nfevals = nfe; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumBetaCondFails * ----------------------------------------------------------------- */ int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBetaCondFails", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nbcfails = nbcf; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetNumBacktrackOps * ----------------------------------------------------------------- */ int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetNumBacktrackOps", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *nbacktr = nbktrk; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetFuncNorm * ----------------------------------------------------------------- */ int KINGetFuncNorm(void *kinmem, realtype *funcnorm) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetFuncNorm", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *funcnorm = kin_mem->kin_fnorm; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetStepLength * ----------------------------------------------------------------- */ int KINGetStepLength(void *kinmem, realtype *steplength) { KINMem kin_mem; if (kinmem == NULL) { KINProcessError(NULL, KIN_MEM_NULL, "KINSOL", "KINGetStepLength", MSG_NO_MEM); return(KIN_MEM_NULL); } kin_mem = (KINMem) kinmem; *steplength = stepl; return(KIN_SUCCESS); } /* * ----------------------------------------------------------------- * Function : KINGetReturnFlagName * ----------------------------------------------------------------- */ char *KINGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(24*sizeof(char)); switch(flag) { case KIN_SUCCESS: sprintf(name, "KIN_SUCCESS"); break; case KIN_INITIAL_GUESS_OK: sprintf(name, "KIN_INITIAL_GUESS_OK"); break; case KIN_STEP_LT_STPTOL: sprintf(name, "KIN_STEP_LT_STPTOL"); break; case KIN_WARNING: sprintf(name, "KIN_WARNING"); break; case KIN_MEM_NULL: sprintf(name, "KIN_MEM_NULL"); break; case KIN_ILL_INPUT: sprintf(name, "KIN_ILL_INPUT"); break; case KIN_NO_MALLOC: sprintf(name, "KIN_NO_MALLOC"); break; case KIN_MEM_FAIL: sprintf(name, "KIN_MEM_FAIL"); break; case KIN_LINESEARCH_NONCONV: sprintf(name, "KIN_LINESEARCH_NONCONV"); break; case KIN_MAXITER_REACHED: sprintf(name, "KIN_MAXITER_REACHED"); break; case KIN_MXNEWT_5X_EXCEEDED: sprintf(name, "KIN_MXNEWT_5X_EXCEEDED"); break; case KIN_LINESEARCH_BCFAIL: sprintf(name, "KIN_LINESEARCH_BCFAIL"); break; case KIN_LINSOLV_NO_RECOVERY: sprintf(name, "KIN_LINSOLV_NO_RECOVERY"); break; case KIN_LINIT_FAIL: sprintf(name, "KIN_LINIT_FAIL"); break; case KIN_LSETUP_FAIL: sprintf(name, "KIN_LSETUP_FAIL"); break; case KIN_LSOLVE_FAIL: sprintf(name, "KIN_LSOLVE_FAIL"); break; default: sprintf(name, "NONE"); } return(name); } StanHeaders/src/Makevars0000644000176200001440000000572713655032377014764 0ustar liggesusers.PHONY: static PKG_CPPFLAGS=-DNO_FPRINTF_OUTPUT -I"../inst/include" -include stan_sundials_printf_override.hpp #SUNDIALS_CVODES = cvodes/cvodes_spils.c cvodes/cvodes_io.c cvodes/cvodes_bbdpre.c cvodes/cvodes_nls_stg1.c cvodes/fmod/fcvodes_mod.c cvodes/cvodes.c cvodes/cvodes_nls_sim.c cvodes/cvodes_diag.c cvodes/cvodes_ls.c cvodes/cvodes_direct.c cvodes/cvodes_nls.c cvodes/cvodes_nls_stg.c cvodes/cvodea.c cvodes/cvodea_io.c cvodes/cvodes_bandpre.c sundials/sundials_matrix.c sundials/sundials_band.c sundials/sundials_math.c sundials/fmod/fsundials_futils_mod.c sundials/fmod/fsundials_nonlinearsolver_mod.c sundials/fmod/fsundials_types_mod.c sundials/fmod/fsundials_nvector_mod.c sundials/fmod/fsundials_matrix_mod.c sundials/fmod/fsundials_linearsolver_mod.c sundials/sundials_linearsolver.c sundials/sundials_nvector.c sundials/sundials_direct.c sundials/sundials_dense.c sundials/sundials_futils.c sundials/sundials_version.c sundials/sundials_iterative.c sundials/sundials_nvector_senswrapper.c sundials/sundials_nonlinearsolver.c sunmatrix/band/sunmatrix_band.c sunmatrix/dense/sunmatrix_dense.c sunlinsol/band/sunlinsol_band.c sunlinsol/dense/sunlinsol_dense.c sunnonlinsol/newton/sunnonlinsol_newton.c sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c SUNDIALS_CVODES = cvodes/cvodes_spils.c cvodes/cvodes_io.c cvodes/cvodes_bbdpre.c cvodes/cvodes_nls_stg1.c cvodes/cvodes.c cvodes/cvodes_nls_sim.c cvodes/cvodes_diag.c cvodes/cvodes_ls.c cvodes/cvodes_direct.c cvodes/cvodes_nls.c cvodes/cvodes_nls_stg.c cvodes/cvodea.c cvodes/cvodea_io.c cvodes/cvodes_bandpre.c sundials/sundials_matrix.c sundials/sundials_band.c sundials/sundials_math.c sundials/sundials_linearsolver.c sundials/sundials_nvector.c sundials/sundials_direct.c sundials/sundials_dense.c sundials/sundials_version.c sundials/sundials_iterative.c sundials/sundials_nvector_senswrapper.c sundials/sundials_nonlinearsolver.c sunmatrix/band/sunmatrix_band.c sunmatrix/dense/sunmatrix_dense.c sunlinsol/band/sunlinsol_band.c sunlinsol/dense/sunlinsol_dense.c sunnonlinsol/newton/sunnonlinsol_newton.c sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c #SUNDIALS_IDAS = idas/idas_io.c idas/idas_nls_sim.c idas/fmod/fidas_mod.c idas/idas_ls.c idas/idas_ic.c idas/idaa_io.c idas/idas_direct.c idas/idas_spils.c idas/idas_nls_stg.c idas/idas.c idas/idas_bbdpre.c idas/idas_nls.c idas/idaa.c SUNDIALS_IDAS = idas/idas_io.c idas/idas_nls_sim.c idas/idas_ls.c idas/idas_ic.c idas/idaa_io.c idas/idas_direct.c idas/idas_spils.c idas/idas_nls_stg.c idas/idas.c idas/idas_bbdpre.c idas/idas_nls.c idas/idaa.c #SUNDIALS_KINSOL = kinsol/kinsol.c kinsol/kinsol_io.c kinsol/kinsol_bbdpre.c kinsol/kinsol_spils.c kinsol/kinsol_ls.c kinsol/kinsol_direct.c SUNDIALS_KINSOL = SUNDIALS_NVECSERIAL = nvector/serial/nvector_serial.c SOURCES = $(SUNDIALS_CVODES) $(SUNDIALS_IDAS) $(SUNDIALS_KINSOL) $(SUNDIALS_NVECSERIAL) OBJECTS = $(SOURCES:.c=.o) static: $(OBJECTS) @mkdir -p ../lib $(AR) -rs ../lib/libStanHeaders.a $(OBJECTS) clean: rm -rf ../lib rm $(OBJECTS) StanHeaders/src/sunnonlinsol/0000755000176200001440000000000013766554135016022 5ustar liggesusersStanHeaders/src/sunnonlinsol/fixedpoint/0000755000176200001440000000000013766554456020201 5ustar liggesusersStanHeaders/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.h0000644000176200001440000000411613766554457025515 0ustar liggesusers/*----------------------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------------------- * This file contains the definitions needed for initialization of the * SUNNonlinearSolver fixed-point moudule operations in Fortran. *---------------------------------------------------------------------------*/ #ifndef _FSUNNONLINSOL_FIXEDPOINT_H #define _FSUNNONLINSOL_FIXEDPOINT_H #include /* FCMIX_* solver IDs */ #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNFIXEDPOINT_INIT SUNDIALS_F77_FUNC(fsunfixedpointinit, FSUNFIXEDPOINTINIT) #define FSUNFIXEDPOINT_SETMAXITERS SUNDIALS_F77_FUNC(fsunfixedpointsetmaxiters, FSUNFIXEDPOINTSETMAXITERS) #else #define FSUNFIXEDPOINT_INIT fsunfixedpointinit_ #define FSUNFIXEDPOINT_SETMAXITERS fsunfixedpointsetmaxiters_ #endif /* Declarations of global variables */ extern SUNNonlinearSolver F2C_CVODE_nonlinsol; extern SUNNonlinearSolver F2C_IDA_nonlinsol; extern SUNNonlinearSolver F2C_ARKODE_nonlinsol; /*----------------------------------------------------------------------------- Prototypes of exported functions FSUNFIXEDPOINT_INIT - initializes fixed point nonlinear solver for main problem FSUNFIXEDPOINT_SETMAXITERS - sets the maximum number of nonlinear iterations ---------------------------------------------------------------------------*/ void FSUNFIXEDPOINT_INIT(int *code, int *m, int *ier); void FSUNFIXEDPOINT_SETMAXITERS(int *code, int *maxiters, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.c0000644000176200001440000000523613766554457025514 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------------------- * This file contains the implementation of functions needed for initialization * of the SUNNonlinearSolver fixed point module operations in Fortran. *---------------------------------------------------------------------------*/ #include #include #include "fsunnonlinsol_fixedpoint.h" /* Define global nonlinsol variables */ SUNNonlinearSolver F2C_CVODE_nonlinsol; SUNNonlinearSolver F2C_IDA_nonlinsol; SUNNonlinearSolver F2C_ARKODE_nonlinsol; /* Declarations of external global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNFIXEDPOINT_INIT(int *code, int *m, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_nonlinsol) SUNNonlinSolFree(F2C_CVODE_nonlinsol); F2C_CVODE_nonlinsol = NULL; F2C_CVODE_nonlinsol = SUNNonlinSol_FixedPoint(F2C_CVODE_vec, *m); if (F2C_CVODE_nonlinsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_nonlinsol) SUNNonlinSolFree(F2C_IDA_nonlinsol); F2C_IDA_nonlinsol = NULL; F2C_IDA_nonlinsol = SUNNonlinSol_FixedPoint(F2C_IDA_vec, *m); if (F2C_IDA_nonlinsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_nonlinsol) SUNNonlinSolFree(F2C_ARKODE_nonlinsol); F2C_ARKODE_nonlinsol = NULL; F2C_ARKODE_nonlinsol = SUNNonlinSol_FixedPoint(F2C_ARKODE_vec, *m); if (F2C_ARKODE_nonlinsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNFIXEDPOINT_SETMAXITERS(int *code, int *maxiters, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_nonlinsol) { *ier = -1; return; } *ier = SUNNonlinSolSetMaxIters(F2C_CVODE_nonlinsol, *maxiters); break; case FCMIX_IDA: if (!F2C_IDA_nonlinsol) { *ier = -1; return; } *ier = SUNNonlinSolSetMaxIters(F2C_IDA_nonlinsol, *maxiters); break; case FCMIX_ARKODE: if (!F2C_ARKODE_nonlinsol) { *ier = -1; return; } *ier = SUNNonlinSolSetMaxIters(F2C_ARKODE_nonlinsol, *maxiters); break; default: *ier = -1; } } StanHeaders/src/sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c0000644000176200001440000005014113766554457025341 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This is the implementation file for the SUNNonlinearSolver module * implementation of the Anderson-accelerated Fixed-Point method. * ---------------------------------------------------------------------------*/ #include #include #include #include #include #include /* Internal utility routines */ static int AndersonAccelerate(SUNNonlinearSolver NLS, N_Vector gval, N_Vector x, N_Vector xold, int iter); static int AllocateContent(SUNNonlinearSolver NLS, N_Vector tmpl); static void FreeContent(SUNNonlinearSolver NLS); /* Content structure accessibility macros */ #define FP_CONTENT(S) ( (SUNNonlinearSolverContent_FixedPoint)(S->content) ) /* Constant macros */ #define ONE RCONST(1.0) #define ZERO RCONST(0.0) /*============================================================================== Constructor to create a new fixed point solver ============================================================================*/ SUNNonlinearSolver SUNNonlinSol_FixedPoint(N_Vector y, int m) { SUNNonlinearSolver NLS; SUNNonlinearSolver_Ops ops; SUNNonlinearSolverContent_FixedPoint content; int retval; /* Check that the supplied N_Vector is non-NULL */ if (y == NULL) return(NULL); /* Check that the supplied N_Vector supports all required operations */ if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || (y->ops->nvscale == NULL) || (y->ops->nvlinearsum == NULL) || (y->ops->nvdotprod == NULL) ) return(NULL); /* Create nonlinear linear solver */ NLS = NULL; NLS = (SUNNonlinearSolver) malloc(sizeof *NLS); if (NLS == NULL) return(NULL); /* Create nonlinear solver operations structure */ ops = NULL; ops = (SUNNonlinearSolver_Ops) malloc(sizeof *ops); if (ops == NULL) { free(NLS); return(NULL); } /* Create nonlinear solver content structure */ content = NULL; content = (SUNNonlinearSolverContent_FixedPoint) malloc(sizeof *content); if (content == NULL) { free(ops); free(NLS); return(NULL); } /* Attach content and ops */ NLS->content = content; NLS->ops = ops; /* Attach operations */ ops->gettype = SUNNonlinSolGetType_FixedPoint; ops->initialize = SUNNonlinSolInitialize_FixedPoint; ops->setup = NULL; /* no setup needed */ ops->solve = SUNNonlinSolSolve_FixedPoint; ops->free = SUNNonlinSolFree_FixedPoint; ops->setsysfn = SUNNonlinSolSetSysFn_FixedPoint; ops->setlsetupfn = NULL; /* no lsetup needed */ ops->setlsolvefn = NULL; /* no lsolve needed */ ops->setctestfn = SUNNonlinSolSetConvTestFn_FixedPoint; ops->setmaxiters = SUNNonlinSolSetMaxIters_FixedPoint; ops->getnumiters = SUNNonlinSolGetNumIters_FixedPoint; ops->getcuriter = SUNNonlinSolGetCurIter_FixedPoint; ops->getnumconvfails = SUNNonlinSolGetNumConvFails_FixedPoint; /* Initialize all components of content to 0/NULL */ memset(content, 0, sizeof(struct _SUNNonlinearSolverContent_FixedPoint)); /* Fill general content */ content->Sys = NULL; content->CTest = NULL; content->m = m; content->curiter = 0; content->maxiters = 3; content->niters = 0; content->nconvfails = 0; /* Fill allocatable content */ retval = AllocateContent(NLS, y); if (retval != SUN_NLS_SUCCESS) { NLS->content = NULL; NLS->ops = NULL; free(content); free(ops); free(NLS); return(NULL); } return(NLS); } /*============================================================================== Constructor wrapper to create a new fixed point solver for sensitivity solvers ============================================================================*/ SUNNonlinearSolver SUNNonlinSol_FixedPointSens(int count, N_Vector y, int m) { SUNNonlinearSolver NLS; N_Vector w; /* create sensitivity vector wrapper */ w = N_VNew_SensWrapper(count, y); /* create nonlinear solver using sensitivity vector wrapper */ NLS = SUNNonlinSol_FixedPoint(w, m); /* free sensitivity vector wrapper */ N_VDestroy(w); /* return NLS object */ return(NLS); } /*============================================================================== GetType, Initialize, Setup, Solve, and Free operations ============================================================================*/ SUNNonlinearSolver_Type SUNNonlinSolGetType_FixedPoint(SUNNonlinearSolver NLS) { return(SUNNONLINEARSOLVER_FIXEDPOINT); } int SUNNonlinSolInitialize_FixedPoint(SUNNonlinearSolver NLS) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that all required function pointers have been set */ if ( (FP_CONTENT(NLS)->Sys == NULL) || (FP_CONTENT(NLS)->CTest == NULL) ) return(SUN_NLS_MEM_NULL); /* reset the total number of iterations and convergence failures */ FP_CONTENT(NLS)->niters = 0; FP_CONTENT(NLS)->nconvfails = 0; return(SUN_NLS_SUCCESS); } /*----------------------------------------------------------------------------- SUNNonlinSolSolve_FixedPoint: Performs the fixed-point solve g(y) = y Successful solve return code: SUN_NLS_SUCCESS = 0 Recoverable failure return codes (positive): SUN_NLS_CONV_RECVR *_RHSFUNC_RECVR (ODEs) or *_RES_RECVR (DAEs) Unrecoverable failure return codes (negative): *_MEM_NULL *_RHSFUNC_FAIL (ODEs) or *_RES_FAIL (DAEs) Note that return values beginning with * are package specific values returned by the Sys function provided to the nonlinear solver. ---------------------------------------------------------------------------*/ int SUNNonlinSolSolve_FixedPoint(SUNNonlinearSolver NLS, N_Vector y0, N_Vector y, N_Vector w, realtype tol, booleantype callSetup, void* mem) { /* local variables */ int retval; N_Vector yprev, gy, delta; /* check that the inputs are non-null */ if ( (NLS == NULL) || (y0 == NULL) || (y == NULL) || (w == NULL) || (mem == NULL) ) return(SUN_NLS_MEM_NULL); /* set local shortcut variables */ yprev = FP_CONTENT(NLS)->yprev; gy = FP_CONTENT(NLS)->gy; delta = FP_CONTENT(NLS)->delta; /* load prediction into y */ N_VScale(ONE, y0, y); /* Looping point for attempts at solution of the nonlinear system: Evaluate fixed-point function (store in gy). Performs the accelerated fixed-point iteration. Performs stopping tests. */ for( FP_CONTENT(NLS)->curiter = 0; FP_CONTENT(NLS)->curiter < FP_CONTENT(NLS)->maxiters; FP_CONTENT(NLS)->curiter++ ) { /* update previous solution guess */ N_VScale(ONE, y, yprev); /* compute fixed-point iteration function, store in gy */ retval = FP_CONTENT(NLS)->Sys(y, gy, mem); if (retval != SUN_NLS_SUCCESS) break; /* perform fixed point update, based on choice of acceleration or not */ if (FP_CONTENT(NLS)->m == 0) { /* basic fixed-point solver */ N_VScale(ONE, gy, y); } else { /* Anderson-accelerated solver */ retval = AndersonAccelerate(NLS, gy, y, yprev, FP_CONTENT(NLS)->curiter); } /* increment nonlinear solver iteration counter */ FP_CONTENT(NLS)->niters++; /* compute change in solution, and call the convergence test function */ N_VLinearSum(ONE, y, -ONE, yprev, delta); /* test for convergence */ retval = FP_CONTENT(NLS)->CTest(NLS, y, delta, tol, w, mem); /* return if successful */ if (retval == SUN_NLS_SUCCESS) return(SUN_NLS_SUCCESS); /* check if the iterations should continue; otherwise increment the convergence failure count and return error flag */ if (retval != SUN_NLS_CONTINUE) { FP_CONTENT(NLS)->nconvfails++; return(retval); } } /* if we've reached this point, then we exhausted the iteration limit; increment the convergence failure count and return */ FP_CONTENT(NLS)->nconvfails++; return(SUN_NLS_CONV_RECVR); } int SUNNonlinSolFree_FixedPoint(SUNNonlinearSolver NLS) { /* return if NLS is already free */ if (NLS == NULL) return(SUN_NLS_SUCCESS); /* free items from content structure, then the structure itself */ if (NLS->content) { FreeContent(NLS); free(NLS->content); NLS->content = NULL; } /* free the ops structure */ if (NLS->ops) { free(NLS->ops); NLS->ops = NULL; } /* free the overall NLS structure */ free(NLS); return(SUN_NLS_SUCCESS); } /*============================================================================== Set functions ============================================================================*/ int SUNNonlinSolSetSysFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that the nonlinear system function is non-null */ if (SysFn == NULL) return(SUN_NLS_ILL_INPUT); FP_CONTENT(NLS)->Sys = SysFn; return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetConvTestFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolConvTestFn CTestFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that the convergence test function is non-null */ if (CTestFn == NULL) return(SUN_NLS_ILL_INPUT); FP_CONTENT(NLS)->CTest = CTestFn; return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetMaxIters_FixedPoint(SUNNonlinearSolver NLS, int maxiters) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that maxiters is a vaild */ if (maxiters < 1) return(SUN_NLS_ILL_INPUT); FP_CONTENT(NLS)->maxiters = maxiters; return(SUN_NLS_SUCCESS); } /*============================================================================== Get functions ============================================================================*/ int SUNNonlinSolGetNumIters_FixedPoint(SUNNonlinearSolver NLS, long int *niters) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the total number of nonlinear iterations */ *niters = FP_CONTENT(NLS)->niters; return(SUN_NLS_SUCCESS); } int SUNNonlinSolGetCurIter_FixedPoint(SUNNonlinearSolver NLS, int *iter) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the current nonlinear solver iteration count */ *iter = FP_CONTENT(NLS)->curiter; return(SUN_NLS_SUCCESS); } int SUNNonlinSolGetNumConvFails_FixedPoint(SUNNonlinearSolver NLS, long int *nconvfails) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the total number of nonlinear convergence failures */ *nconvfails = FP_CONTENT(NLS)->nconvfails; return(SUN_NLS_SUCCESS); } int SUNNonlinSolGetSysFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolSysFn *SysFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the nonlinear system defining function */ *SysFn = FP_CONTENT(NLS)->Sys; return(SUN_NLS_SUCCESS); } /*============================================================================= Utility routines ===========================================================================*/ /*--------------------------------------------------------------- AndersonAccelerate This routine computes the Anderson-accelerated fixed point iterate. Upon entry, the predicted solution is held in xold; this array is never changed throughout this routine. The result of the routine is held in x. Possible return values: SUN_NLS_MEM_NULL --> a required item was missing from memory SUN_NLS_SUCCESS --> successful completion -------------------------------------------------------------*/ static int AndersonAccelerate(SUNNonlinearSolver NLS, N_Vector gval, N_Vector x, N_Vector xold, int iter) { /* local variables */ int nvec, retval, i_pt, i, j, lAA, maa, *ipt_map; realtype a, b, rtemp, c, s, *cvals, *R, *gamma; N_Vector fv, vtemp, gold, fold, *df, *dg, *Q, *Xvecs; /* local shortcut variables */ vtemp = x; /* use result as temporary vector */ ipt_map = FP_CONTENT(NLS)->imap; maa = FP_CONTENT(NLS)->m; gold = FP_CONTENT(NLS)->gold; fold = FP_CONTENT(NLS)->fold; df = FP_CONTENT(NLS)->df; dg = FP_CONTENT(NLS)->dg; Q = FP_CONTENT(NLS)->q; cvals = FP_CONTENT(NLS)->cvals; Xvecs = FP_CONTENT(NLS)->Xvecs; R = FP_CONTENT(NLS)->R; gamma = FP_CONTENT(NLS)->gamma; fv = FP_CONTENT(NLS)->delta; /* reset ipt_map, i_pt */ for (i = 0; i < maa; i++) ipt_map[i]=0; i_pt = iter-1 - ((iter-1)/maa)*maa; /* update dg[i_pt], df[i_pt], fv, gold and fold*/ N_VLinearSum(ONE, gval, -ONE, xold, fv); if (iter > 0) { N_VLinearSum(ONE, gval, -ONE, gold, dg[i_pt]); /* dg_new = gval - gold */ N_VLinearSum(ONE, fv, -ONE, fold, df[i_pt]); /* df_new = fv - fold */ } N_VScale(ONE, gval, gold); N_VScale(ONE, fv, fold); /* on first iteration, just do basic fixed-point update */ if (iter == 0) { N_VScale(ONE, gval, x); return(SUN_NLS_SUCCESS); } /* update data structures based on current iteration index */ if (iter == 1) { /* second iteration */ R[0] = SUNRsqrt( N_VDotProd(df[i_pt], df[i_pt]) ); N_VScale(ONE/R[0], df[i_pt], Q[i_pt]); ipt_map[0] = 0; } else if (iter <= maa) { /* another iteration before we've reached maa */ N_VScale(ONE, df[i_pt], vtemp); for (j = 0; j < iter-1; j++) { ipt_map[j] = j; R[(iter-1)*maa+j] = N_VDotProd(Q[j], vtemp); N_VLinearSum(ONE, vtemp, -R[(iter-1)*maa+j], Q[j], vtemp); } R[(iter-1)*maa+iter-1] = SUNRsqrt( N_VDotProd(vtemp, vtemp) ); if (R[(iter-1)*maa+iter-1] == ZERO) { N_VScale(ZERO, vtemp, Q[i_pt]); } else { N_VScale((ONE/R[(iter-1)*maa+iter-1]), vtemp, Q[i_pt]); } ipt_map[iter-1] = iter-1; } else { /* we've filled the acceleration subspace, so start recycling */ /* delete left-most column vector from QR factorization */ for (i = 0; i < maa-1; i++) { a = R[(i+1)*maa + i]; b = R[(i+1)*maa + i+1]; rtemp = SUNRsqrt(a*a + b*b); c = a / rtemp; s = b / rtemp; R[(i+1)*maa + i] = rtemp; R[(i+1)*maa + i+1] = 0.0; if (i < maa-1) { for (j = i+2; j < maa; j++) { a = R[j*maa + i]; b = R[j*maa + i+1]; rtemp = c * a + s * b; R[j*maa + i+1] = -s*a + c*b; R[j*maa + i] = rtemp; } } N_VLinearSum(c, Q[i], s, Q[i+1], vtemp); N_VLinearSum(-s, Q[i], c, Q[i+1], Q[i+1]); N_VScale(ONE, vtemp, Q[i]); } /* ahift R to the left by one */ for (i = 1; i < maa; i++) for (j = 0; j < maa-1; j++) R[(i-1)*maa + j] = R[i*maa + j]; /* add the new df vector */ N_VScale(ONE, df[i_pt], vtemp); for (j = 0; j < maa-1; j++) { R[(maa-1)*maa+j] = N_VDotProd(Q[j], vtemp); N_VLinearSum(ONE, vtemp, -R[(maa-1)*maa+j], Q[j], vtemp); } R[(maa-1)*maa+maa-1] = SUNRsqrt( N_VDotProd(vtemp, vtemp) ); N_VScale((ONE/R[(maa-1)*maa+maa-1]), vtemp, Q[maa-1]); /* update the iteration map */ j = 0; for (i = i_pt+1; i < maa; i++) ipt_map[j++] = i; for (i = 0; i < i_pt+1; i++) ipt_map[j++] = i; } /* solve least squares problem and update solution */ lAA = iter; if (maa < iter) lAA = maa; retval = N_VDotProdMulti(lAA, fv, Q, gamma); if (retval != 0) return(SUN_NLS_VECTOROP_ERR); /* set arrays for fused vector operation */ cvals[0] = ONE; Xvecs[0] = gval; nvec = 1; for (i = lAA-1; i > -1; i--) { for (j = i+1; j < lAA; j++) gamma[i] -= R[j*maa+i]*gamma[j]; if (gamma[i] == ZERO) { gamma[i] = ZERO; } else { gamma[i] /= R[i*maa+i]; } cvals[nvec] = -gamma[i]; Xvecs[nvec] = dg[ipt_map[i]]; nvec += 1; } /* update solution */ retval = N_VLinearCombination(nvec, cvals, Xvecs, x); if (retval != 0) return(SUN_NLS_VECTOROP_ERR); return(SUN_NLS_SUCCESS); } static int AllocateContent(SUNNonlinearSolver NLS, N_Vector y) { int m = FP_CONTENT(NLS)->m; FP_CONTENT(NLS)->yprev = N_VClone(y); if (FP_CONTENT(NLS)->yprev == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->gy = N_VClone(y); if (FP_CONTENT(NLS)->gy == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->delta = N_VClone(y); if (FP_CONTENT(NLS)->delta == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } /* Allocate all m-dependent content */ if (m > 0) { FP_CONTENT(NLS)->fold = N_VClone(y); if (FP_CONTENT(NLS)->fold == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->gold = N_VClone(y); if (FP_CONTENT(NLS)->gold == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->imap = (int *) malloc(m * sizeof(int)); if (FP_CONTENT(NLS)->imap == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->R = (realtype *) malloc((m*m) * sizeof(realtype)); if (FP_CONTENT(NLS)->R == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->gamma = (realtype *) malloc(m * sizeof(realtype)); if (FP_CONTENT(NLS)->gamma == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->cvals = (realtype *) malloc((m+1) * sizeof(realtype)); if (FP_CONTENT(NLS)->cvals == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->df = N_VCloneVectorArray(m, y); if (FP_CONTENT(NLS)->df == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->dg = N_VCloneVectorArray(m, y); if (FP_CONTENT(NLS)->dg == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->q = N_VCloneVectorArray(m, y); if (FP_CONTENT(NLS)->q == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } FP_CONTENT(NLS)->Xvecs = (N_Vector *) malloc((m+1) * sizeof(N_Vector)); if (FP_CONTENT(NLS)->Xvecs == NULL) { FreeContent(NLS); return(SUN_NLS_MEM_FAIL); } } return(SUN_NLS_SUCCESS); } static void FreeContent(SUNNonlinearSolver NLS) { if (FP_CONTENT(NLS)->yprev) { N_VDestroy(FP_CONTENT(NLS)->yprev); FP_CONTENT(NLS)->yprev = NULL; } if (FP_CONTENT(NLS)->gy) { N_VDestroy(FP_CONTENT(NLS)->gy); FP_CONTENT(NLS)->gy = NULL; } if (FP_CONTENT(NLS)->fold) { N_VDestroy(FP_CONTENT(NLS)->fold); FP_CONTENT(NLS)->fold = NULL; } if (FP_CONTENT(NLS)->gold) { N_VDestroy(FP_CONTENT(NLS)->gold); FP_CONTENT(NLS)->gold = NULL; } if (FP_CONTENT(NLS)->delta) { N_VDestroy(FP_CONTENT(NLS)->delta); FP_CONTENT(NLS)->delta = NULL; } if (FP_CONTENT(NLS)->imap) { free(FP_CONTENT(NLS)->imap); FP_CONTENT(NLS)->imap = NULL; } if (FP_CONTENT(NLS)->R) { free(FP_CONTENT(NLS)->R); FP_CONTENT(NLS)->R = NULL; } if (FP_CONTENT(NLS)->gamma) { free(FP_CONTENT(NLS)->gamma); FP_CONTENT(NLS)->gamma = NULL; } if (FP_CONTENT(NLS)->cvals) { free(FP_CONTENT(NLS)->cvals); FP_CONTENT(NLS)->cvals = NULL; } if (FP_CONTENT(NLS)->df) { N_VDestroyVectorArray(FP_CONTENT(NLS)->df, FP_CONTENT(NLS)->m); FP_CONTENT(NLS)->df = NULL; } if (FP_CONTENT(NLS)->dg) { N_VDestroyVectorArray(FP_CONTENT(NLS)->dg, FP_CONTENT(NLS)->m); FP_CONTENT(NLS)->dg = NULL; } if (FP_CONTENT(NLS)->q) { N_VDestroyVectorArray(FP_CONTENT(NLS)->q, FP_CONTENT(NLS)->m); FP_CONTENT(NLS)->q = NULL; } if (FP_CONTENT(NLS)->Xvecs) { free(FP_CONTENT(NLS)->Xvecs); FP_CONTENT(NLS)->Xvecs = NULL; } return; } StanHeaders/src/sunnonlinsol/fixedpoint/F90/0000755000176200001440000000000013766554135020531 5ustar liggesusersStanHeaders/src/sunnonlinsol/fixedpoint/F90/fsunnonlinsol_fixedpoint.f900000644000176200001440000001302313766554457026217 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS fixed-point nonlinear solver using the ISO_C_BINDING ! module. ! ----------------------------------------------------------------- module fsunnonlinsol_fixedpoint_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNNonlinSol_FixedPoint(y, m) & bind(C,name='SUNNonlinSol_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y integer(c_int), value :: m end function FSUNNonlinSol_FixedPoint type(c_ptr) function FSUNNonlinSol_FixedPointSens(cnt, y, m) & bind(C,name='SUNNonlinSol_FixedPointSens') use, intrinsic :: iso_c_binding implicit none integer(c_int), value :: cnt type(c_ptr), value :: y integer(c_int), value :: m end function FSUNNonlinSol_FixedPointSens ! ================================================================= ! Destructors ! ================================================================= integer(c_int) function FSUNNonlinSolFree_FixedPoint(NLS) & bind(C,name='SUNNonlinSolFree_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS end function FSUNNonlinSolFree_FixedPoint ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNNonlinSolGetType_FixedPoint(NLS) & bind(C,name='SUNNonlinSolGetType_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS end function FSUNNonlinSolGetType_FixedPoint integer(c_int) function FSUNNonlinSolInitialize_FixedPoint(NLS) & bind(C,name='SUNNonlinSolInitialize_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS end function FSUNNonlinSolInitialize_FixedPoint integer(c_int) function FSUNNonlinSolSolve_FixedPoint(NLS, y0, y, w, tol, & callSetup, mem) & bind(C,name='SUNNonlinSolSolve_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_ptr), value :: y0 type(c_ptr), value :: y type(c_ptr), value :: w real(c_double), value :: tol integer(c_int), value :: callSetup type(c_ptr), value :: mem end function FSUNNonlinSolSolve_FixedPoint ! ================================================================= ! Set functions ! ================================================================= integer(c_int) function FSUNNonlinSolSetSysFn_FixedPoint(NLS, SysFn) & bind(C,name='SUNNonlinSolSetSysFn_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr), value :: SysFn end function FSUNNonlinSolSetSysFn_FixedPoint integer(c_int) function FSUNNonlinSolSetConvTestFn_FixedPoint(NLS, CTestFN) & bind(C,name='SUNNonlinSolSetConvTestFn_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr), value :: CTestFN end function FSUNNonlinSolSetConvTestFn_FixedPoint integer(c_int) function FSUNNonlinSolSetMaxIters_FixedPoint(NLS, maxiters) & bind(C,name='SUNNonlinSolSetMaxIters_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS integer(c_int), value :: maxiters end function FSUNNonlinSolSetMaxIters_FixedPoint ! ================================================================= ! Get functions ! ================================================================= integer(c_int) function FSUNNonlinSolGetNumIters_FixedPoint(NLS, niters) & bind(C,name='SUNNonlinSolGetNumIters_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS integer(c_long) :: niters end function FSUNNonlinSolGetNumIters_FixedPoint integer(c_int) function FSUNNonlinSolGetCurIter_FixedPoint(NLS, iter) & bind(C,name='SUNNonlinSolGetCurIter_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS integer(c_int) :: iter end function FSUNNonlinSolGetCurIter_FixedPoint integer(c_int) function FSUNNonlinSolGetSysFn_FixedPoint(NLS, SysFn) & bind(C,name='SUNNonlinSolGetSysFn_FixedPoint') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr) :: SysFn end function FSUNNonlinSolGetSysFn_FixedPoint end interface end module fsunnonlinsol_fixedpoint_mod StanHeaders/src/sunnonlinsol/newton/0000755000176200001440000000000013766554456017342 5ustar liggesusersStanHeaders/src/sunnonlinsol/newton/fsunnonlinsol_newton.c0000644000176200001440000000516013766554457024012 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This file contains the implementation of functions needed for initialization * of the SUNNonlinearSolver Newton moudule operations in Fortran. * ---------------------------------------------------------------------------*/ #include #include #include "fsunnonlinsol_newton.h" /* Define global nonlinsol variables */ SUNNonlinearSolver F2C_CVODE_nonlinsol; SUNNonlinearSolver F2C_IDA_nonlinsol; SUNNonlinearSolver F2C_ARKODE_nonlinsol; /* Declarations of external global variables */ extern N_Vector F2C_CVODE_vec; extern N_Vector F2C_IDA_vec; extern N_Vector F2C_ARKODE_vec; /* Fortran callable interfaces */ void FSUNNEWTON_INIT(int *code, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (F2C_CVODE_nonlinsol) SUNNonlinSolFree(F2C_CVODE_nonlinsol); F2C_CVODE_nonlinsol = NULL; F2C_CVODE_nonlinsol = SUNNonlinSol_Newton(F2C_CVODE_vec); if (F2C_CVODE_nonlinsol == NULL) *ier = -1; break; case FCMIX_IDA: if (F2C_IDA_nonlinsol) SUNNonlinSolFree(F2C_IDA_nonlinsol); F2C_IDA_nonlinsol = NULL; F2C_IDA_nonlinsol = SUNNonlinSol_Newton(F2C_IDA_vec); if (F2C_IDA_nonlinsol == NULL) *ier = -1; break; case FCMIX_ARKODE: if (F2C_ARKODE_nonlinsol) SUNNonlinSolFree(F2C_ARKODE_nonlinsol); F2C_ARKODE_nonlinsol = NULL; F2C_ARKODE_nonlinsol = SUNNonlinSol_Newton(F2C_ARKODE_vec); if (F2C_ARKODE_nonlinsol == NULL) *ier = -1; break; default: *ier = -1; } } void FSUNNEWTON_SETMAXITERS(int *code, int *maxiters, int *ier) { *ier = 0; switch(*code) { case FCMIX_CVODE: if (!F2C_CVODE_nonlinsol) { *ier = -1; return; } *ier = SUNNonlinSolSetMaxIters(F2C_CVODE_nonlinsol, *maxiters); break; case FCMIX_IDA: if (!F2C_IDA_nonlinsol) { *ier = -1; return; } *ier = SUNNonlinSolSetMaxIters(F2C_IDA_nonlinsol, *maxiters); break; case FCMIX_ARKODE: if (!F2C_ARKODE_nonlinsol) { *ier = -1; return; } *ier = SUNNonlinSolSetMaxIters(F2C_ARKODE_nonlinsol, *maxiters); break; default: *ier = -1; } } StanHeaders/src/sunnonlinsol/newton/sunnonlinsol_newton.c0000644000176200001440000003242113766554457023644 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This is the implementation file for the SUNNonlinearSolver module * implementation of Newton's method. * ---------------------------------------------------------------------------*/ #include #include #include #include #include #include /* Content structure accessibility macros */ #define NEWTON_CONTENT(S) ( (SUNNonlinearSolverContent_Newton)(S->content) ) /* Constant macros */ #define ONE RCONST(1.0) /* real 1.0 */ /*============================================================================== Constructor to create a new Newton solver ============================================================================*/ SUNNonlinearSolver SUNNonlinSol_Newton(N_Vector y) { SUNNonlinearSolver NLS; SUNNonlinearSolver_Ops ops; SUNNonlinearSolverContent_Newton content; /* Check that the supplied N_Vector is non-NULL */ if (y == NULL) return(NULL); /* Check that the supplied N_Vector supports all required operations */ if ( (y->ops->nvclone == NULL) || (y->ops->nvdestroy == NULL) || (y->ops->nvscale == NULL) || (y->ops->nvlinearsum == NULL) ) return(NULL); /* Create nonlinear linear solver */ NLS = NULL; NLS = (SUNNonlinearSolver) malloc(sizeof *NLS); if (NLS == NULL) return(NULL); /* Create linear solver operation structure */ ops = NULL; ops = (SUNNonlinearSolver_Ops) malloc(sizeof *ops); if (ops == NULL) { free(NLS); return(NULL); } /* Attach operations */ ops->gettype = SUNNonlinSolGetType_Newton; ops->initialize = SUNNonlinSolInitialize_Newton; ops->setup = NULL; /* no setup needed */ ops->solve = SUNNonlinSolSolve_Newton; ops->free = SUNNonlinSolFree_Newton; ops->setsysfn = SUNNonlinSolSetSysFn_Newton; ops->setlsetupfn = SUNNonlinSolSetLSetupFn_Newton; ops->setlsolvefn = SUNNonlinSolSetLSolveFn_Newton; ops->setctestfn = SUNNonlinSolSetConvTestFn_Newton; ops->setmaxiters = SUNNonlinSolSetMaxIters_Newton; ops->getnumiters = SUNNonlinSolGetNumIters_Newton; ops->getcuriter = SUNNonlinSolGetCurIter_Newton; ops->getnumconvfails = SUNNonlinSolGetNumConvFails_Newton; /* Create content */ content = NULL; content = (SUNNonlinearSolverContent_Newton) malloc(sizeof *content); if (content == NULL) { free(ops); free(NLS); return(NULL); } /* Initialize all components of content to 0/NULL */ memset(content, 0, sizeof(struct _SUNNonlinearSolverContent_Newton)); /* Fill content */ content->Sys = NULL; content->LSetup = NULL; content->LSolve = NULL; content->CTest = NULL; content->delta = N_VClone(y); content->jcur = SUNFALSE; content->curiter = 0; content->maxiters = 3; content->niters = 0; content->nconvfails = 0; /* check if clone was successful */ if (content->delta == NULL) { free(ops); free(NLS); return(NULL); } /* Attach content and ops */ NLS->content = content; NLS->ops = ops; return(NLS); } /*============================================================================== Constructor wrapper to create a new Newton solver for sensitivity solvers ============================================================================*/ SUNNonlinearSolver SUNNonlinSol_NewtonSens(int count, N_Vector y) { SUNNonlinearSolver NLS; N_Vector w; /* create sensitivity vector wrapper */ w = N_VNew_SensWrapper(count, y); /* create nonlinear solver using sensitivity vector wrapper */ NLS = SUNNonlinSol_Newton(w); /* free sensitivity vector wrapper */ N_VDestroy(w); /* return NLS object */ return(NLS); } /*============================================================================== GetType, Initialize, Setup, Solve, and Free operations ============================================================================*/ SUNNonlinearSolver_Type SUNNonlinSolGetType_Newton(SUNNonlinearSolver NLS) { return(SUNNONLINEARSOLVER_ROOTFIND); } int SUNNonlinSolInitialize_Newton(SUNNonlinearSolver NLS) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that all required function pointers have been set */ if ( (NEWTON_CONTENT(NLS)->Sys == NULL) || (NEWTON_CONTENT(NLS)->LSolve == NULL) || (NEWTON_CONTENT(NLS)->CTest == NULL) ) { return(SUN_NLS_MEM_NULL); } /* reset the total number of iterations and convergence failures */ NEWTON_CONTENT(NLS)->niters = 0; NEWTON_CONTENT(NLS)->nconvfails = 0; /* reset the Jacobian status */ NEWTON_CONTENT(NLS)->jcur = SUNFALSE; return(SUN_NLS_SUCCESS); } /*------------------------------------------------------------------------------ SUNNonlinSolSolve_Newton: Performs the nonlinear solve F(y) = 0 Successful solve return code: SUN_NLS_SUCCESS = 0 Recoverable failure return codes (positive): SUN_NLS_CONV_RECVR *_RHSFUNC_RECVR (ODEs) or *_RES_RECVR (DAEs) *_LSETUP_RECVR *_LSOLVE_RECVR Unrecoverable failure return codes (negative): *_MEM_NULL *_RHSFUNC_FAIL (ODEs) or *_RES_FAIL (DAEs) *_LSETUP_FAIL *_LSOLVE_FAIL Note return values beginning with * are package specific values returned by the Sys, LSetup, and LSolve functions provided to the nonlinear solver. ----------------------------------------------------------------------------*/ int SUNNonlinSolSolve_Newton(SUNNonlinearSolver NLS, N_Vector y0, N_Vector y, N_Vector w, realtype tol, booleantype callLSetup, void* mem) { /* local variables */ int retval; booleantype jbad; N_Vector delta; /* check that the inputs are non-null */ if ( (NLS == NULL) || (y0 == NULL) || (y == NULL) || (w == NULL) || (mem == NULL) ) return(SUN_NLS_MEM_NULL); /* set local shortcut variables */ delta = NEWTON_CONTENT(NLS)->delta; /* assume the Jacobian is good */ jbad = SUNFALSE; /* looping point for attempts at solution of the nonlinear system: Evaluate the nonlinear residual function (store in delta) Setup the linear solver if necessary Preform Newton iteraion */ for(;;) { /* compute the nonlinear residual, store in delta */ retval = NEWTON_CONTENT(NLS)->Sys(y0, delta, mem); if (retval != SUN_NLS_SUCCESS) break; /* if indicated, setup the linear system */ if (callLSetup) { retval = NEWTON_CONTENT(NLS)->LSetup(y0, delta, jbad, &(NEWTON_CONTENT(NLS)->jcur), mem); if (retval != SUN_NLS_SUCCESS) break; } /* initialize counter curiter */ NEWTON_CONTENT(NLS)->curiter = 0; /* load prediction into y */ N_VScale(ONE, y0, y); /* looping point for Newton iteration. Break out on any error. */ for(;;) { /* increment nonlinear solver iteration counter */ NEWTON_CONTENT(NLS)->niters++; /* compute the negative of the residual for the linear system rhs */ N_VScale(-ONE, delta, delta); /* solve the linear system to get Newton update delta */ retval = NEWTON_CONTENT(NLS)->LSolve(y, delta, mem); if (retval != SUN_NLS_SUCCESS) break; /* update the Newton iterate */ N_VLinearSum(ONE, y, ONE, delta, y); /* test for convergence */ retval = NEWTON_CONTENT(NLS)->CTest(NLS, y, delta, tol, w, mem); /* if successful update Jacobian status and return */ if (retval == SUN_NLS_SUCCESS) { NEWTON_CONTENT(NLS)->jcur = SUNFALSE; return(SUN_NLS_SUCCESS); } /* check if the iteration should continue; otherwise exit Newton loop */ if (retval != SUN_NLS_CONTINUE) break; /* not yet converged. Increment curiter and test for max allowed. */ NEWTON_CONTENT(NLS)->curiter++; if (NEWTON_CONTENT(NLS)->curiter >= NEWTON_CONTENT(NLS)->maxiters) { retval = SUN_NLS_CONV_RECVR; break; } /* compute the nonlinear residual, store in delta */ retval = NEWTON_CONTENT(NLS)->Sys(y, delta, mem); if (retval != SUN_NLS_SUCCESS) break; } /* end of Newton iteration loop */ /* all errors go here */ /* If there is a recoverable convergence failure and the Jacobian-related data appears not to be current, increment the convergence failure count and loop again with a call to lsetup in which jbad is TRUE. Otherwise break out and return. */ if ((retval > 0) && !(NEWTON_CONTENT(NLS)->jcur) && (NEWTON_CONTENT(NLS)->LSetup)) { NEWTON_CONTENT(NLS)->nconvfails++; callLSetup = SUNTRUE; jbad = SUNTRUE; continue; } else { break; } } /* end of setup loop */ /* increment number of convergence failures */ NEWTON_CONTENT(NLS)->nconvfails++; /* all error returns exit here */ return(retval); } int SUNNonlinSolFree_Newton(SUNNonlinearSolver NLS) { /* return if NLS is already free */ if (NLS == NULL) return(SUN_NLS_SUCCESS); /* free items from contents, then the generic structure */ if (NLS->content) { if (NEWTON_CONTENT(NLS)->delta) N_VDestroy(NEWTON_CONTENT(NLS)->delta); NEWTON_CONTENT(NLS)->delta = NULL; free(NLS->content); NLS->content = NULL; } /* free the ops structure */ if (NLS->ops) { free(NLS->ops); NLS->ops = NULL; } /* free the nonlinear solver */ free(NLS); return(SUN_NLS_SUCCESS); } /*============================================================================== Set functions ============================================================================*/ int SUNNonlinSolSetSysFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that the nonlinear system function is non-null */ if (SysFn == NULL) return(SUN_NLS_ILL_INPUT); NEWTON_CONTENT(NLS)->Sys = SysFn; return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetLSetupFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolLSetupFn LSetupFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); NEWTON_CONTENT(NLS)->LSetup = LSetupFn; return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetLSolveFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolLSolveFn LSolveFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that the linear solver solve function is non-null */ if (LSolveFn == NULL) return(SUN_NLS_ILL_INPUT); NEWTON_CONTENT(NLS)->LSolve = LSolveFn; return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetConvTestFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolConvTestFn CTestFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that the convergence test function is non-null */ if (CTestFn == NULL) return(SUN_NLS_ILL_INPUT); NEWTON_CONTENT(NLS)->CTest = CTestFn; return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetMaxIters_Newton(SUNNonlinearSolver NLS, int maxiters) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* check that maxiters is a vaild */ if (maxiters < 1) return(SUN_NLS_ILL_INPUT); NEWTON_CONTENT(NLS)->maxiters = maxiters; return(SUN_NLS_SUCCESS); } /*============================================================================== Get functions ============================================================================*/ int SUNNonlinSolGetNumIters_Newton(SUNNonlinearSolver NLS, long int *niters) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the total number of nonlinear iterations */ *niters = NEWTON_CONTENT(NLS)->niters; return(SUN_NLS_SUCCESS); } int SUNNonlinSolGetCurIter_Newton(SUNNonlinearSolver NLS, int *iter) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the current nonlinear solver iteration count */ *iter = NEWTON_CONTENT(NLS)->curiter; return(SUN_NLS_SUCCESS); } int SUNNonlinSolGetNumConvFails_Newton(SUNNonlinearSolver NLS, long int *nconvfails) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the total number of nonlinear convergence failures */ *nconvfails = NEWTON_CONTENT(NLS)->nconvfails; return(SUN_NLS_SUCCESS); } int SUNNonlinSolGetSysFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolSysFn *SysFn) { /* check that the nonlinear solver is non-null */ if (NLS == NULL) return(SUN_NLS_MEM_NULL); /* return the nonlinear system defining function */ *SysFn = NEWTON_CONTENT(NLS)->Sys; return(SUN_NLS_SUCCESS); } StanHeaders/src/sunnonlinsol/newton/F90/0000755000176200001440000000000013766554135017672 5ustar liggesusersStanHeaders/src/sunnonlinsol/newton/F90/fsunnonlinsol_newton.f900000644000176200001440000001365613766554457024535 0ustar liggesusers! ----------------------------------------------------------------- ! Programmer(s): Cody J. Balos @ LLNL ! ----------------------------------------------------------------- ! SUNDIALS Copyright Start ! Copyright (c) 2002-2019, Lawrence Livermore National Security ! and Southern Methodist University. ! All rights reserved. ! ! See the top-level LICENSE and NOTICE files for details. ! ! SPDX-License-Identifier: BSD-3-Clause ! SUNDIALS Copyright End ! ----------------------------------------------------------------- ! This file contains a Fortran module for interfacing directly with ! the SUNDIALS Newton iteration nonlinear solver using the ! ISO_C_BINDING module. ! ----------------------------------------------------------------- module fsunnonlinsol_newton_mod !======= Interfaces ========= interface ! ================================================================= ! Constructors ! ================================================================= type(c_ptr) function FSUNNonlinSol_Newton(y) & bind(C,name='SUNNonlinSol_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: y end function FSUNNonlinSol_Newton type(c_ptr) function FSUNNonlinSol_NewtonSens(cnt, y) & bind(C,name='SUNNonlinSol_NewtonSens') use, intrinsic :: iso_c_binding implicit none integer(c_int), value :: cnt type(c_ptr), value :: y end function FSUNNonlinSol_NewtonSens ! ================================================================= ! Destructors ! ================================================================= integer(c_int) function FSUNNonlinSolFree_Newton(NLS) & bind(C,name='SUNNonlinSolFree_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS end function FSUNNonlinSolFree_Newton ! ================================================================= ! Operations ! ================================================================= integer(c_int) function FSUNNonlinSolGetType_Newton(NLS) & bind(C,name='SUNNonlinSolGetType_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS end function FSUNNonlinSolGetType_Newton integer(c_int) function FSUNNonlinSolInitialize_Newton(NLS) & bind(C,name='SUNNonlinSolInitialize_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS end function FSUNNonlinSolInitialize_Newton integer(c_int) function FSUNNonlinSolSolve_Newton(NLS, y0, y, w, tol, & callSetup, mem) & bind(C,name='SUNNonlinSolSolve_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_ptr), value :: y0 type(c_ptr), value :: y type(c_ptr), value :: w real(c_double), value :: tol integer(c_int), value :: callSetup type(c_ptr), value :: mem end function FSUNNonlinSolSolve_Newton ! ================================================================= ! Set functions ! ================================================================= integer(c_int) function FSUNNonlinSolSetSysFn_Newton(NLS, SysFn) & bind(C,name='SUNNonlinSolSetSysFn_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr), value :: SysFn end function FSUNNonlinSolSetSysFn_Newton integer(c_int) function FSUNNonlinSolSetLSetupFn_Newton(NLS, LSetupFn) & bind(C,name='SUNNonlinSolSetLSetupFn_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr), value :: LSetupFn end function FSUNNonlinSolSetLSetupFn_Newton integer(c_int) function FSUNNonlinSolSetLSolveFn_Newton(NLS, LSolveFn) & bind(C,name='SUNNonlinSolSetLSolveFn_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr), value :: LSolveFn end function FSUNNonlinSolSetLSolveFn_Newton integer(c_int) function FSUNNonlinSolSetConvTestFn_Newton(NLS, CTestFN) & bind(C,name='SUNNonlinSolSetConvTestFn_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr), value :: CTestFN end function FSUNNonlinSolSetConvTestFn_Newton integer(c_int) function FSUNNonlinSolSetMaxIters_Newton(NLS, maxiters) & bind(C,name='SUNNonlinSolSetMaxIters_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS integer(c_int), value :: maxiters end function FSUNNonlinSolSetMaxIters_Newton ! ================================================================= ! Get functions ! ================================================================= integer(c_int) function FSUNNonlinSolGetNumIters_Newton(NLS, niters) & bind(C,name='SUNNonlinSolGetNumIters_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS integer(c_long) :: niters end function FSUNNonlinSolGetNumIters_Newton integer(c_int) function FSUNNonlinSolGetCurIter_Newton(NLS, iter) & bind(C,name='SUNNonlinSolGetCurIter_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS integer(c_int) :: iter end function FSUNNonlinSolGetCurIter_Newton integer(c_int) function FSUNNonlinSolGetSysFn_Newton(NLS, SysFn) & bind(C,name='SUNNonlinSolGetSysFn_Newton') use, intrinsic :: iso_c_binding implicit none type(c_ptr), value :: NLS type(c_funptr) :: SysFn end function FSUNNonlinSolGetSysFn_Newton end interface end module fsunnonlinsol_newton_mod StanHeaders/src/sunnonlinsol/newton/fsunnonlinsol_newton.h0000644000176200001440000000400313766554457024012 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This file contains the definitions needed for initialization of the * SUNNonlinearSolver Newton moudule operations in Fortran. * ---------------------------------------------------------------------------*/ #ifndef _FSUNNONLINSOL_NEWTON_H #define _FSUNNONLINSOL_NEWTON_H #include /* FCMIX_* solver IDs */ #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif #if defined(SUNDIALS_F77_FUNC) #define FSUNNEWTON_INIT SUNDIALS_F77_FUNC(fsunnewtoninit, FSUNNEWTONINIT) #define FSUNNEWTON_SETMAXITERS SUNDIALS_F77_FUNC(fsunnewtonsetmaxiters, FSUNNEWTONSETMAXITERS) #else #define FSUNNEWTON_INIT fsunnewtoninit_ #define FSUNNEWTON_SETMAXITERS fsunnewtonsetmaxiters_ #endif /* Declarations of global variables */ extern SUNNonlinearSolver F2C_CVODE_nonlinsol; extern SUNNonlinearSolver F2C_IDA_nonlinsol; extern SUNNonlinearSolver F2C_ARKODE_nonlinsol; /* ----------------------------------------------------------------------------- * Prototypes of exported functions * * FSUNNEWTON_INIT - initializes Newton nonlinear solver for main problem * FSUNNEWTON_SETMAXITERS - sets the maximum number of nonlinear iterations * ---------------------------------------------------------------------------*/ void FSUNNEWTON_INIT(int *code, int *ier); void FSUNNEWTON_SETMAXITERS(int *code, int *maxiters, int *ier); #ifdef __cplusplus } #endif #endif StanHeaders/src/Makevars.win0000644000176200001440000000131113663726316015543 0ustar liggesusersPKG_CPPFLAGS=-DNO_FPRINTF_OUTPUT -I"../inst/include" -include stan_sundials_printf_override.hpp SUNDIALS_CVODES := \ $(wildcard cvodes/*.c) \ $(wildcard sundials/*.c) \ $(wildcard sunmatrix/band/[^f]*.c) \ $(wildcard sunmatrix/dense/[^f]*.c) \ $(wildcard sunlinsol/band/[^f]*.c) \ $(wildcard sunlinsol/dense/[^f]*.c) \ $(wildcard sunnonlinsol/newton/[^f]*.c) \ $(wildcard sunnonlinsol/fixedpoint/[^f]*.c) SUNDIALS_IDAS := \ $(wildcard idas/*.c) SUNDIALS_KINSOL := $(patsubst %.c,%.o, \ $(wildcard $(SUNDIALS)/src/kinsol/[^f]*.c)) SUNDIALS_NVECSERIAL := nvector/serial/nvector_serial.c SOURCES = $(SUNDIALS_CVODES) $(SUNDIALS_IDAS) $(SUNDIALS_NVECSERIAL) init.c OBJECTS = $(SOURCES:.c=.o) StanHeaders/src/idas/0000755000176200001440000000000013766554456014207 5ustar liggesusersStanHeaders/src/idas/idas_io.c0000644000176200001440000013536713766554457016002 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the optional inputs and * outputs for the IDAS solver. * ----------------------------------------------------------------- */ #include #include #include "idas_impl.h" #include #include #define ZERO RCONST(0.0) #define HALF RCONST(0.5) #define ONE RCONST(1.0) #define TWOPT5 RCONST(2.5) /* * ================================================================= * IDA optional input functions * ================================================================= */ int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetErrHandlerFn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_ehfun = ehfun; IDA_mem->ida_eh_data = eh_data; return(IDA_SUCCESS); } int IDASetErrFile(void *ida_mem, FILE *errfp) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetErrFile", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_errfp = errfp; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetUserData(void *ida_mem, void *user_data) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetUserData", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_user_data = user_data; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxOrd(void *ida_mem, int maxord) { IDAMem IDA_mem; int maxord_alloc; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxOrd", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxord <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxOrd", MSG_NEG_MAXORD); return(IDA_ILL_INPUT); } /* Cannot increase maximum order beyond the value that was used when allocating memory */ maxord_alloc = IDA_mem->ida_maxord_alloc; if (maxord > maxord_alloc) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxOrd", MSG_BAD_MAXORD); return(IDA_ILL_INPUT); } IDA_mem->ida_maxord = SUNMIN(maxord,MAXORD_DEFAULT); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumSteps(void *ida_mem, long int mxsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Passing mxsteps=0 sets the default. Passing mxsteps<0 disables the test. */ if (mxsteps == 0) IDA_mem->ida_mxstep = MXSTEP_DEFAULT; else IDA_mem->ida_mxstep = mxsteps; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetInitStep(void *ida_mem, realtype hin) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetInitStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_hin = hin; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxStep(void *ida_mem, realtype hmax) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (hmax < 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxStep", MSG_NEG_HMAX); return(IDA_ILL_INPUT); } /* Passing 0 sets hmax = infinity */ if (hmax == ZERO) { IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; return(IDA_SUCCESS); } IDA_mem->ida_hmax_inv = ONE/hmax; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetStopTime(void *ida_mem, realtype tstop) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetStopTime", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* If IDASolve was called at least once, test if tstop is legal * (i.e. if it was not already passed). * If IDASetStopTime is called before the first call to IDASolve, * tstop will be checked in IDASolve. */ if (IDA_mem->ida_nst > 0) { if ( (tstop - IDA_mem->ida_tn) * IDA_mem->ida_hh < ZERO ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetStopTime", MSG_BAD_TSTOP, tstop, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } } IDA_mem->ida_tstop = tstop; IDA_mem->ida_tstopset = SUNTRUE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetNonlinConvCoef(void *ida_mem, realtype epcon) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinConvCoef", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (epcon <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinConvCoef", MSG_NEG_EPCON); return(IDA_ILL_INPUT); } IDA_mem->ida_epcon = epcon; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxErrTestFails(void *ida_mem, int maxnef) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxErrTestFails", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxnef = maxnef; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxConvFails(void *ida_mem, int maxncf) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxConvFails", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_maxncf = maxncf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNonlinIters(void *ida_mem, int maxcor) { IDAMem IDA_mem; booleantype sensi_sim; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNonlinIters", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Are we computing sensitivities with the simultaneous approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); if (sensi_sim) { /* check that the NLS is non-NULL */ if (IDA_mem->NLSsim == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDASetMaxNonlinIters", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(IDA_mem->NLSsim, maxcor)); } else { /* check that the NLS is non-NULL */ if (IDA_mem->NLS == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDASetMaxNonlinIters", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(IDA_mem->NLS, maxcor)); } } /*-----------------------------------------------------------------*/ int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSuppressAlg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_suppressalg = suppressalg; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetId(void *ida_mem, N_Vector id) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetId", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (id == NULL) { if (IDA_mem->ida_idMallocDone) { N_VDestroy(IDA_mem->ida_id); IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; IDA_mem->ida_liw -= IDA_mem->ida_liw1; } IDA_mem->ida_idMallocDone = SUNFALSE; return(IDA_SUCCESS); } if ( !(IDA_mem->ida_idMallocDone) ) { IDA_mem->ida_id = N_VClone(id); IDA_mem->ida_lrw += IDA_mem->ida_lrw1; IDA_mem->ida_liw += IDA_mem->ida_liw1; IDA_mem->ida_idMallocDone = SUNTRUE; } /* Load the id vector */ N_VScale(ONE, id, IDA_mem->ida_id); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetConstraints(void *ida_mem, N_Vector constraints) { IDAMem IDA_mem; realtype temptest; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetConstraints", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (constraints == NULL) { if (IDA_mem->ida_constraintsMallocDone) { N_VDestroy(IDA_mem->ida_constraints); IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; IDA_mem->ida_liw -= IDA_mem->ida_liw1; } IDA_mem->ida_constraintsMallocDone = SUNFALSE; IDA_mem->ida_constraintsSet = SUNFALSE; return(IDA_SUCCESS); } /* Test if required vector ops. are defined */ if (constraints->ops->nvdiv == NULL || constraints->ops->nvmaxnorm == NULL || constraints->ops->nvcompare == NULL || constraints->ops->nvconstrmask == NULL || constraints->ops->nvminquotient == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetConstraints", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Check the constraints vector */ temptest = N_VMaxNorm(constraints); if((temptest > TWOPT5) || (temptest < HALF)){ IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetConstraints", MSG_BAD_CONSTR); return(IDA_ILL_INPUT); } if ( !(IDA_mem->ida_constraintsMallocDone) ) { IDA_mem->ida_constraints = N_VClone(constraints); IDA_mem->ida_lrw += IDA_mem->ida_lrw1; IDA_mem->ida_liw += IDA_mem->ida_liw1; IDA_mem->ida_constraintsMallocDone = SUNTRUE; } /* Load the constraints vector */ N_VScale(ONE, constraints, IDA_mem->ida_constraints); IDA_mem->ida_constraintsSet = SUNTRUE; return(IDA_SUCCESS); } /* * IDASetRootDirection * * Specifies the direction of zero-crossings to be monitored. * The default is to monitor both crossings. */ int IDASetRootDirection(void *ida_mem, int *rootdir) { IDAMem IDA_mem; int i, nrt; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetRootDirection", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = IDA_mem->ida_nrtfn; if (nrt==0) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDASetRootDirection", MSG_NO_ROOT); return(IDA_ILL_INPUT); } for(i=0; iida_rootdir[i] = rootdir[i]; return(IDA_SUCCESS); } /* * IDASetNoInactiveRootWarn * * Disables issuing a warning if some root function appears * to be identically zero at the beginning of the integration */ int IDASetNoInactiveRootWarn(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNoInactiveRootWarn", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_mxgnull = 0; return(IDA_SUCCESS); } /* * ================================================================= * IDA IC optional input functions * ================================================================= */ int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinConvCoefIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (epiccon <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinConvCoefIC", MSG_BAD_EPICCON); return(IDA_ILL_INPUT); } IDA_mem->ida_epiccon = epiccon; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumStepsIC(void *ida_mem, int maxnh) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumStepsIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnh <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxNumStepsIC", MSG_BAD_MAXNH); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnh = maxnh; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumJacsIC(void *ida_mem, int maxnj) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumJacsIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnj <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxNumJacsIC", MSG_BAD_MAXNJ); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnj = maxnj; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxNumItersIC(void *ida_mem, int maxnit) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetMaxNumItersIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxnit <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetMaxNumItersIC", MSG_BAD_MAXNIT); return(IDA_ILL_INPUT); } IDA_mem->ida_maxnit = maxnit; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetMaxBacksIC(void *ida_mem, int maxbacks) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASetMaxBacksIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (maxbacks <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASetMaxBacksIC", MSG_IC_BAD_MAXBACKS); return(IDA_ILL_INPUT); } IDA_mem->ida_maxbacks = maxbacks; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetLineSearchOffIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_lsoff = lsoff; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetStepToleranceIC(void *ida_mem, realtype steptol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetStepToleranceIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (steptol <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetStepToleranceIC", MSG_BAD_STEPTOL); return(IDA_ILL_INPUT); } IDA_mem->ida_steptol = steptol; return(IDA_SUCCESS); } /* * ================================================================= * Quadrature optional input functions * ================================================================= */ /*-----------------------------------------------------------------*/ int IDASetQuadErrCon(void *ida_mem, booleantype errconQ) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetQuadErrCon", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadMallocDone == SUNFALSE) { IDAProcessError(NULL, IDA_NO_QUAD, "IDAS", "IDASetQuadErrCon", MSG_NO_QUAD); return(IDA_NO_QUAD); } IDA_mem->ida_errconQ = errconQ; return (IDA_SUCCESS); } /* * ================================================================= * FSA optional input functions * ================================================================= */ int IDASetSensDQMethod(void *ida_mem, int DQtype, realtype DQrhomax) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensDQMethod", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if ( (DQtype != IDA_CENTERED) && (DQtype != IDA_FORWARD) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetSensDQMethod", MSG_BAD_DQTYPE); return(IDA_ILL_INPUT); } if (DQrhomax < ZERO ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetSensDQMethod", MSG_BAD_DQRHO); return(IDA_ILL_INPUT); } IDA_mem->ida_DQtype = DQtype; IDA_mem->ida_DQrhomax = DQrhomax; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSensErrCon(void *ida_mem, booleantype errconS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensErrCon", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_errconS = errconS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDASetSensMaxNonlinIters(void *ida_mem, int maxcorS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensMaxNonlinIters", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* check that the NLS is non-NULL */ if (IDA_mem->NLSstg == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDASetSensMaxNonlinIters", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } return(SUNNonlinSolSetMaxIters(IDA_mem->NLSstg, maxcorS)); } /*-----------------------------------------------------------------*/ int IDASetSensParams(void *ida_mem, realtype *p, realtype *pbar, int *plist) { IDAMem IDA_mem; int Ns, is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetSensParams", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASetSensParams", MSG_NO_SENSI); return(IDA_NO_SENS); } Ns = IDA_mem->ida_Ns; /* Parameters */ IDA_mem->ida_p = p; /* pbar */ if (pbar != NULL) for (is=0; isida_pbar[is] = SUNRabs(pbar[is]); } else for (is=0; isida_pbar[is] = ONE; /* plist */ if (plist != NULL) for (is=0; isida_plist[is] = plist[is]; } else for (is=0; isida_plist[is] = is; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Function: IDASetQuadSensErrCon * ----------------------------------------------------------------- * IDASetQuadSensErrCon specifies if quadrature sensitivity variables * are considered or not in the error control. * ----------------------------------------------------------------- */ int IDASetQuadSensErrCon(void *ida_mem, booleantype errconQS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetQuadSensErrCon", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASetQuadSensErrCon", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was quadrature sensitivity initialized? */ if (IDA_mem->ida_quadSensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDASetQuadSensErrCon", MSG_NO_SENSI); return(IDA_NO_QUADSENS); } IDA_mem->ida_errconQS = errconQS; return(IDA_SUCCESS); } /* * ================================================================= * IDA optional output functions * ================================================================= */ int IDAGetNumSteps(void *ida_mem, long int *nsteps) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumSteps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nsteps = IDA_mem->ida_nst; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumResEvals(void *ida_mem, long int *nrevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumResEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nrevals = IDA_mem->ida_nre; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumLinSolvSetups", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nlinsetups = IDA_mem->ida_nsetups; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumErrTestFails(void *ida_mem, long int *netfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *netfails = IDA_mem->ida_netf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktracks) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumBacktrackOps", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nbacktracks = IDA_mem->ida_nbacktr; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetConsistentIC(void *ida_mem, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetConsistentIC", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_kused != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAGetConsistentIC", MSG_TOO_LATE); return(IDA_ILL_INPUT); } if(yy0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[0], yy0); if(yp0 != NULL) N_VScale(ONE, IDA_mem->ida_phi[1], yp0); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetLastOrder(void *ida_mem, int *klast) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetLastOrder", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *klast = IDA_mem->ida_kused; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentOrder(void *ida_mem, int *kcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetCurrentOrder", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *kcur = IDA_mem->ida_kk; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetActualInitStep(void *ida_mem, realtype *hinused) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetActualInitStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hinused = IDA_mem->ida_h0u; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetLastStep(void *ida_mem, realtype *hlast) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetLastStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hlast = IDA_mem->ida_hused; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentStep(void *ida_mem, realtype *hcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetCurrentStep", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *hcur = IDA_mem->ida_hh; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetCurrentTime(void *ida_mem, realtype *tcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetCurrentTime", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *tcur = IDA_mem->ida_tn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetTolScaleFactor", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *tolsfact = IDA_mem->ida_tolsf; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetErrWeights(void *ida_mem, N_Vector eweight) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetErrWeights", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; N_VScale(ONE, IDA_mem->ida_ewt, eweight); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetEstLocalErrors", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; N_VScale(ONE, IDA_mem->ida_ee, ele); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetWorkSpace", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *leniw = IDA_mem->ida_liw; *lenrw = IDA_mem->ida_lrw; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, long int *nlinsetups, long int *netfails, int *klast, int *kcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetIntegratorStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nsteps = IDA_mem->ida_nst; *nrevals = IDA_mem->ida_nre; *nlinsetups = IDA_mem->ida_nsetups; *netfails = IDA_mem->ida_netf; *klast = IDA_mem->ida_kused; *kcur = IDA_mem->ida_kk; *hinused = IDA_mem->ida_h0u; *hlast = IDA_mem->ida_hused; *hcur = IDA_mem->ida_hh; *tcur = IDA_mem->ida_tn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumGEvals(void *ida_mem, long int *ngevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumGEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *ngevals = IDA_mem->ida_nge; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetRootInfo(void *ida_mem, int *rootsfound) { IDAMem IDA_mem; int i, nrt; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetRootInfo", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = IDA_mem->ida_nrtfn; for (i=0; iida_iroots[i]; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters) { IDAMem IDA_mem; long int nls_iters; booleantype sensi_sim; int retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumNonlinSolvIters", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* get number of iterations for IC calc */ *nniters = IDA_mem->ida_nni; /* are we computing sensitivities with the simultaneous approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); /* get number of iterations from the NLS */ if (sensi_sim) { /* check that the NLS is non-NULL */ if (IDA_mem->NLSsim == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAGetNumNonlinSolvIters", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } retval = SUNNonlinSolGetNumIters(IDA_mem->NLSsim, &nls_iters); if (retval != IDA_SUCCESS) return(retval); } else { /* check that the NLS is non-NULL */ if (IDA_mem->NLS == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAGetNumNonlinSolvIters", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } retval = SUNNonlinSolGetNumIters(IDA_mem->NLS, &nls_iters); if (retval != IDA_SUCCESS) return(retval); } /* update the number of nonlinear iterations */ *nniters += nls_iters; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumNonlinSolvConvFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nncfails = IDA_mem->ida_ncfn; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, long int *nncfails) { IDAMem IDA_mem; long int nls_iters; booleantype sensi_sim; int retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNonlinSolvStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *nniters = IDA_mem->ida_nni; *nncfails = IDA_mem->ida_ncfn; /* Are we computing sensitivities with the simultaneous approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); /* get number of iterations from NLS */ if (sensi_sim) { if (IDA_mem->NLSsim == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAGetNonlinSolvStats", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } retval = SUNNonlinSolGetNumIters(IDA_mem->NLSsim, &nls_iters); if (retval != IDA_SUCCESS) return(retval); } else { if (IDA_mem->NLS == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAGetNonlinSolvStats", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } retval = SUNNonlinSolGetNumIters(IDA_mem->NLS, &nls_iters); if (retval != IDA_SUCCESS) return(retval); } /* update the number of nonlinear iterations */ *nniters += nls_iters; return(IDA_SUCCESS); } /* * ================================================================= * Quadrature optional output functions * ================================================================= */ /*-----------------------------------------------------------------*/ int IDAGetQuadNumRhsEvals(void *ida_mem, long int *nrQevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadNumRhsEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadNumRhsEvals", MSG_NO_QUAD); return(IDA_NO_QUAD); } *nrQevals = IDA_mem->ida_nrQe; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadNumErrTestFails(void *ida_mem, long int *nQetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadNumErrTestFails", MSG_NO_QUAD); return(IDA_NO_QUAD); } *nQetfails = IDA_mem->ida_netfQ; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadErrWeights(void *ida_mem, N_Vector eQweight) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadErrWeights", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadErrWeights", MSG_NO_QUAD); return(IDA_NO_QUAD); } if(IDA_mem->ida_errconQ) N_VScale(ONE, IDA_mem->ida_ewtQ, eQweight); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadStats(void *ida_mem, long int *nrQevals, long int *nQetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadStats", MSG_NO_QUAD); return(IDA_NO_QUAD); } *nrQevals = IDA_mem->ida_nrQe; *nQetfails = IDA_mem->ida_netfQ; return(IDA_SUCCESS); } /* * ================================================================= * Quadrature FSA optional output functions * ================================================================= */ /*-----------------------------------------------------------------*/ int IDAGetQuadSensNumRhsEvals(void *ida_mem, long int *nrhsQSevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensNumRhsEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr_sensi == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensNumRhsEvals", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } *nrhsQSevals = IDA_mem->ida_nrQSe; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadSensNumErrTestFails(void *ida_mem, long int *nQSetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr_sensi == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensNumErrTestFails", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } *nQSetfails = IDA_mem->ida_netfQS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadSensErrWeights(void *ida_mem, N_Vector *eQSweight) { IDAMem IDA_mem; int is, Ns; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensErrWeights", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr_sensi == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensErrWeights", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } Ns = IDA_mem->ida_Ns; if (IDA_mem->ida_errconQS) for (is=0; isida_ewtQS[is], eQSweight[is]); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetQuadSensStats(void *ida_mem, long int *nrhsQSevals, long int *nQSetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadr_sensi == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensStats", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } *nrhsQSevals = IDA_mem->ida_nrQSe; *nQSetfails = IDA_mem->ida_netfQS; return(IDA_SUCCESS); } /* * ================================================================= * FSA optional output functions * ================================================================= */ /*-----------------------------------------------------------------*/ int IDAGetSensConsistentIC(void *ida_mem, N_Vector *yyS0, N_Vector *ypS0) { IDAMem IDA_mem; int is; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensConsistentIC", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensConsistentIC", MSG_NO_SENSI); return(IDA_NO_SENS); } if (IDA_mem->ida_kused != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAGetSensConsistentIC", MSG_TOO_LATE); return(IDA_ILL_INPUT); } if(yyS0 != NULL) { for (is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_phiS[0][is], yyS0[is]); } if(ypS0 != NULL) { for (is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_phiS[1][is], ypS0[is]); } return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumResEvals(void *ida_mem, long int *nrSevals) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGeSensNumResEvals", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumResEvals", MSG_NO_SENSI); return(IDA_NO_SENS); } *nrSevals = IDA_mem->ida_nrSe; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetNumResEvalsSens(void *ida_mem, long int *nrevalsS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetNumResEvalsSens", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetNumResEvalsSens", MSG_NO_SENSI); return(IDA_NO_SENS); } *nrevalsS = IDA_mem->ida_nreS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumErrTestFails(void *ida_mem, long int *nSetfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNumErrTestFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumErrTestFails", MSG_NO_SENSI); return(IDA_NO_SENS); } *nSetfails = IDA_mem->ida_netfS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumLinSolvSetups(void *ida_mem, long int *nlinsetupsS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNumLinSolvSetups", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumLinSolvSetups", MSG_NO_SENSI); return(IDA_NO_SENS); } *nlinsetupsS = IDA_mem->ida_nsetupsS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensErrWeights(void *ida_mem, N_Vector_S eSweight) { IDAMem IDA_mem; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensErrWeights", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensErrWeights", MSG_NO_SENSI); return(IDA_NO_SENS); } for (is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_ewtS[is], eSweight[is]); return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensStats(void *ida_mem, long int *nrSevals, long int *nrevalsS, long int *nSetfails, long int *nlinsetupsS) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensStats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensStats", MSG_NO_SENSI); return(IDA_NO_SENS); } *nrSevals = IDA_mem->ida_nrSe; *nrevalsS = IDA_mem->ida_nreS; *nSetfails = IDA_mem->ida_netfS; *nlinsetupsS = IDA_mem->ida_nsetupsS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumNonlinSolvIters(void *ida_mem, long int *nSniters) { IDAMem IDA_mem; long int nls_iters; int retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNumNonlinSolvIters", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumNonlinSolvIters", MSG_NO_SENSI); return(IDA_NO_SENS); } *nSniters = IDA_mem->ida_nniS; /* check that the NLS is non-NULL */ if (IDA_mem->NLSstg == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAGetSensNumNonlinSolvIters", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* get number of iterations from the NLS */ retval = SUNNonlinSolGetNumIters(IDA_mem->NLSstg, &nls_iters); if (retval != IDA_SUCCESS) return(retval); /* update the number of nonlinear iterations */ *nSniters += nls_iters; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNumNonlinSolvConvFails(void *ida_mem, long int *nSncfails) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNumNonlinSolvConvFails", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNumNonlinSolvConvFails", MSG_NO_SENSI); return(IDA_NO_SENS); } *nSncfails = IDA_mem->ida_ncfnS; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ int IDAGetSensNonlinSolvStats(void *ida_mem, long int *nSniters, long int *nSncfails) { IDAMem IDA_mem; long int nls_iters; int retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensNonlinSolvstats", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensNonlinSolvStats", MSG_NO_SENSI); return(IDA_NO_SENS); } *nSniters = IDA_mem->ida_nniS; *nSncfails = IDA_mem->ida_ncfnS; /* check that the NLS is non-NULL */ if (IDA_mem->NLSstg == NULL) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAGetSensNumNonlinSolvStats", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* get number of iterations from the NLS */ retval = SUNNonlinSolGetNumIters(IDA_mem->NLSstg, &nls_iters); if (retval != IDA_SUCCESS) return(retval); /* update the number of nonlinear iterations */ *nSniters += nls_iters; return(IDA_SUCCESS); } /* * ================================================================= * IDAGetReturnFlagName * ================================================================= */ char *IDAGetReturnFlagName(long int flag) { char *name; name = (char *)malloc(24*sizeof(char)); switch(flag) { case IDA_SUCCESS: sprintf(name,"IDA_SUCCESS"); break; case IDA_TSTOP_RETURN: sprintf(name,"IDA_TSTOP_RETURN"); break; case IDA_ROOT_RETURN: sprintf(name,"IDA_ROOT_RETURN"); break; case IDA_TOO_MUCH_WORK: sprintf(name,"IDA_TOO_MUCH_WORK"); break; case IDA_TOO_MUCH_ACC: sprintf(name,"IDA_TOO_MUCH_ACC"); break; case IDA_ERR_FAIL: sprintf(name,"IDA_ERR_FAIL"); break; case IDA_CONV_FAIL: sprintf(name,"IDA_CONV_FAIL"); break; case IDA_LINIT_FAIL: sprintf(name,"IDA_LINIT_FAIL"); break; case IDA_LSETUP_FAIL: sprintf(name,"IDA_LSETUP_FAIL"); break; case IDA_LSOLVE_FAIL: sprintf(name,"IDA_LSOLVE_FAIL"); break; case IDA_CONSTR_FAIL: sprintf(name,"IDA_CONSTR_FAIL"); break; case IDA_RES_FAIL: sprintf(name,"IDA_RES_FAIL"); break; case IDA_FIRST_RES_FAIL: sprintf(name,"IDA_FIRST_RES_FAIL"); break; case IDA_REP_RES_ERR: sprintf(name,"IDA_REP_RES_ERR"); break; case IDA_RTFUNC_FAIL: sprintf(name,"IDA_RTFUNC_FAIL"); break; case IDA_MEM_FAIL: sprintf(name,"IDA_MEM_FAIL"); break; case IDA_MEM_NULL: sprintf(name,"IDA_MEM_NULL"); break; case IDA_ILL_INPUT: sprintf(name,"IDA_ILL_INPUT"); break; case IDA_NO_MALLOC: sprintf(name,"IDA_NO_MALLOC"); break; case IDA_BAD_T: sprintf(name,"IDA_BAD_T"); break; case IDA_BAD_K: sprintf(name,"IDA_BAD_K"); break; case IDA_BAD_DKY: sprintf(name,"IDA_BAD_DKY"); break; case IDA_BAD_EWT: sprintf(name,"IDA_BAD_EWT"); break; case IDA_NO_RECOVERY: sprintf(name,"IDA_NO_RECOVERY"); break; case IDA_LINESEARCH_FAIL: sprintf(name,"IDA_LINESEARCH_FAIL"); break; case IDA_NO_SENS: sprintf(name,"IDA_NO_SENS"); break; case IDA_SRES_FAIL: sprintf(name, "IDA_SRES_FAIL"); break; case IDA_REP_SRES_ERR: sprintf(name, "IDA_REP_SRES_ERR"); break; case IDA_BAD_IS: sprintf(name,"IDA_BAD_IS"); break; case IDA_NO_QUAD: sprintf(name,"IDA_NO_QUAD"); break; case IDA_NO_QUADSENS: sprintf(name, "IDA_NO_QUADSENS"); break; case IDA_QSRHS_FAIL: sprintf(name, "IDA_QSRHS_FAIL"); break; /* IDAA flags follow below. */ case IDA_NO_ADJ: sprintf(name, "IDA_NO_ADJ"); break; case IDA_BAD_TB0: sprintf(name, "IDA_BAD_TB0"); break; case IDA_REIFWD_FAIL: sprintf(name, "IDA_REIFWD_FAIL"); break; case IDA_FWD_FAIL: sprintf(name, "IDA_FWD_FAIL"); break; case IDA_GETY_BADT: sprintf(name, "IDA_GETY_BADT"); break; case IDA_NO_BCK: sprintf(name, "IDA_NO_BCK"); break; case IDA_NO_FWD: sprintf(name,"IDA_NO_FWD"); break; default: sprintf(name,"NONE"); } return(name); } StanHeaders/src/idas/idaa_io.c0000644000176200001440000005270413766554457015751 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Radu Serban and Cosmin Petra @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the optional input and output * functions for the adjoint module in the IDAS solver. * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include "idas_impl.h" #include /* * ================================================================= * IDAA PRIVATE CONSTANTS * ================================================================= */ #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Optional input functions for ASA * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * IDAAdjSetNoSensi * ----------------------------------------------------------------- * Disables the forward sensitivity analysis in IDASolveF. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAAdjSetNoSensi(void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAAdjSetNoSensi", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAAdjSetNoSensi", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; IDAADJ_mem->ia_storeSensi = SUNFALSE; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Optional input functions for backward integration * ----------------------------------------------------------------- */ int IDASetNonlinearSolverB(void *ida_mem, int which, SUNNonlinearSolver NLS) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Check if ida_mem exists */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetNonlinearSolverB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetNonlinearSolverB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetNonlinearSolverB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which' */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if ( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) (IDAB_mem->IDA_mem); return(IDASetNonlinearSolver(ida_memB, NLS)); } int IDASetUserDataB(void *ida_mem, int which, void *user_dataB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetUserDataB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetUserDataB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetUserDataB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Set user data for this backward problem. */ IDAB_mem->ida_user_data = user_dataB; return(IDA_SUCCESS); } int IDASetMaxOrdB(void *ida_mem, int which, int maxordB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetMaxOrdB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetMaxOrdB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetMaxOrdB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetMaxOrd(ida_memB, maxordB); } int IDASetMaxNumStepsB(void *ida_mem, int which, long int mxstepsB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetMaxNumStepsB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetMaxNumStepsB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetMaxNumStepsB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetMaxNumSteps(ida_memB, mxstepsB); } int IDASetInitStepB(void *ida_mem, int which, realtype hinB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetInitStepB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetInitStepB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetInitStepB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetInitStep(ida_memB, hinB); } int IDASetMaxStepB(void *ida_mem, int which, realtype hmaxB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetMaxStepB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetMaxStepB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetMaxStepB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetMaxStep(ida_memB, hmaxB); } int IDASetSuppressAlgB(void *ida_mem, int which, booleantype suppressalgB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetSuppressAlgB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetSuppressAlgB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetSuppressAlgB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetSuppressAlg(ida_memB, suppressalgB); } int IDASetIdB(void *ida_mem, int which, N_Vector idB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetIdB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetIdB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetIdB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetId(ida_memB, idB); } int IDASetConstraintsB(void *ida_mem, int which, N_Vector constraintsB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetConstraintsB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetConstraintsB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetConstraintsB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetConstraints(ida_memB, constraintsB); } /* * ---------------------------------------------------------------- * Input quadrature functions for ASA * ---------------------------------------------------------------- */ int IDASetQuadErrConB(void *ida_mem, int which, int errconQB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASetQuadErrConB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASetQuadErrConB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASetQuadErrConB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDASetQuadErrCon(ida_memB, errconQB); } /* * ----------------------------------------------------------------- * Optional output functions for backward integration * ----------------------------------------------------------------- */ /* * IDAGetAdjIDABmem * * This function returns a (void *) pointer to the IDAS * memory allocated for the backward problem. This pointer can * then be used to call any of the IDAGet* IDAS routines to * extract optional output for the backward integration phase. */ SUNDIALS_EXPORT void *IDAGetAdjIDABmem(void *ida_mem, int which) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, 0, "IDAA", "IDAGetAdjIDABmem", MSGAM_NULL_IDAMEM); return(NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, 0, "IDAA", "IDAGetAdjIDABmem", MSGAM_NO_ADJ); return(NULL); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, 0, "IDAA", "IDAGetAdjIDABmem", MSGAM_BAD_WHICH); return(NULL); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return(ida_memB); } /* * IDAGetAdjCheckPointsInfo * * Loads an array of nckpnts structures of type IDAadjCheckPointRec * defined below. * * The user must allocate space for ckpnt (ncheck+1). */ int IDAGetAdjCheckPointsInfo(void *ida_mem, IDAadjCheckPointRec *ckpnt) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; CkpntMem ck_mem; int i; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjCheckPointsInfo", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjCheckPointsInfo", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; i=0; ck_mem = IDAADJ_mem->ck_mem; while (ck_mem != NULL) { ckpnt[i].my_addr = (void *) ck_mem; ckpnt[i].next_addr = (void *) ck_mem->ck_next; ckpnt[i].t0 = ck_mem->ck_t0; ckpnt[i].t1 = ck_mem->ck_t1; ckpnt[i].nstep = ck_mem->ck_nst; ckpnt[i].order = ck_mem->ck_kk; ckpnt[i].step = ck_mem->ck_hh; ck_mem = ck_mem->ck_next; i++; } return(IDA_SUCCESS); } /* IDAGetConsistentICB * * Returns the consistent initial conditions computed by IDACalcICB or * IDACalcICBS * * It must be preceded by a successful call to IDACalcICB or IDACalcICBS * for 'which' backward problem. */ int IDAGetConsistentICB(void *ida_mem, int which, N_Vector yyB0_mod, N_Vector ypB0_mod) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetConsistentICB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetConsistentICB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetConsistentICB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; flag = IDAGetConsistentIC(ida_memB, yyB0_mod, ypB0_mod); return(flag); } /* * ----------------------------------------------------------------- * Undocumented development user-callable functions * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * IDAGetAdjDataPointHermite * ----------------------------------------------------------------- * Returns the 2 vectors stored for cubic Hermite interpolation at * the data point 'which'. The user must allocate space for yy and * yd. * * Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if the * interpolation type previously specified is not IDA_HERMITE or * IDA_SUCCESS otherwise. * */ int IDAGetAdjDataPointHermite(void *ida_mem, int which, realtype *t, N_Vector yy, N_Vector yd) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjDataPointHermite", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjDataPointHermite", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; if (IDAADJ_mem->ia_interpType != IDA_HERMITE) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetAdjDataPointHermite", MSGAM_WRONG_INTERP); return(IDA_ILL_INPUT); } *t = dt_mem[which]->t; content = (HermiteDataMem) dt_mem[which]->content; if (yy != NULL) N_VScale(ONE, content->y, yy); if (yd != NULL) N_VScale(ONE, content->yd, yd); return(IDA_SUCCESS); } /* * IDAGetAdjDataPointPolynomial * * Returns the vector stored for polynomial interpolation at the * data point 'which'. The user must allocate space for y. * * Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if the * interpolation type previously specified is not IDA_POLYNOMIAL or * IDA_SUCCESS otherwise. */ int IDAGetAdjDataPointPolynomial(void *ida_mem, int which, realtype *t, int *order, N_Vector y) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjDataPointPolynomial", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjDataPointPolynomial", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; if (IDAADJ_mem->ia_interpType != IDA_POLYNOMIAL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetAdjDataPointPolynomial", MSGAM_WRONG_INTERP); return(IDA_ILL_INPUT); } *t = dt_mem[which]->t; content = (PolynomialDataMem) dt_mem[which]->content; if (y != NULL) N_VScale(ONE, content->y, y); *order = content->order; return(IDA_SUCCESS); } /* * IDAGetAdjCurrentCheckPoint * * Returns the address of the 'active' check point. */ SUNDIALS_EXPORT int IDAGetAdjCurrentCheckPoint(void *ida_mem, void **addr) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjCurrentCheckPoint", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetAdjCurrentCheckPoint", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; *addr = (void *) IDAADJ_mem->ia_ckpntData; return(IDA_SUCCESS); } StanHeaders/src/idas/README0000644000176200001440000000646013766554457015076 0ustar liggesusers IDAS Release 3.1.0, Feb 2019 Radu Serban Center for Applied Scientific Computing, LLNL IDAS is a package for the solution of differential-algebraic equation (DAE) systems with sensitivity analysis capabilities (both forward and adjoint modes). It is written in ANSI standard C. IDAS can be used both on serial and parallel computers. The main difference is in the NVECTOR module of vector kernels. The desired version is obtained when compiling the example files by linking the appropriate library of NVECTOR kernels. In the parallel versions, communication between processors is done with MPI, with OpenMP, or with Pthreads. When used with the serial NVECTOR module, IDAS provides both direct (dense and band) linear solvers and preconditioned Krylov (iterative) linear solvers. Three different iterative solvers are available: scaled preconditioned GMRES (SPGMR), scaled preconditioned BiCGStab (SPBCG), and scaled preconditioned TFQMR (SPTFQMR). When IDAS is used with the parallel NVECTOR module, only the Krylov linear solvers are available. For the latter case, in addition to the basic solver, the IDA package also contains a preconditioner module called IDABBDPRE, which provides a band-block-diagonal preconditioner. IDAS is part of a software family called SUNDIALS: SUite of Nonlinear and DIfferential/ALgebraic equation Solvers [3]. This suite consists of CVODE, CVODES, ARkode, IDA, IDAS, and KINSOL. The directory structure of the package supplied reflects this family relationship. Several examples problem programs are included, covering both serial and parallel cases, both small and large problem sizes, and both linear and nonlinear problems. The notes below provide the location of documentation, directions for the installation of the IDAS package, and relevant references. Following that is a brief history of revisions to the package. A. Documentation ---------------- /sundials/doc/idas/ contains PDF files for the IDAS User Guide [1] (idas_guide.pdf) and the IDAS Examples [2] (idas_examples.pdf) documents. B. Installation --------------- For basic installation instructions see the file /sundials/INSTALL_GUIDE.pdf. For complete installation instructions see the "Installation Procedure" chapter in the IDAS User Guide. C. References ------------- [1] R. Serban, C. Petra,and A. C. Hindmarsh, "User Documentation for IDAS v1.3.0," LLNL technical report UCRL-SM-234051, March 2016. [2] R. Serban and A.C. Hindmarsh, "Example Programs for IDAS v1.3.0," LLNL technical report LLNL-TR-437091, March 2016. [3] A. C. Hindmarsh, P. N. Brown, K. E. Grant, S. L. Lee, R. Serban, D. E. Shumaker, and C. S. Woodward, "SUNDIALS, Suite of Nonlinear and Differential/Algebraic Equation Solvers," ACM Trans. Math. Softw., 31(3), pp. 363-396, 2005. D. Releases ----------- v. 3.1.0 - Feb. 2019 v. 3.0.2 - Jan. 2019 v. 3.0.1 - Dec. 2018 v. 3.0.0 - Dec. 2018 v. 2.2.1 - Oct. 2018 v. 2.2.0 - Sep. 2018 v. 2.1.2 - Jul. 2018 v. 2.1.1 - May 2018 v. 2.1.0 - Nov. 2017 v. 2.0.0 - Sep. 2017 v. 1.3.0 - Sep. 2016 v. 1.2.2 - Aug. 2015 v. 1.2.1 - Mar. 2015 v. 1.2.0 - Mar. 2015 v. 1.1.0 - Mar. 2012 v. 1.0.0 - May 2009 StanHeaders/src/idas/idas.c0000644000176200001440000071412513766554457015306 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the main IDAS solver. * It is independent of the linear solver in use. * ----------------------------------------------------------------- * * EXPORTED FUNCTIONS * ------------------ * Creation, allocation and re-initialization functions * IDACreate * IDAInit * IDAReInit * IDAQuadInit * IDAQuadReInit * IDAQuadSStolerances * IDAQuadSVtolerances * IDASensInit * IDASensReInit * IDASensToggleOff * IDASensSStolerances * IDASensSVtolerances * IDASensEEtolerances * IDAQuadSensInit * IDAQuadSensReInit * IDARootInit * * Main solver function * IDASolve * * Interpolated output and extraction functions * IDAGetDky * IDAGetQuad * IDAGetQuadDky * IDAGetSens * IDAGetSens1 * IDAGetSensDky * IDAGetSensDky1 * * Deallocation functions * IDAFree * IDAQuadFree * IDASensFree * IDAQuadSensFree * * PRIVATE FUNCTIONS * ----------------- * IDACheckNvector * Memory allocation/deallocation * IDAAllocVectors * IDAFreeVectors * IDAQuadAllocVectors * IDAQuadFreeVectors * IDASensAllocVectors * IDASensFreeVectors * IDAQuadSensAllocVectors * IDAQuadSensFreeVectors * Initial setup * IDAInitialSetup * IDAEwtSet * IDAEwtSetSS * IDAEwtSetSV * IDAQuadEwtSet * IDAQuadEwtSetSS * IDAQuadEwtSetSV * IDASensEwtSet * IDASensEwtSetEE * IDASensEwtSetSS * IDASensEwtSetSV * IDAQuadSensEwtSet * IDAQuadSensEwtSetEE * IDAQuadSensEwtSetSS * IDAQuadSensEwtSetSV * Stopping tests * IDAStopTest1 * IDAStopTest2 * Error handler * IDAHandleFailure * Main IDAStep function * IDAStep * IDASetCoeffs * Nonlinear solver functions * IDANls * IDAPredict * IDAQuadNls * IDAQuadSensNls * IDAQuadPredict * IDAQuadSensPredict * IDASensNls * IDASensPredict * Error test * IDATestError * IDAQuadTestError * IDASensTestError * IDAQuadSensTestError * IDARestore * Handler for convergence and/or error test failures * IDAHandleNFlag * IDAReset * Function called after a successful step * IDACompleteStep * Get solution * IDAGetSolution * Norm functions * IDAWrmsNorm * IDASensWrmsNorm * IDAQuadSensWrmsNorm * IDAQuadWrmsNormUpdate * IDASensWrmsNormUpdate * IDAQuadSensWrmsNormUpdate * Functions for rootfinding * IDARcheck1 * IDARcheck2 * IDARcheck3 * IDARootfind * IDA Error message handling functions * IDAProcessError * IDAErrHandler * Internal DQ approximations for sensitivity RHS * IDASensResDQ * IDASensRes1DQ * IDAQuadSensResDQ * IDAQuadSensRes1DQ * ----------------------------------------------------------------- */ /* * ================================================================= * IMPORTED HEADER FILES * ================================================================= */ #include #include #include #include #include "idas_impl.h" #include #include #include #include /* * ================================================================= * IDAS PRIVATE CONSTANTS * ================================================================= */ #define ZERO RCONST(0.0) /* real 0.0 */ #define HALF RCONST(0.5) /* real 0.5 */ #define QUARTER RCONST(0.25) /* real 0.25 */ #define TWOTHIRDS RCONST(0.667) /* real 2/3 */ #define ONE RCONST(1.0) /* real 1.0 */ #define ONEPT5 RCONST(1.5) /* real 1.5 */ #define TWO RCONST(2.0) /* real 2.0 */ #define FOUR RCONST(4.0) /* real 4.0 */ #define FIVE RCONST(5.0) /* real 5.0 */ #define TEN RCONST(10.0) /* real 10.0 */ #define TWELVE RCONST(12.0) /* real 12.0 */ #define TWENTY RCONST(20.0) /* real 20.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define PT9 RCONST(0.9) /* real 0.9 */ #define PT99 RCONST(0.99) /* real 0.99 */ #define PT1 RCONST(0.1) /* real 0.1 */ #define PT01 RCONST(0.01) /* real 0.01 */ #define PT001 RCONST(0.001) /* real 0.001 */ #define PT0001 RCONST(0.0001) /* real 0.0001 */ /* * ================================================================= * IDAS ROUTINE-SPECIFIC CONSTANTS * ================================================================= */ /* * Control constants for lower-level functions used by IDASolve * ------------------------------------------------------------ */ /* IDAStep control constants */ #define PREDICT_AGAIN 20 /* Return values for lower level routines used by IDASolve */ #define CONTINUE_STEPS +99 /* IDACompleteStep constants */ #define UNSET -1 #define LOWER 1 #define RAISE 2 #define MAINTAIN 3 /* IDATestError constants */ #define ERROR_TEST_FAIL +7 /* * Control constants for lower-level rootfinding functions * ------------------------------------------------------- */ #define RTFOUND 1 #define CLOSERT 3 /* * Control constants for sensitivity DQ * ------------------------------------ */ #define CENTERED1 +1 #define CENTERED2 +2 #define FORWARD1 +3 #define FORWARD2 +4 /* * Algorithmic constants * --------------------- */ #define MXNCF 10 /* max number of convergence failures allowed */ #define MXNEF 10 /* max number of error test failures allowed */ #define MAXNH 5 /* max. number of h tries in IC calc. */ #define MAXNJ 4 /* max. number of J tries in IC calc. */ #define MAXNI 10 /* max. Newton iterations in IC calc. */ #define EPCON RCONST(0.33) /* Newton convergence test constant */ #define MAXBACKS 100 /* max backtracks per Newton step in IDACalcIC */ /* IDANewtonIter constants */ #define MAXIT 4 #define XRATE RCONST(0.25) /* constant for updating Jacobian/preconditioner */ /* * ================================================================= * PRIVATE FUNCTION PROTOTYPES * ================================================================= */ static booleantype IDACheckNvector(N_Vector tmpl); /* Memory allocation/deallocation */ static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDAFreeVectors(IDAMem IDA_mem); static booleantype IDAQuadAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDAQuadFreeVectors(IDAMem IDA_mem); static booleantype IDASensAllocVectors(IDAMem IDA_mem, N_Vector tmpl); static void IDASensFreeVectors(IDAMem IDA_mem); static booleantype IDAQuadSensAllocVectors(IDAMem ida_mem, N_Vector tmpl); static void IDAQuadSensFreeVectors(IDAMem ida_mem); /* Initial setup */ int IDAInitialSetup(IDAMem IDA_mem); static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight); static int IDAQuadEwtSet(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ); static int IDAQuadEwtSetSS(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ); static int IDAQuadEwtSetSV(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ); /* Used in IC for sensitivities. */ int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDASensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDASensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDASensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); int IDAQuadSensEwtSet(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS); static int IDAQuadSensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDAQuadSensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDAQuadSensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); /* Main IDAStep function */ static int IDAStep(IDAMem IDA_mem); /* Function called at beginning of step */ static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck); /* Nonlinear solver functions */ static void IDAPredict(IDAMem IDA_mem); static void IDAQuadPredict(IDAMem IDA_mem); static void IDASensPredict(IDAMem IDA_mem, N_Vector *yySens, N_Vector *ypSens); static void IDAQuadSensPredict(IDAMem IDA_mem, N_Vector *yQS, N_Vector *ypQS); static int IDANls(IDAMem IDA_mem); static int IDASensNls(IDAMem IDA_mem); static int IDAQuadNls(IDAMem IDA_mem); static int IDAQuadSensNls(IDAMem IDA_mem); /* Error tests */ static int IDATestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); static int IDAQuadTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); static int IDASensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); static int IDAQuadSensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2); /* Handling of convergence and/or error test failures */ static void IDARestore(IDAMem IDA_mem, realtype saved_t); static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr); static void IDAReset(IDAMem IDA_mem); /* Function called after a successful step */ static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1); /* Function called to evaluate the solutions y(t) and y'(t) at t. Also used in IDAA */ int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret); /* Stopping tests and failure handling */ static int IDAStopTest1(IDAMem IDA_mem, realtype tout,realtype *tret, N_Vector yret, N_Vector ypret, int itask); static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask); static int IDAHandleFailure(IDAMem IDA_mem, int sflag); /* Norm functions */ static realtype IDAQuadWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ); static realtype IDAQuadSensWrmsNorm(IDAMem IDA_mem, N_Vector *xQS, N_Vector *wQS); static realtype IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS); /* Functions for rootfinding */ static int IDARcheck1(IDAMem IDA_mem); static int IDARcheck2(IDAMem IDA_mem); static int IDARcheck3(IDAMem IDA_mem); static int IDARootfind(IDAMem IDA_mem); /* Sensitivity residual DQ function */ static int IDASensRes1DQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, int iS, N_Vector yyS, N_Vector ypS, N_Vector resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp); static int IDAQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *resvalQS, void *ida_mem, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); static int IDAQuadSensRhs1InternalDQ(IDAMem IDA_mem, int is, realtype t, N_Vector yy, N_Vector y, N_Vector yyS, N_Vector ypS, N_Vector resvalQ, N_Vector resvalQS, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * Creation, allocation and re-initialization functions * ----------------------------------------------------------------- */ /* * IDACreate * * IDACreate creates an internal memory block for a problem to * be solved by IDA. * If successful, IDACreate returns a pointer to the problem memory. * This pointer should be passed to IDAInit. * If an initialization error occurs, IDACreate prints an error * message to standard err and returns NULL. */ void *IDACreate(void) { IDAMem IDA_mem; IDA_mem = NULL; IDA_mem = (IDAMem) malloc(sizeof(struct IDAMemRec)); if (IDA_mem == NULL) { IDAProcessError(NULL, 0, "IDAS", "IDACreate", MSG_MEM_FAIL); return (NULL); } /* Zero out ida_mem */ memset(IDA_mem, 0, sizeof(struct IDAMemRec)); /* Set unit roundoff in IDA_mem */ IDA_mem->ida_uround = UNIT_ROUNDOFF; /* Set default values for integrator optional inputs */ IDA_mem->ida_res = NULL; IDA_mem->ida_user_data = NULL; IDA_mem->ida_itol = IDA_NN; IDA_mem->ida_user_efun = SUNFALSE; IDA_mem->ida_efun = NULL; IDA_mem->ida_edata = NULL; IDA_mem->ida_ehfun = IDAErrHandler; IDA_mem->ida_eh_data = IDA_mem; IDA_mem->ida_errfp = stderr; IDA_mem->ida_maxord = MAXORD_DEFAULT; IDA_mem->ida_mxstep = MXSTEP_DEFAULT; IDA_mem->ida_hmax_inv = HMAX_INV_DEFAULT; IDA_mem->ida_hin = ZERO; IDA_mem->ida_epcon = EPCON; IDA_mem->ida_maxnef = MXNEF; IDA_mem->ida_maxncf = MXNCF; IDA_mem->ida_maxcor = MAXIT; IDA_mem->ida_suppressalg = SUNFALSE; IDA_mem->ida_id = NULL; IDA_mem->ida_constraints = NULL; IDA_mem->ida_constraintsSet = SUNFALSE; IDA_mem->ida_tstopset = SUNFALSE; /* set the saved value maxord_alloc */ IDA_mem->ida_maxord_alloc = MAXORD_DEFAULT; /* Set default values for IC optional inputs */ IDA_mem->ida_epiccon = PT01 * EPCON; IDA_mem->ida_maxnh = MAXNH; IDA_mem->ida_maxnj = MAXNJ; IDA_mem->ida_maxnit = MAXNI; IDA_mem->ida_maxbacks = MAXBACKS; IDA_mem->ida_lsoff = SUNFALSE; IDA_mem->ida_steptol = SUNRpowerR(IDA_mem->ida_uround, TWOTHIRDS); /* Set default values for quad. optional inputs */ IDA_mem->ida_quadr = SUNFALSE; IDA_mem->ida_rhsQ = NULL; IDA_mem->ida_errconQ = SUNFALSE; IDA_mem->ida_itolQ = IDA_NN; /* Set default values for sensi. optional inputs */ IDA_mem->ida_sensi = SUNFALSE; IDA_mem->ida_user_dataS = (void *)IDA_mem; IDA_mem->ida_resS = IDASensResDQ; IDA_mem->ida_resSDQ = SUNTRUE; IDA_mem->ida_DQtype = IDA_CENTERED; IDA_mem->ida_DQrhomax = ZERO; IDA_mem->ida_p = NULL; IDA_mem->ida_pbar = NULL; IDA_mem->ida_plist = NULL; IDA_mem->ida_errconS = SUNFALSE; IDA_mem->ida_maxcorS = MAXIT; IDA_mem->ida_itolS = IDA_EE; IDA_mem->ida_ism = -1; /* initialize to invalid option */ /* Defaults for sensi. quadr. optional inputs. */ IDA_mem->ida_quadr_sensi = SUNFALSE; IDA_mem->ida_user_dataQS = (void *)IDA_mem; IDA_mem->ida_rhsQS = IDAQuadSensRhsInternalDQ; IDA_mem->ida_rhsQSDQ = SUNTRUE; IDA_mem->ida_errconQS = SUNFALSE; IDA_mem->ida_itolQS = IDA_EE; /* Set defaults for ASA. */ IDA_mem->ida_adj = SUNFALSE; IDA_mem->ida_adj_mem = NULL; /* Initialize lrw and liw */ IDA_mem->ida_lrw = 25 + 5*MXORDP1; IDA_mem->ida_liw = 38; /* No mallocs have been done yet */ IDA_mem->ida_VatolMallocDone = SUNFALSE; IDA_mem->ida_constraintsMallocDone = SUNFALSE; IDA_mem->ida_idMallocDone = SUNFALSE; IDA_mem->ida_MallocDone = SUNFALSE; IDA_mem->ida_VatolQMallocDone = SUNFALSE; IDA_mem->ida_quadMallocDone = SUNFALSE; IDA_mem->ida_VatolSMallocDone = SUNFALSE; IDA_mem->ida_SatolSMallocDone = SUNFALSE; IDA_mem->ida_sensMallocDone = SUNFALSE; IDA_mem->ida_VatolQSMallocDone = SUNFALSE; IDA_mem->ida_SatolQSMallocDone = SUNFALSE; IDA_mem->ida_quadSensMallocDone = SUNFALSE; IDA_mem->ida_adjMallocDone = SUNFALSE; /* Initialize nonlinear solver variables */ IDA_mem->NLS = NULL; IDA_mem->ownNLS = SUNFALSE; IDA_mem->NLSsim = NULL; IDA_mem->ownNLSsim = SUNFALSE; IDA_mem->ycor0Sim = NULL; IDA_mem->ycorSim = NULL; IDA_mem->ewtSim = NULL; IDA_mem->simMallocDone = SUNFALSE; IDA_mem->NLSstg = NULL; IDA_mem->ownNLSstg = SUNFALSE; IDA_mem->ycor0Stg = NULL; IDA_mem->ycorStg = NULL; IDA_mem->ewtStg = NULL; IDA_mem->stgMallocDone = SUNFALSE; /* Return pointer to IDA memory block */ return((void *)IDA_mem); } /*-----------------------------------------------------------------*/ /* * IDAInit * * IDAInit allocates and initializes memory for a problem. All * problem specification inputs are checked for errors. If any * error occurs during initialization, it is reported to the * error handler function. */ int IDAInit(void *ida_mem, IDAResFn res, realtype t0, N_Vector yy0, N_Vector yp0) { int retval; IDAMem IDA_mem; booleantype nvectorOK, allocOK; sunindextype lrw1, liw1; SUNNonlinearSolver NLS; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check for legal input parameters */ if (yy0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_Y0_NULL); return(IDA_ILL_INPUT); } if (yp0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_YP0_NULL); return(IDA_ILL_INPUT); } if (res == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_RES_NULL); return(IDA_ILL_INPUT); } /* Test if all required vector operations are implemented */ nvectorOK = IDACheckNvector(yy0); if (!nvectorOK) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInit", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Set space requirements for one N_Vector */ if (yy0->ops->nvspace != NULL) { N_VSpace(yy0, &lrw1, &liw1); } else { lrw1 = 0; liw1 = 0; } IDA_mem->ida_lrw1 = lrw1; IDA_mem->ida_liw1 = liw1; /* Allocate the vectors (using yy0 as a template) */ allocOK = IDAAllocVectors(IDA_mem, yy0); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Allocate temporary work arrays for fused vector ops */ IDA_mem->ida_cvals = NULL; IDA_mem->ida_cvals = (realtype *) malloc(MXORDP1*sizeof(realtype)); IDA_mem->ida_Xvecs = NULL; IDA_mem->ida_Xvecs = (N_Vector *) malloc(MXORDP1*sizeof(N_Vector)); IDA_mem->ida_Zvecs = NULL; IDA_mem->ida_Zvecs = (N_Vector *) malloc(MXORDP1*sizeof(N_Vector)); if ((IDA_mem->ida_cvals == NULL) || (IDA_mem->ida_Xvecs == NULL) || (IDA_mem->ida_Zvecs == NULL)) { IDAFreeVectors(IDA_mem); IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* create a Newton nonlinear solver object by default */ NLS = SUNNonlinSol_Newton(yy0); /* check that nonlinear solver is non-NULL */ if (NLS == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAInit", MSG_MEM_FAIL); IDAFreeVectors(IDA_mem); return(IDA_MEM_FAIL); } /* attach the nonlinear solver to the IDA memory */ retval = IDASetNonlinearSolver(IDA_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, retval, "IDAS", "IDAInit", "Setting the nonlinear solver failed"); IDAFreeVectors(IDA_mem); SUNNonlinSolFree(NLS); return(IDA_MEM_FAIL); } /* set ownership flag */ IDA_mem->ownNLS = SUNTRUE; /* All error checking is complete at this point */ /* Copy the input parameters into IDA memory block */ IDA_mem->ida_res = res; IDA_mem->ida_tn = t0; /* Set the linear solver addresses to NULL */ IDA_mem->ida_linit = NULL; IDA_mem->ida_lsetup = NULL; IDA_mem->ida_lsolve = NULL; IDA_mem->ida_lperf = NULL; IDA_mem->ida_lfree = NULL; IDA_mem->ida_lmem = NULL; /* Set forceSetup to SUNFALSE */ IDA_mem->ida_forceSetup = SUNFALSE; /* Initialize the phi array */ N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); /* Initialize all the counters and other optional output values */ IDA_mem->ida_nst = 0; IDA_mem->ida_nre = 0; IDA_mem->ida_ncfn = 0; IDA_mem->ida_netf = 0; IDA_mem->ida_nni = 0; IDA_mem->ida_nsetups = 0; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_tolsf = ONE; IDA_mem->ida_nge = 0; IDA_mem->ida_irfnd = 0; /* Initialize counters specific to IC calculation. */ IDA_mem->ida_nbacktr = 0; /* Initialize root-finding variables */ IDA_mem->ida_glo = NULL; IDA_mem->ida_ghi = NULL; IDA_mem->ida_grout = NULL; IDA_mem->ida_iroots = NULL; IDA_mem->ida_rootdir = NULL; IDA_mem->ida_gfun = NULL; IDA_mem->ida_nrtfn = 0; IDA_mem->ida_gactive = NULL; IDA_mem->ida_mxgnull = 1; /* Initial setup not done yet */ IDA_mem->ida_SetupDone = SUNFALSE; /* Problem memory has been successfully allocated */ IDA_mem->ida_MallocDone = SUNTRUE; return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDAReInit * * IDAReInit re-initializes IDA's memory for a problem, assuming * it has already beeen allocated in a prior IDAInit call. * All problem specification inputs are checked for errors. * The problem size Neq is assumed to be unchanged since the call * to IDAInit, and the maximum order maxord must not be larger. * If any error occurs during reinitialization, it is reported to * the error handler function. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; /* Check for legal input parameters */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if (IDA_mem->ida_MallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDAReInit", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check for legal input parameters */ if (yy0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAReInit", MSG_Y0_NULL); return(IDA_ILL_INPUT); } if (yp0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAReInit", MSG_YP0_NULL); return(IDA_ILL_INPUT); } /* Copy the input parameters into IDA memory block */ IDA_mem->ida_tn = t0; /* Set forceSetup to SUNFALSE */ IDA_mem->ida_forceSetup = SUNFALSE; /* Initialize the phi array */ N_VScale(ONE, yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, yp0, IDA_mem->ida_phi[1]); /* Initialize all the counters and other optional output values */ IDA_mem->ida_nst = 0; IDA_mem->ida_nre = 0; IDA_mem->ida_ncfn = 0; IDA_mem->ida_netf = 0; IDA_mem->ida_nni = 0; IDA_mem->ida_nsetups = 0; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_tolsf = ONE; IDA_mem->ida_nge = 0; IDA_mem->ida_irfnd = 0; /* Initial setup not done yet */ IDA_mem->ida_SetupDone = SUNFALSE; /* Problem has been successfully re-initialized */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDASStolerances * IDASVtolerances * IDAWFtolerances * * These functions specify the integration tolerances. One of them * MUST be called before the first call to IDA. * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). * IDAWFtolerances specifies a user-provides function (of type IDAEwtFn) * which will be called to set the error weight vector. */ int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASStolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASStolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (abstol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASStolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ IDA_mem->ida_rtol = reltol; IDA_mem->ida_Satol = abstol; IDA_mem->ida_itol = IDA_SS; IDA_mem->ida_user_efun = SUNFALSE; IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */ return(IDA_SUCCESS); } int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASVtolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs */ if (reltol < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASVtolerances", MSG_BAD_RTOL); return(IDA_ILL_INPUT); } if (N_VMin(abstol) < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASVtolerances", MSG_BAD_ATOL); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ if ( !(IDA_mem->ida_VatolMallocDone) ) { IDA_mem->ida_Vatol = N_VClone(IDA_mem->ida_ewt); IDA_mem->ida_lrw += IDA_mem->ida_lrw1; IDA_mem->ida_liw += IDA_mem->ida_liw1; IDA_mem->ida_VatolMallocDone = SUNTRUE; } IDA_mem->ida_rtol = reltol; N_VScale(ONE, abstol, IDA_mem->ida_Vatol); IDA_mem->ida_itol = IDA_SV; IDA_mem->ida_user_efun = SUNFALSE; IDA_mem->ida_efun = IDAEwtSet; IDA_mem->ida_edata = NULL; /* will be set to ida_mem in InitialSetup */ return(IDA_SUCCESS); } int IDAWFtolerances(void *ida_mem, IDAEwtFn efun) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAWFtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_MallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDAWFtolerances", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } IDA_mem->ida_itol = IDA_WF; IDA_mem->ida_user_efun = SUNTRUE; IDA_mem->ida_efun = efun; IDA_mem->ida_edata = NULL; /* will be set to user_data in InitialSetup */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDAQuadMalloc * * IDAQuadMalloc allocates and initializes quadrature related * memory for a problem. All problem specification inputs are * checked for errors. If any error occurs during initialization, * it is reported to the file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAQuadInit(void *ida_mem, IDAQuadRhsFn rhsQ, N_Vector yQ0) { IDAMem IDA_mem; booleantype allocOK; sunindextype lrw1Q, liw1Q; int retval; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Set space requirements for one N_Vector */ N_VSpace(yQ0, &lrw1Q, &liw1Q); IDA_mem->ida_lrw1Q = lrw1Q; IDA_mem->ida_liw1Q = liw1Q; /* Allocate the vectors (using yQ0 as a template) */ allocOK = IDAQuadAllocVectors(IDA_mem, yQ0); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDAQuadInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Initialize phiQ in the history array */ N_VScale(ONE, yQ0, IDA_mem->ida_phiQ[0]); retval = N_VConstVectorArray(IDA_mem->ida_maxord, ZERO, IDA_mem->ida_phiQ+1); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Copy the input parameters into IDAS state */ IDA_mem->ida_rhsQ = rhsQ; /* Initialize counters */ IDA_mem->ida_nrQe = 0; IDA_mem->ida_netfQ = 0; /* Quadrature integration turned ON */ IDA_mem->ida_quadr = SUNTRUE; IDA_mem->ida_quadMallocDone = SUNTRUE; /* Quadrature initialization was successfull */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDAQuadReInit * * IDAQuadReInit re-initializes IDAS's quadrature related memory * for a problem, assuming it has already been allocated in prior * calls to IDAInit and IDAQuadMalloc. * All problem specification inputs are checked for errors. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDAQuadReInit(void *ida_mem, N_Vector yQ0) { IDAMem IDA_mem; int retval; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadReInit", MSG_NO_QUAD); return(IDA_NO_QUAD); } /* Initialize phiQ in the history array */ N_VScale(ONE, yQ0, IDA_mem->ida_phiQ[0]); retval = N_VConstVectorArray(IDA_mem->ida_maxord, ZERO, IDA_mem->ida_phiQ+1); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Initialize counters */ IDA_mem->ida_nrQe = 0; IDA_mem->ida_netfQ = 0; /* Quadrature integration turned ON */ IDA_mem->ida_quadr = SUNTRUE; /* Quadrature re-initialization was successfull */ return(IDA_SUCCESS); } /* * IDAQuadSStolerances * IDAQuadSVtolerances * * * These functions specify the integration tolerances for quadrature * variables. One of them MUST be called before the first call to * IDA IF error control on the quadrature variables is enabled * (see IDASetQuadErrCon). * * IDASStolerances specifies scalar relative and absolute tolerances. * IDASVtolerances specifies scalar relative tolerance and a vector * absolute tolerance (a potentially different absolute tolerance * for each vector component). */ int IDAQuadSStolerances(void *ida_mem, realtype reltolQ, realtype abstolQ) { IDAMem IDA_mem; /*Check ida mem*/ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadSStolerances", MSG_NO_QUAD); return(IDA_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSStolerances", MSG_BAD_RTOLQ); return(IDA_ILL_INPUT); } if (abstolQ < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSStolerances", MSG_BAD_ATOLQ); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ IDA_mem->ida_itolQ = IDA_SS; IDA_mem->ida_rtolQ = reltolQ; IDA_mem->ida_SatolQ = abstolQ; return (IDA_SUCCESS); } int IDAQuadSVtolerances(void *ida_mem, realtype reltolQ, N_Vector abstolQ) { IDAMem IDA_mem; /*Check ida mem*/ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAQuadSVtolerances", MSG_NO_QUAD); return(IDA_NO_QUAD); } /* Test user-supplied tolerances */ if (reltolQ < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_BAD_RTOLQ); return(IDA_ILL_INPUT); } if (abstolQ == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSVtolerances", MSG_NULL_ATOLQ); return(IDA_ILL_INPUT); } if (N_VMin(abstolQ)ida_itolQ = IDA_SV; IDA_mem->ida_rtolQ = reltolQ; /* clone the absolute tolerances vector (if necessary) */ if (SUNFALSE == IDA_mem->ida_VatolQMallocDone) { IDA_mem->ida_VatolQ = N_VClone(abstolQ); IDA_mem->ida_lrw += IDA_mem->ida_lrw1Q; IDA_mem->ida_liw += IDA_mem->ida_liw1Q; IDA_mem->ida_VatolQMallocDone = SUNTRUE; } N_VScale(ONE, abstolQ, IDA_mem->ida_VatolQ); return(IDA_SUCCESS); } /* * IDASenMalloc * * IDASensInit allocates and initializes sensitivity related * memory for a problem. All problem specification inputs are * checked for errors. If any error occurs during initialization, * it is reported to the file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDASensInit(void *ida_mem, int Ns, int ism, IDASensResFn fS, N_Vector *yS0, N_Vector *ypS0) { IDAMem IDA_mem; booleantype allocOK; int is, retval; SUNNonlinearSolver NLS; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if Ns is legal */ if (Ns<=0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_BAD_NS); return(IDA_ILL_INPUT); } IDA_mem->ida_Ns = Ns; /* Check if ism is legal */ if ((ism!=IDA_SIMULTANEOUS) && (ism!=IDA_STAGGERED)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_BAD_ISM); return(IDA_ILL_INPUT); } IDA_mem->ida_ism = ism; /* Check if yS0 and ypS0 are non-null */ if (yS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_NULL_YYS0); return(IDA_ILL_INPUT); } if (ypS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensInit", MSG_NULL_YPS0); return(IDA_ILL_INPUT); } /* Store sensitivity RHS-related data */ if (fS != NULL) { IDA_mem->ida_resS = fS; IDA_mem->ida_user_dataS = IDA_mem->ida_user_data; IDA_mem->ida_resSDQ = SUNFALSE; } else { IDA_mem->ida_resS = IDASensResDQ; IDA_mem->ida_user_dataS = ida_mem; IDA_mem->ida_resSDQ = SUNTRUE; } /* Allocate the vectors (using yS0[0] as a template) */ allocOK = IDASensAllocVectors(IDA_mem, yS0[0]); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Allocate temporary work arrays for fused vector ops */ if (Ns*MXORDP1 > MXORDP1) { free(IDA_mem->ida_cvals); IDA_mem->ida_cvals = NULL; free(IDA_mem->ida_Xvecs); IDA_mem->ida_Xvecs = NULL; free(IDA_mem->ida_Zvecs); IDA_mem->ida_Zvecs = NULL; IDA_mem->ida_cvals = (realtype *) malloc((Ns*MXORDP1)*sizeof(realtype)); IDA_mem->ida_Xvecs = (N_Vector *) malloc((Ns*MXORDP1)*sizeof(N_Vector)); IDA_mem->ida_Zvecs = (N_Vector *) malloc((Ns*MXORDP1)*sizeof(N_Vector)); if ((IDA_mem->ida_cvals == NULL) || (IDA_mem->ida_Xvecs == NULL) || (IDA_mem->ida_Zvecs == NULL)) { IDASensFreeVectors(IDA_mem); IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } } /*---------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize the phiS array */ for (is=0; isida_cvals[is] = ONE; retval = N_VScaleVectorArray(Ns, IDA_mem->ida_cvals, yS0, IDA_mem->ida_phiS[0]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); retval = N_VScaleVectorArray(Ns, IDA_mem->ida_cvals, ypS0, IDA_mem->ida_phiS[1]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Initialize all sensitivity related counters */ IDA_mem->ida_nrSe = 0; IDA_mem->ida_nreS = 0; IDA_mem->ida_ncfnS = 0; IDA_mem->ida_netfS = 0; IDA_mem->ida_nniS = 0; IDA_mem->ida_nsetupsS = 0; /* Set default values for plist and pbar */ for (is=0; isida_plist[is] = is; IDA_mem->ida_pbar[is] = ONE; } /* Sensitivities will be computed */ IDA_mem->ida_sensi = SUNTRUE; IDA_mem->ida_sensMallocDone = SUNTRUE; /* create a Newton nonlinear solver object by default */ if (ism == IDA_SIMULTANEOUS) NLS = SUNNonlinSol_NewtonSens(Ns+1, IDA_mem->ida_delta); else NLS = SUNNonlinSol_NewtonSens(Ns, IDA_mem->ida_delta); /* check that the nonlinear solver is non-NULL */ if (NLS == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensInit", MSG_MEM_FAIL); IDASensFreeVectors(IDA_mem); return(IDA_MEM_FAIL); } /* attach the nonlinear solver to the IDA memory */ if (ism == IDA_SIMULTANEOUS) retval = IDASetNonlinearSolverSensSim(IDA_mem, NLS); else retval = IDASetNonlinearSolverSensStg(IDA_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, retval, "IDAS", "IDASensInit", "Setting the nonlinear solver failed"); IDASensFreeVectors(IDA_mem); SUNNonlinSolFree(NLS); return(IDA_MEM_FAIL); } /* set ownership flag */ if (ism == IDA_SIMULTANEOUS) IDA_mem->ownNLSsim = SUNTRUE; else IDA_mem->ownNLSstg = SUNTRUE; /* Sensitivity initialization was successfull */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDASensReInit * * IDASensReInit re-initializes IDAS's sensitivity related memory * for a problem, assuming it has already been allocated in prior * calls to IDAInit and IDASensInit. * All problem specification inputs are checked for errors. * The number of sensitivities Ns is assumed to be unchanged since * the previous call to IDASensInit. * If any error occurs during initialization, it is reported to the * file whose file pointer is errfp. * The return value is IDA_SUCCESS = 0 if no errors occurred, or * a negative value otherwise. */ int IDASensReInit(void *ida_mem, int ism, N_Vector *yS0, N_Vector *ypS0) { IDAMem IDA_mem; int is, retval; SUNNonlinearSolver NLS; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensReInit", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Check if ism is legal */ if ((ism!=IDA_SIMULTANEOUS) && (ism!=IDA_STAGGERED)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensReInit", MSG_BAD_ISM); return(IDA_ILL_INPUT); } IDA_mem->ida_ism = ism; /* Check if yS0 and ypS0 are non-null */ if (yS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensReInit", MSG_NULL_YYS0); return(IDA_ILL_INPUT); } if (ypS0 == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensReInit", MSG_NULL_YPS0); return(IDA_ILL_INPUT); } /*----------------------------------------------- All error checking is complete at this point -----------------------------------------------*/ /* Initialize the phiS array */ for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, yS0, IDA_mem->ida_phiS[0]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, ypS0, IDA_mem->ida_phiS[1]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Initialize all sensitivity related counters */ IDA_mem->ida_nrSe = 0; IDA_mem->ida_nreS = 0; IDA_mem->ida_ncfnS = 0; IDA_mem->ida_netfS = 0; IDA_mem->ida_nniS = 0; IDA_mem->ida_nsetupsS = 0; /* Set default values for plist and pbar */ for (is=0; isida_Ns; is++) { IDA_mem->ida_plist[is] = is; IDA_mem->ida_pbar[is] = ONE; } /* Sensitivities will be computed */ IDA_mem->ida_sensi = SUNTRUE; /* Check if the NLS exists, create the default NLS if needed */ if ((ism == IDA_SIMULTANEOUS && IDA_mem->NLSsim == NULL) || (ism == IDA_STAGGERED && IDA_mem->NLSstg == NULL)) { /* create a Newton nonlinear solver object by default */ if (ism == IDA_SIMULTANEOUS) NLS = SUNNonlinSol_NewtonSens(IDA_mem->ida_Ns+1, IDA_mem->ida_delta); else NLS = SUNNonlinSol_NewtonSens(IDA_mem->ida_Ns, IDA_mem->ida_delta); /* check that the nonlinear solver is non-NULL */ if (NLS == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASensReInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* attach the nonlinear solver to the IDA memory */ if (ism == IDA_SIMULTANEOUS) retval = IDASetNonlinearSolverSensSim(IDA_mem, NLS); else retval = IDASetNonlinearSolverSensStg(IDA_mem, NLS); /* check that the nonlinear solver was successfully attached */ if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, retval, "IDAS", "IDASensReInit", "Setting the nonlinear solver failed"); SUNNonlinSolFree(NLS); return(IDA_MEM_FAIL); } /* set ownership flag */ if (ism == IDA_SIMULTANEOUS) IDA_mem->ownNLSsim = SUNTRUE; else IDA_mem->ownNLSstg = SUNTRUE; /* initialize the NLS object, this assumes that the linear solver has already been initialized in IDAInit */ if (ism == IDA_SIMULTANEOUS) retval = idaNlsInitSensSim(IDA_mem); else retval = idaNlsInitSensStg(IDA_mem); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDASensReInit", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } } /* Sensitivity re-initialization was successfull */ return(IDA_SUCCESS); } /*-----------------------------------------------------------------*/ /* * IDASensSStolerances * IDASensSVtolerances * IDASensEEtolerances * * These functions specify the integration tolerances for sensitivity * variables. One of them MUST be called before the first call to IDASolve. * * IDASensSStolerances specifies scalar relative and absolute tolerances. * IDASensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each sensitivity vector (a potentially different * absolute tolerance for each vector component). * IDASensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the state variables. */ int IDASensSStolerances(void *ida_mem, realtype reltolS, realtype *abstolS) { IDAMem IDA_mem; int is; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensSStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensSStolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_BAD_RTOLS); return(IDA_ILL_INPUT); } if (abstolS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_NULL_ATOLS); return(IDA_ILL_INPUT); } for (is=0; isida_Ns; is++) if (abstolS[is] < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSStolerances", MSG_BAD_ATOLS); return(IDA_ILL_INPUT); } /* Copy tolerances into memory */ IDA_mem->ida_itolS = IDA_SS; IDA_mem->ida_rtolS = reltolS; if ( !(IDA_mem->ida_SatolSMallocDone) ) { IDA_mem->ida_SatolS = NULL; IDA_mem->ida_SatolS = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype)); IDA_mem->ida_lrw += IDA_mem->ida_Ns; IDA_mem->ida_SatolSMallocDone = SUNTRUE; } for (is=0; isida_Ns; is++) IDA_mem->ida_SatolS[is] = abstolS[is]; return(IDA_SUCCESS); } int IDASensSVtolerances(void *ida_mem, realtype reltolS, N_Vector *abstolS) { IDAMem IDA_mem; int is, retval; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensSVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensSVtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Test user-supplied tolerances */ if (reltolS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSVtolerances", MSG_BAD_RTOLS); return(IDA_ILL_INPUT); } if (abstolS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASensSVtolerances", MSG_NULL_ATOLS); return(IDA_ILL_INPUT); } for (is=0; isida_Ns; is++) { if (N_VMin(abstolS[is])ida_itolS = IDA_SV; IDA_mem->ida_rtolS = reltolS ; if ( SUNFALSE == IDA_mem->ida_VatolSMallocDone ) { IDA_mem->ida_VatolS = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); IDA_mem->ida_lrw += IDA_mem->ida_Ns*IDA_mem->ida_lrw1; IDA_mem->ida_liw += IDA_mem->ida_Ns*IDA_mem->ida_liw1; IDA_mem->ida_VatolSMallocDone = SUNTRUE; } for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, abstolS, IDA_mem->ida_VatolS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } int IDASensEEtolerances(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensEEtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was sensitivity initialized? */ if (IDA_mem->ida_sensMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDASensEEtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } IDA_mem->ida_itolS = IDA_EE; return(IDA_SUCCESS); } int IDAQuadSensInit(void *ida_mem, IDAQuadSensRhsFn rhsQS, N_Vector *yQS0) { IDAMem IDA_mem; booleantype allocOK; int is, retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(NULL, IDA_NO_SENS, "IDAS", "IDAQuadSensInit", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Verifiy yQS0 parameter. */ if (yQS0==NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDAQuadSensInit", MSG_NULL_YQS0); return(IDA_ILL_INPUT); } /* Allocate vector needed for quadratures' sensitivities. */ allocOK = IDAQuadSensAllocVectors(IDA_mem, yQS0[0]); if (!allocOK) { IDAProcessError(NULL, IDA_MEM_FAIL, "IDAS", "IDAQuadSensInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Error checking complete. */ if (rhsQS == NULL) { IDA_mem->ida_rhsQSDQ = SUNTRUE; IDA_mem->ida_rhsQS = IDAQuadSensRhsInternalDQ; IDA_mem->ida_user_dataQS = ida_mem; } else { IDA_mem->ida_rhsQSDQ = SUNFALSE; IDA_mem->ida_rhsQS = rhsQS; IDA_mem->ida_user_dataQS = IDA_mem->ida_user_data; } /* Initialize phiQS[0] in the history array */ for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, yQS0, IDA_mem->ida_phiQS[0]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Initialize all sensitivities related counters. */ IDA_mem->ida_nrQSe = 0; IDA_mem->ida_nrQeS = 0; IDA_mem->ida_netfQS = 0; /* Everything allright, set the flags and return with success. */ IDA_mem->ida_quadr_sensi = SUNTRUE; IDA_mem->ida_quadSensMallocDone = SUNTRUE; return(IDA_SUCCESS); } int IDAQuadSensReInit(void *ida_mem, N_Vector *yQS0) { IDAMem IDA_mem; int is, retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensReInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensReInit", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensReInit", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } /* Verifiy yQS0 parameter. */ if (yQS0==NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDAQuadSensReInit", MSG_NULL_YQS0); return(IDA_ILL_INPUT); } /* Error checking complete at this point. */ /* Initialize phiQS[0] in the history array */ for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, yQS0, IDA_mem->ida_phiQS[0]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Initialize all sensitivities related counters. */ IDA_mem->ida_nrQSe = 0; IDA_mem->ida_nrQeS = 0; IDA_mem->ida_netfQS = 0; /* Everything allright, set the flags and return with success. */ IDA_mem->ida_quadr_sensi = SUNTRUE; return(IDA_SUCCESS); } /* * IDAQuadSensSStolerances * IDAQuadSensSVtolerances * IDAQuadSensEEtolerances * * These functions specify the integration tolerances for quadrature * sensitivity variables. One of them MUST be called before the first * call to IDAS IF these variables are included in the error test. * * IDAQuadSensSStolerances specifies scalar relative and absolute tolerances. * IDAQuadSensSVtolerances specifies scalar relative tolerance and a vector * absolute tolerance for each quadrature sensitivity vector (a potentially * different absolute tolerance for each vector component). * IDAQuadSensEEtolerances specifies that tolerances for sensitivity variables * should be estimated from those provided for the quadrature variables. * In this case, tolerances for the quadrature variables must be * specified through a call to one of IDAQuad**tolerances. */ int IDAQuadSensSStolerances(void *ida_mem, realtype reltolQS, realtype *abstolQS) { IDAMem IDA_mem; int is; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensSStolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensSStolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensSStolerances", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_BAD_RELTOLQS); return(IDA_ILL_INPUT); } if (abstolQS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_NULL_ABSTOLQS); return(IDA_ILL_INPUT); } for (is=0; isida_Ns; is++) if (abstolQS[is] < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSStolerances", MSG_BAD_ABSTOLQS); return(IDA_ILL_INPUT); } /* Save data. */ IDA_mem->ida_itolQS = IDA_SS; IDA_mem->ida_rtolQS = reltolQS; if ( !(IDA_mem->ida_SatolQSMallocDone) ) { IDA_mem->ida_SatolQS = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype)); IDA_mem->ida_lrw += IDA_mem->ida_Ns; IDA_mem->ida_SatolQSMallocDone = SUNTRUE; } for (is=0; isida_Ns; is++) IDA_mem->ida_SatolQS[is] = abstolQS[is]; return(IDA_SUCCESS); } int IDAQuadSensSVtolerances(void *ida_mem, realtype reltolQS, N_Vector *abstolQS) { IDAMem IDA_mem; int is, retval; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensSVtolerances", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } /* Test user-supplied tolerances */ if (reltolQS < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_BAD_RELTOLQS); return(IDA_ILL_INPUT); } if (abstolQS == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_NULL_ABSTOLQS); return(IDA_ILL_INPUT); } for (is=0; isida_Ns; is++) if (N_VMin(abstolQS[is]) < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAQuadSensSVtolerances", MSG_BAD_ABSTOLQS); return(IDA_ILL_INPUT); } /* Save data. */ IDA_mem->ida_itolQS = IDA_SV; IDA_mem->ida_rtolQS = reltolQS; if ( !(IDA_mem->ida_VatolQSMallocDone) ) { IDA_mem->ida_VatolQS = N_VCloneVectorArray(IDA_mem->ida_Ns, abstolQS[0]); IDA_mem->ida_lrw += IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q; IDA_mem->ida_liw += IDA_mem->ida_Ns*IDA_mem->ida_liw1Q; IDA_mem->ida_VatolQSMallocDone = SUNTRUE; } for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, abstolQS, IDA_mem->ida_VatolQS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } int IDAQuadSensEEtolerances(void *ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if sensitivity analysis is active */ if (!IDA_mem->ida_sensi) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_SENSI); return(IDA_NO_SENS); } /* Was sensitivity for quadrature already initialized? */ if (!IDA_mem->ida_quadSensMallocDone) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAQuadSensEEtolerances", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } IDA_mem->ida_itolQS = IDA_EE; return(IDA_SUCCESS); } /* * IDASensToggleOff * * IDASensToggleOff deactivates sensitivity calculations. * It does NOT deallocate sensitivity-related memory. */ int IDASensToggleOff(void *ida_mem) { IDAMem IDA_mem; /* Check ida_mem */ if (ida_mem==NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASensToggleOff", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Disable sensitivities */ IDA_mem->ida_sensi = SUNFALSE; IDA_mem->ida_quadr_sensi = SUNFALSE; return(IDA_SUCCESS); } /* * IDARootInit * * IDARootInit initializes a rootfinding problem to be solved * during the integration of the DAE system. It loads the root * function pointer and the number of root functions, and allocates * workspace memory. The return value is IDA_SUCCESS = 0 if no * errors occurred, or a negative value otherwise. */ int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g) { IDAMem IDA_mem; int i, nrt; /* Check ida_mem pointer */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDARootInit", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; nrt = (nrtfn < 0) ? 0 : nrtfn; /* If rerunning IDARootInit() with a different number of root functions (changing number of gfun components), then free currently held memory resources */ if ((nrt != IDA_mem->ida_nrtfn) && (IDA_mem->ida_nrtfn > 0)) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL; IDA_mem->ida_lrw -= 3 * (IDA_mem->ida_nrtfn); IDA_mem->ida_liw -= 3 * (IDA_mem->ida_nrtfn); } /* If IDARootInit() was called with nrtfn == 0, then set ida_nrtfn to zero and ida_gfun to NULL before returning */ if (nrt == 0) { IDA_mem->ida_nrtfn = nrt; IDA_mem->ida_gfun = NULL; return(IDA_SUCCESS); } /* If rerunning IDARootInit() with the same number of root functions (not changing number of gfun components), then check if the root function argument has changed */ /* If g != NULL then return as currently reserved memory resources will suffice */ if (nrt == IDA_mem->ida_nrtfn) { if (g != IDA_mem->ida_gfun) { if (g == NULL) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL; IDA_mem->ida_lrw -= 3*nrt; IDA_mem->ida_liw -= 3*nrt; IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARootInit", MSG_ROOT_FUNC_NULL); return(IDA_ILL_INPUT); } else { IDA_mem->ida_gfun = g; return(IDA_SUCCESS); } } else return(IDA_SUCCESS); } /* Set variable values in IDA memory block */ IDA_mem->ida_nrtfn = nrt; if (g == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARootInit", MSG_ROOT_FUNC_NULL); return(IDA_ILL_INPUT); } else IDA_mem->ida_gfun = g; /* Allocate necessary memory and return */ IDA_mem->ida_glo = NULL; IDA_mem->ida_glo = (realtype *) malloc(nrt*sizeof(realtype)); if (IDA_mem->ida_glo == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ida_ghi = NULL; IDA_mem->ida_ghi = (realtype *) malloc(nrt*sizeof(realtype)); if (IDA_mem->ida_ghi == NULL) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ida_grout = NULL; IDA_mem->ida_grout = (realtype *) malloc(nrt*sizeof(realtype)); if (IDA_mem->ida_grout == NULL) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ida_iroots = NULL; IDA_mem->ida_iroots = (int *) malloc(nrt*sizeof(int)); if (IDA_mem->ida_iroots == NULL) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ida_rootdir = NULL; IDA_mem->ida_rootdir = (int *) malloc(nrt*sizeof(int)); if (IDA_mem->ida_rootdir == NULL) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ida_gactive = NULL; IDA_mem->ida_gactive = (booleantype *) malloc(nrt*sizeof(booleantype)); if (IDA_mem->ida_gactive == NULL) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDA", "IDARootInit", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Set default values for rootdir (both directions) */ for(i=0; iida_rootdir[i] = 0; /* Set default values for gactive (all active) */ for(i=0; iida_gactive[i] = SUNTRUE; IDA_mem->ida_lrw += 3*nrt; IDA_mem->ida_liw += 3*nrt; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Main solver function * ----------------------------------------------------------------- */ /* * IDASolve * * This routine is the main driver of the IDA package. * * It integrates over an independent variable interval defined by the user, * by calling IDAStep to take internal independent variable steps. * * The first time that IDASolve is called for a successfully initialized * problem, it computes a tentative initial step size. * * IDASolve supports two modes, specified by itask: * In the IDA_NORMAL mode, the solver steps until it passes tout and then * interpolates to obtain y(tout) and yp(tout). * In the IDA_ONE_STEP mode, it takes one internal step and returns. * * IDASolve returns integer values corresponding to success and failure as below: * * successful returns: * * IDA_SUCCESS * IDA_TSTOP_RETURN * * failed returns: * * IDA_ILL_INPUT * IDA_TOO_MUCH_WORK * IDA_MEM_NULL * IDA_TOO_MUCH_ACC * IDA_CONV_FAIL * IDA_LSETUP_FAIL * IDA_LSOLVE_FAIL * IDA_CONSTR_FAIL * IDA_ERR_FAIL * IDA_REP_RES_ERR * IDA_RES_FAIL */ int IDASolve(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { long int nstloc; int sflag, istate, ier, irfndp, is, ir; realtype tdist, troundoff, ypnorm, rh, nrm; IDAMem IDA_mem; booleantype inactive_roots; /* Check for legal inputs in all cases. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASolve", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if (IDA_mem->ida_MallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDASolve", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check for legal arguments */ if (yret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_YRET_NULL); return(IDA_ILL_INPUT); } IDA_mem->ida_yy = yret; if (ypret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_YPRET_NULL); return(IDA_ILL_INPUT); } IDA_mem->ida_yp = ypret; if (tret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TRET_NULL); return(IDA_ILL_INPUT); } if ((itask != IDA_NORMAL) && (itask != IDA_ONE_STEP)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } if (itask == IDA_NORMAL) IDA_mem->ida_toutc = tout; IDA_mem->ida_taskc = itask; /* Sensitivity-specific tests (if using internal DQ functions) */ if (IDA_mem->ida_sensi && IDA_mem->ida_resSDQ) { /* Make sure we have the right 'user data' */ IDA_mem->ida_user_dataS = ida_mem; /* Test if we have the problem parameters */ if(IDA_mem->ida_p == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_NULL_P); return(IDA_ILL_INPUT); } } if (IDA_mem->ida_quadr_sensi && IDA_mem->ida_rhsQSDQ) { IDA_mem->ida_user_dataQS = ida_mem; /* Test if we have the problem parameters */ if(IDA_mem->ida_p == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_NULL_P); return(IDA_ILL_INPUT); } } if (IDA_mem->ida_nst == 0) { /* This is the first call */ /* Check inputs to IDA for correctness and consistency */ if (IDA_mem->ida_SetupDone == SUNFALSE) { ier = IDAInitialSetup(IDA_mem); if (ier != IDA_SUCCESS) return(ier); IDA_mem->ida_SetupDone = SUNTRUE; } /* On first call, check for tout - tn too small, set initial hh, check for approach to tstop, and scale phi[1], phiQ[1], and phiS[1] by hh. Also check for zeros of root function g at and near t0. */ tdist = SUNRabs(tout - IDA_mem->ida_tn); if (tdist == ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_CLOSE); return(IDA_ILL_INPUT); } troundoff = TWO * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(tout)); if (tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_CLOSE); return(IDA_ILL_INPUT); } IDA_mem->ida_hh = IDA_mem->ida_hin; if ( (IDA_mem->ida_hh != ZERO) && ((tout-IDA_mem->ida_tn)*IDA_mem->ida_hh < ZERO) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_HINIT); return(IDA_ILL_INPUT); } if (IDA_mem->ida_hh == ZERO) { IDA_mem->ida_hh = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_phi[1], IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); if (IDA_mem->ida_errconQ) ypnorm = IDAQuadWrmsNormUpdate(IDA_mem, ypnorm, IDA_mem->ida_phiQ[1], IDA_mem->ida_ewtQ); if (IDA_mem->ida_errconS) ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, IDA_mem->ida_phiS[1], IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg); if (IDA_mem->ida_errconQS) ypnorm = IDAQuadSensWrmsNormUpdate(IDA_mem, ypnorm, IDA_mem->ida_phiQS[1], IDA_mem->ida_ewtQS); if (ypnorm > HALF/IDA_mem->ida_hh) IDA_mem->ida_hh = HALF/ypnorm; if (tout < IDA_mem->ida_tn) IDA_mem->ida_hh = -IDA_mem->ida_hh; } rh = SUNRabs(IDA_mem->ida_hh) * IDA_mem->ida_hmax_inv; if (rh > ONE) IDA_mem->ida_hh /= rh; if (IDA_mem->ida_tstopset) { if ( (IDA_mem->ida_tstop - IDA_mem->ida_tn)*IDA_mem->ida_hh <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } if ( (IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); } IDA_mem->ida_h0u = IDA_mem->ida_hh; IDA_mem->ida_kk = 0; IDA_mem->ida_kused = 0; /* set in case of an error return before a step */ /* Check for exact zeros of the root functions at or near t0. */ if (IDA_mem->ida_nrtfn > 0) { ier = IDARcheck1(IDA_mem); if (ier == IDA_RTFUNC_FAIL) { IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck1", MSG_RTFUNC_FAILED, IDA_mem->ida_tn); return(IDA_RTFUNC_FAIL); } } N_VScale(IDA_mem->ida_hh, IDA_mem->ida_phi[1], IDA_mem->ida_phi[1]); /* set phi[1] = hh*y' */ if (IDA_mem->ida_quadr) N_VScale(IDA_mem->ida_hh, IDA_mem->ida_phiQ[1], IDA_mem->ida_phiQ[1]); /* set phiQ[1] = hh*yQ' */ if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = IDA_mem->ida_hh; if (IDA_mem->ida_sensi) { /* set phiS[1][i] = hh*yS_i' */ ier = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiS[1], IDA_mem->ida_phiS[1]); if (ier != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } if (IDA_mem->ida_quadr_sensi) { ier = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiQS[1], IDA_mem->ida_phiQS[1]); if (ier != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } /* Set the convergence test constants epsNewt and toldel */ IDA_mem->ida_epsNewt = IDA_mem->ida_epcon; IDA_mem->ida_toldel = PT0001 * IDA_mem->ida_epsNewt; } /* end of first-call block. */ /* Call lperf function and set nstloc for later performance testing. */ if (IDA_mem->ida_lperf != NULL) IDA_mem->ida_lperf(IDA_mem, 0); nstloc = 0; /* If not the first call, perform all stopping tests. */ if (IDA_mem->ida_nst > 0) { /* First, check for a root in the last step taken, other than the last root found, if any. If itask = IDA_ONE_STEP and y(tn) was not returned because of an intervening root, return y(tn) now. */ if (IDA_mem->ida_nrtfn > 0) { irfndp = IDA_mem->ida_irfnd; ier = IDARcheck2(IDA_mem); if (ier == CLOSERT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDARcheck2", MSG_CLOSE_ROOTS, IDA_mem->ida_tlo); return(IDA_ILL_INPUT); } else if (ier == IDA_RTFUNC_FAIL) { IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck2", MSG_RTFUNC_FAILED, IDA_mem->ida_tlo); return(IDA_RTFUNC_FAIL); } else if (ier == RTFOUND) { IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo; return(IDA_ROOT_RETURN); } /* If tn is distinct from tretlast (within roundoff), check remaining interval for roots */ troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if ( SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tretlast) > troundoff ) { ier = IDARcheck3(IDA_mem); if (ier == IDA_SUCCESS) { /* no root found */ IDA_mem->ida_irfnd = 0; if ((irfndp == 1) && (itask == IDA_ONE_STEP)) { IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tn; ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); return(IDA_SUCCESS); } } else if (ier == RTFOUND) { /* a new root was found */ IDA_mem->ida_irfnd = 1; IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo; return(IDA_ROOT_RETURN); } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck3", MSG_RTFUNC_FAILED, IDA_mem->ida_tlo); return(IDA_RTFUNC_FAIL); } } } /* end of root stop check */ /* Now test for all other stop conditions. */ istate = IDAStopTest1(IDA_mem, tout, tret, yret, ypret, itask); if (istate != CONTINUE_STEPS) return(istate); } /* Looping point for internal steps. */ for(;;) { /* Check for too many steps taken. */ if ( (IDA_mem->ida_mxstep>0) && (nstloc >= IDA_mem->ida_mxstep) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_MAX_STEPS, IDA_mem->ida_tn); istate = IDA_TOO_MUCH_WORK; *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; break; /* Here yy=yret and yp=ypret already have the current solution. */ } /* Call lperf to generate warnings of poor performance. */ if (IDA_mem->ida_lperf != NULL) IDA_mem->ida_lperf(IDA_mem, 1); /* Reset and check ewt, ewtQ, ewtS and ewtQS (if not first call). */ if (IDA_mem->ida_nst > 0) { ier = IDA_mem->ida_efun(IDA_mem->ida_phi[0], IDA_mem->ida_ewt, IDA_mem->ida_edata); if (ier != 0) { if (IDA_mem->ida_itol == IDA_WF) IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWT_NOW_FAIL, IDA_mem->ida_tn); else IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWT_NOW_BAD, IDA_mem->ida_tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; break; } if (IDA_mem->ida_quadr && IDA_mem->ida_errconQ) { ier = IDAQuadEwtSet(IDA_mem, IDA_mem->ida_phiQ[0], IDA_mem->ida_ewtQ); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWTQ_NOW_BAD, IDA_mem->ida_tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; break; } } if (IDA_mem->ida_sensi) { ier = IDASensEwtSet(IDA_mem, IDA_mem->ida_phiS[0], IDA_mem->ida_ewtS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWTS_NOW_BAD, IDA_mem->ida_tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; break; } } if (IDA_mem->ida_quadr_sensi && IDA_mem->ida_errconQS) { ier = IDAQuadSensEwtSet(IDA_mem, IDA_mem->ida_phiQS[0], IDA_mem->ida_ewtQS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_EWTQS_NOW_BAD, IDA_mem->ida_tn); istate = IDA_ILL_INPUT; ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tn; break; } } } /* Check for too much accuracy requested. */ nrm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_phi[0], IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); if (IDA_mem->ida_errconQ) nrm = IDAQuadWrmsNormUpdate(IDA_mem, nrm, IDA_mem->ida_phiQ[0], IDA_mem->ida_ewtQ); if (IDA_mem->ida_errconS) nrm = IDASensWrmsNormUpdate(IDA_mem, nrm, IDA_mem->ida_phiS[0], IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg); if (IDA_mem->ida_errconQS) nrm = IDAQuadSensWrmsNormUpdate(IDA_mem, nrm, IDA_mem->ida_phiQS[0], IDA_mem->ida_ewtQS); IDA_mem->ida_tolsf = IDA_mem->ida_uround * nrm; if (IDA_mem->ida_tolsf > ONE) { IDA_mem->ida_tolsf *= TEN; IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASolve", MSG_TOO_MUCH_ACC, IDA_mem->ida_tn); istate = IDA_TOO_MUCH_ACC; *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; if (IDA_mem->ida_nst > 0) ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); break; } /* Call IDAStep to take a step. */ sflag = IDAStep(IDA_mem); /* Process all failed-step cases, and exit loop. */ if (sflag != IDA_SUCCESS) { istate = IDAHandleFailure(IDA_mem, sflag); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); break; } nstloc++; /* If tstop is set and was reached, reset IDA_mem->ida_tn = tstop */ if (IDA_mem->ida_tstopset) { troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) IDA_mem->ida_tn = IDA_mem->ida_tstop; } /* After successful step, check for stop conditions; continue or break. */ /* First check for root in the last step taken. */ if (IDA_mem->ida_nrtfn > 0) { ier = IDARcheck3(IDA_mem); if (ier == RTFOUND) { /* A new root was found */ IDA_mem->ida_irfnd = 1; istate = IDA_ROOT_RETURN; IDA_mem->ida_tretlast = *tret = IDA_mem->ida_tlo; break; } else if (ier == IDA_RTFUNC_FAIL) { /* g failed */ IDAProcessError(IDA_mem, IDA_RTFUNC_FAIL, "IDAS", "IDARcheck3", MSG_RTFUNC_FAILED, IDA_mem->ida_tlo); istate = IDA_RTFUNC_FAIL; break; } /* If we are at the end of the first step and we still have * some event functions that are inactive, issue a warning * as this may indicate a user error in the implementation * of the root function. */ if (IDA_mem->ida_nst==1) { inactive_roots = SUNFALSE; for (ir=0; irida_nrtfn; ir++) { if (!IDA_mem->ida_gactive[ir]) { inactive_roots = SUNTRUE; break; } } if ((IDA_mem->ida_mxgnull > 0) && inactive_roots) { IDAProcessError(IDA_mem, IDA_WARNING, "IDAS", "IDASolve", MSG_INACTIVE_ROOTS); } } } /* Now check all other stop conditions. */ istate = IDAStopTest2(IDA_mem, tout, tret, yret, ypret, itask); if (istate != CONTINUE_STEPS) break; } /* End of step loop */ return(istate); } /* * ----------------------------------------------------------------- * Interpolated output and extraction functions * ----------------------------------------------------------------- */ /* * IDAGetDky * * This routine evaluates the k-th derivative of y(t) as the value of * the k-th derivative of the interpolating polynomial at the independent * variable t, and stores the results in the vector dky. It uses the current * independent variable value, tn, and the method order last used, kused. * * The return values are: * IDA_SUCCESS if t is legal, or * IDA_BAD_T if t is not within the interval of the last step taken. * IDA_BAD_DKY if the dky vector is NULL. * IDA_BAD_K if the requested k is not in the range 0,1,...,order used * */ int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j, retval; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (dky == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > IDA_mem->ida_kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetDky", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz; tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; if ((t - tp)*IDA_mem->ida_hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetDky", MSG_BAD_T, t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; iida_tn; for(i=0; i<=k; i++) { /* The below reccurence is used to compute the k-th derivative of the solution: c_j^(k) = ( k * c_{j-1}^(k-1) + c_{j-1}^{k} (Delta+psi_{j-1}) ) / psi_j Translated in indexes notation: cjk[j] = ( k*cjk_1[j-1] + cjk[j-1]*(delt+psi[j-2]) ) / psi[j-1] For k=0, j=1: c_1 = c_0^(-1) + (delt+psi[-1]) / psi[0] In order to be able to deal with k=0 in the same way as for k>0, the following conventions were adopted: - c_0(t) = 1 , c_0^(-1)(t)=0 - psij_1 stands for psi[-1]=0 when j=1 for psi[j-2] when j>1 */ if(i==0) { cjk[i] = 1; psij_1 = 0; }else { /* i i-1 1 c_i^(i) can be always updated since c_i^(i) = ----- -------- ... ----- psi_j psi_{j-1} psi_1 */ cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1]; psij_1 = IDA_mem->ida_psi[i-1]; } /* update c_j^(i) */ /*j does not need to go till kused */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) { cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1]; psij_1 = IDA_mem->ida_psi[j-1]; } /* save existing c_j^(i)'s */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j]; } /* Compute sum (c_j(t) * phi(t)) */ retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k, IDA_mem->ida_phi+k, dky); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } /* * IDAGetQuad * * The following function can be called to obtain the quadrature * variables after a successful integration step. * * This is just a wrapper that calls IDAGetQuadDky with k=0. */ int IDAGetQuad(void *ida_mem, realtype *ptret, N_Vector yQout) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuad", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem)ida_mem; *ptret = IDA_mem->ida_tretlast; return IDAGetQuadDky(ida_mem, IDA_mem->ida_tretlast, 0, yQout); } /* * IDAGetQuadDky * * Returns the quadrature variables (or their * derivatives up to the current method order) at any time within * the last integration step (dense output). */ int IDAGetQuadDky(void *ida_mem, realtype t, int k, N_Vector dkyQ) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j, retval; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Ckeck if quadrature was initialized */ if (IDA_mem->ida_quadr != SUNTRUE) { IDAProcessError(IDA_mem, IDA_NO_QUAD, "IDAS", "IDAGetQuadDky", MSG_NO_QUAD); return(IDA_NO_QUAD); } if (dkyQ == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > IDA_mem->ida_kk)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadDky", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * IDA_mem->ida_uround * (IDA_mem->ida_tn + IDA_mem->ida_hh); tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; if ( (t - tp)*IDA_mem->ida_hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetQuadDky", MSG_BAD_T, t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; iida_tn; for(i=0; i<=k; i++) { if(i==0) { cjk[i] = 1; psij_1 = 0; }else { cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1]; psij_1 = IDA_mem->ida_psi[i-1]; } /* update c_j^(i) */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) { cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1]; psij_1 = IDA_mem->ida_psi[j-1]; } /* save existing c_j^(i)'s */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j]; } /* Compute sum (c_j(t) * phi(t)) */ retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k, IDA_mem->ida_phiQ+k, dkyQ); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } /* * IDAGetSens * * This routine extracts sensitivity solution into yySout at the * time at which IDASolve returned the solution. * This is just a wrapper that calls IDAGetSensDky1 with k=0 and * is=0, 1, ... ,NS-1. */ int IDAGetSens(void *ida_mem, realtype *ptret, N_Vector *yySout) { IDAMem IDA_mem; int is, ierr=0; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSens", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /*Check the parameters */ if (yySout == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetSens", MSG_NULL_DKY); return(IDA_BAD_DKY); } /* are sensitivities enabled? */ if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSens", MSG_NO_SENSI); return(IDA_NO_SENS); } *ptret = IDA_mem->ida_tretlast; for(is=0; isida_Ns; is++) if( IDA_SUCCESS != (ierr = IDAGetSensDky1(ida_mem, *ptret, 0, is, yySout[is])) ) break; return(ierr); } /* * IDAGetSensDky * * Computes the k-th derivative of all sensitivities of the y function at * time t. It repeatedly calls IDAGetSensDky1. The argument dkyS must be * a pointer to N_Vector and must be allocated by the user to hold at * least Ns vectors. */ int IDAGetSensDky(void *ida_mem, realtype t, int k, N_Vector *dkySout) { int is, ier=0; IDAMem IDA_mem; /* Check all inputs for legality */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensDky", MSG_NO_SENSI); return(IDA_NO_SENS); } if (dkySout == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetSensDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > IDA_mem->ida_kk)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetSensDky", MSG_BAD_K); return(IDA_BAD_K); } for (is=0; isida_Ns; is++) { ier = IDAGetSensDky1(ida_mem, t, k, is, dkySout[is]); if (ier!=IDA_SUCCESS) break; } return(ier); } /* * IDAGetSens1 * * This routine extracts the is-th sensitivity solution into ySout * at the time at which IDASolve returned the solution. * This is just a wrapper that calls IDASensDky1 with k=0. */ int IDAGetSens1(void *ida_mem, realtype *ptret, int is, N_Vector yySret) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSens1", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; *ptret = IDA_mem->ida_tretlast; return IDAGetSensDky1(ida_mem, *ptret, 0, is, yySret); } /* * IDAGetSensDky1 * * IDASensDky1 computes the kth derivative of the yS[is] function * at time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * is=0, 1, ..., Ns-1 and k=0, 1, ..., kk, where kk is the current * order. The derivative vector is returned in dky. This vector * must be allocated by the caller. It is only legal to call this * function after a successful return from IDASolve with sensitivity * computation enabled. */ int IDAGetSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyS) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j, retval; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check all inputs for legality */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSensDky1", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetSensDky1", MSG_NO_SENSI); return(IDA_NO_SENS); } if (dkyS == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetSensDky1", MSG_NULL_DKY); return(IDA_BAD_DKY); } /* Is the requested sensitivity index valid? */ if(is<0 || is >= IDA_mem->ida_Ns) { IDAProcessError(IDA_mem, IDA_BAD_IS, "IDAS", "IDAGetSensDky1", MSG_BAD_IS); } /* Is the requested order valid? */ if ((k < 0) || (k > IDA_mem->ida_kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetSensDky1", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz; tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; if ((t - tp)*IDA_mem->ida_hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetSensDky1", MSG_BAD_T, t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; iida_tn; for(i=0; i<=k; i++) { if(i==0) { cjk[i] = 1; psij_1 = 0; }else { cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1]; psij_1 = IDA_mem->ida_psi[i-1]; } /* Update cjk based on the reccurence */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) { cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1]; psij_1 = IDA_mem->ida_psi[j-1]; } /* Update cjk_1 for the next step */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j]; } /* Compute sum (c_j(t) * phi(t)) */ for(j=k; j<=IDA_mem->ida_kused; j++) IDA_mem->ida_Xvecs[j-k] = IDA_mem->ida_phiS[j][is]; retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k, IDA_mem->ida_Xvecs, dkyS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } /* * IDAGetQuadSens * * This routine extracts quadrature sensitivity solution into yyQSout at the * time at which IDASolve returned the solution. * This is just a wrapper that calls IDAGetQuadSensDky1 with k=0 and * is=0, 1, ... ,NS-1. */ int IDAGetQuadSens(void *ida_mem, realtype *ptret, N_Vector *yyQSout) { IDAMem IDA_mem; int is, ierr=0; /* Check ida_mem */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSens", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /*Check the parameters */ if (yyQSout == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSens", MSG_NULL_DKY); return(IDA_BAD_DKY); } /* are sensitivities enabled? */ if (IDA_mem->ida_quadr_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSens", MSG_NO_QUADSENSI); return(IDA_NO_SENS); } *ptret = IDA_mem->ida_tretlast; for(is=0; isida_Ns; is++) if( IDA_SUCCESS != (ierr = IDAGetQuadSensDky1(ida_mem, *ptret, 0, is, yyQSout[is])) ) break; return(ierr); } /* * IDAGetQuadSensDky * * Computes the k-th derivative of all quadratures sensitivities of the y function at * time t. It repeatedly calls IDAGetQuadSensDky. The argument dkyS must be * a pointer to N_Vector and must be allocated by the user to hold at * least Ns vectors. */ int IDAGetQuadSensDky(void *ida_mem, realtype t, int k, N_Vector *dkyQSout) { int is, ier=0; IDAMem IDA_mem; /* Check all inputs for legality */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensDky", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSensDky", MSG_NO_SENSI); return(IDA_NO_SENS); } if (IDA_mem->ida_quadr_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensDky", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } if (dkyQSout == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSensDky", MSG_NULL_DKY); return(IDA_BAD_DKY); } if ((k < 0) || (k > IDA_mem->ida_kk)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadSensDky", MSG_BAD_K); return(IDA_BAD_K); } for (is=0; isida_Ns; is++) { ier = IDAGetQuadSensDky1(ida_mem, t, k, is, dkyQSout[is]); if (ier!=IDA_SUCCESS) break; } return(ier); } /* * IDAGetQuadSens1 * * This routine extracts the is-th quadrature sensitivity solution into yQSout * at the time at which IDASolve returned the solution. * This is just a wrapper that calls IDASensDky1 with k=0. */ int IDAGetQuadSens1(void *ida_mem, realtype *ptret, int is, N_Vector yyQSret) { IDAMem IDA_mem; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSens1", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSens1", MSG_NO_SENSI); return(IDA_NO_SENS); } if (IDA_mem->ida_quadr_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSens1", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } if (yyQSret == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSens1", MSG_NULL_DKY); return(IDA_BAD_DKY); } *ptret = IDA_mem->ida_tretlast; return IDAGetQuadSensDky1(ida_mem, *ptret, 0, is, yyQSret); } /* * IDAGetQuadSensDky1 * * IDAGetQuadSensDky1 computes the kth derivative of the yS[is] function * at time t, where tn-hu <= t <= tn, tn denotes the current * internal time reached, and hu is the last internal step size * successfully used by the solver. The user may request * is=0, 1, ..., Ns-1 and k=0, 1, ..., kk, where kk is the current * order. The derivative vector is returned in dky. This vector * must be allocated by the caller. It is only legal to call this * function after a successful return from IDASolve with sensitivity * computation enabled. */ int IDAGetQuadSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyQS) { IDAMem IDA_mem; realtype tfuzz, tp, delt, psij_1; int i, j, retval; realtype cjk [MXORDP1]; realtype cjk_1[MXORDP1]; /* Check all inputs for legality */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetQuadSensDky1", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_SENS, "IDAS", "IDAGetQuadSensDky1", MSG_NO_SENSI); return(IDA_NO_SENS); } if (IDA_mem->ida_quadr_sensi==SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_QUADSENS, "IDAS", "IDAGetQuadSensDky1", MSG_NO_QUADSENSI); return(IDA_NO_QUADSENS); } if (dkyQS == NULL) { IDAProcessError(IDA_mem, IDA_BAD_DKY, "IDAS", "IDAGetQuadSensDky1", MSG_NULL_DKY); return(IDA_BAD_DKY); } /* Is the requested sensitivity index valid*/ if(is<0 || is >= IDA_mem->ida_Ns) { IDAProcessError(IDA_mem, IDA_BAD_IS, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_IS); } /* Is the requested order valid? */ if ((k < 0) || (k > IDA_mem->ida_kused)) { IDAProcessError(IDA_mem, IDA_BAD_K, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_K); return(IDA_BAD_K); } /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz; tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; if ((t - tp)*IDA_mem->ida_hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetQuadSensDky1", MSG_BAD_T, t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); return(IDA_BAD_T); } /* Initialize the c_j^(k) and c_k^(k-1) */ for(i=0; iida_tn; for(i=0; i<=k; i++) { if(i==0) { cjk[i] = 1; psij_1 = 0; }else { cjk[i] = cjk[i-1]*i / IDA_mem->ida_psi[i-1]; psij_1 = IDA_mem->ida_psi[i-1]; } /* Update cjk based on the reccurence */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) { cjk[j] = ( i* cjk_1[j-1] + cjk[j-1] * (delt + psij_1) ) / IDA_mem->ida_psi[j-1]; psij_1 = IDA_mem->ida_psi[j-1]; } /* Update cjk_1 for the next step */ for(j=i+1; j<=IDA_mem->ida_kused-k+i; j++) cjk_1[j] = cjk[j]; } /* Compute sum (c_j(t) * phi(t)) */ for(j=k; j<=IDA_mem->ida_kused; j++) IDA_mem->ida_Xvecs[j-k] = IDA_mem->ida_phiQS[j][is]; retval = N_VLinearCombination(IDA_mem->ida_kused-k+1, cjk+k, IDA_mem->ida_Xvecs, dkyQS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Deallocation functions * ----------------------------------------------------------------- */ /* * IDAFree * * This routine frees the problem memory allocated by IDAInit * Such memory includes all the vectors allocated by IDAAllocVectors, * and the memory lmem for the linear solver (deallocated by a call * to lfree). */ void IDAFree(void **ida_mem) { IDAMem IDA_mem; if (*ida_mem == NULL) return; IDA_mem = (IDAMem) (*ida_mem); IDAFreeVectors(IDA_mem); IDAQuadFree(IDA_mem); IDASensFree(IDA_mem); IDAQuadSensFree(IDA_mem); IDAAdjFree(IDA_mem); if (IDA_mem->ida_lfree != NULL) IDA_mem->ida_lfree(IDA_mem); if (IDA_mem->ida_nrtfn > 0) { free(IDA_mem->ida_glo); IDA_mem->ida_glo = NULL; free(IDA_mem->ida_ghi); IDA_mem->ida_ghi = NULL; free(IDA_mem->ida_grout); IDA_mem->ida_grout = NULL; free(IDA_mem->ida_iroots); IDA_mem->ida_iroots = NULL; free(IDA_mem->ida_rootdir); IDA_mem->ida_rootdir = NULL; free(IDA_mem->ida_gactive); IDA_mem->ida_gactive = NULL; } free(IDA_mem->ida_cvals); IDA_mem->ida_cvals = NULL; free(IDA_mem->ida_Xvecs); IDA_mem->ida_Xvecs = NULL; free(IDA_mem->ida_Zvecs); IDA_mem->ida_Zvecs = NULL; /* if IDA created the NLS object then free it */ if (IDA_mem->ownNLS) { SUNNonlinSolFree(IDA_mem->NLS); IDA_mem->ownNLS = SUNFALSE; IDA_mem->NLS = NULL; } free(*ida_mem); *ida_mem = NULL; } /* * IDAQuadFree * * IDAQuadFree frees the problem memory in ida_mem allocated * for quadrature integration. Its only argument is the pointer * ida_mem returned by IDACreate. */ void IDAQuadFree(void *ida_mem) { IDAMem IDA_mem; if (ida_mem == NULL) return; IDA_mem = (IDAMem) ida_mem; if(IDA_mem->ida_quadMallocDone) { IDAQuadFreeVectors(IDA_mem); IDA_mem->ida_quadMallocDone = SUNFALSE; IDA_mem->ida_quadr = SUNFALSE; } } /* * IDASensFree * * IDASensFree frees the problem memory in ida_mem allocated * for sensitivity analysis. Its only argument is the pointer * ida_mem returned by IDACreate. */ void IDASensFree(void *ida_mem) { IDAMem IDA_mem; /* return immediately if IDA memory is NULL */ if (ida_mem == NULL) return; IDA_mem = (IDAMem) ida_mem; if(IDA_mem->ida_sensMallocDone) { IDASensFreeVectors(IDA_mem); IDA_mem->ida_sensMallocDone = SUNFALSE; IDA_mem->ida_sensi = SUNFALSE; } /* free any vector wrappers */ if (IDA_mem->simMallocDone) { N_VDestroy(IDA_mem->ycor0Sim); IDA_mem->ycor0Sim = NULL; N_VDestroy(IDA_mem->ycorSim); IDA_mem->ycorSim = NULL; N_VDestroy(IDA_mem->ewtSim); IDA_mem->ewtSim = NULL; IDA_mem->simMallocDone = SUNFALSE; } if (IDA_mem->stgMallocDone) { N_VDestroy(IDA_mem->ycor0Stg); IDA_mem->ycor0Stg = NULL; N_VDestroy(IDA_mem->ycorStg); IDA_mem->ycorStg = NULL; N_VDestroy(IDA_mem->ewtStg); IDA_mem->ewtStg = NULL; IDA_mem->stgMallocDone = SUNFALSE; } /* if IDA created the NLS object then free it */ if (IDA_mem->ownNLSsim) { SUNNonlinSolFree(IDA_mem->NLSsim); IDA_mem->ownNLSsim = SUNFALSE; IDA_mem->NLSsim = NULL; } if (IDA_mem->ownNLSstg) { SUNNonlinSolFree(IDA_mem->NLSstg); IDA_mem->ownNLSstg = SUNFALSE; IDA_mem->NLSstg = NULL; } } /* * IDAQuadSensFree * * IDAQuadSensFree frees the problem memory in ida_mem allocated * for quadrature sensitivity analysis. Its only argument is the * pointer ida_mem returned by IDACreate. */ void IDAQuadSensFree(void* ida_mem) { IDAMem IDA_mem; if (ida_mem==NULL) return; IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_quadSensMallocDone) { IDAQuadSensFreeVectors(IDA_mem); IDA_mem->ida_quadSensMallocDone=SUNFALSE; IDA_mem->ida_quadr_sensi = SUNFALSE; } } /* * ================================================================= * PRIVATE FUNCTIONS * ================================================================= */ /* * IDACheckNvector * * This routine checks if all required vector operations are present. * If any of them is missing it returns SUNFALSE. */ static booleantype IDACheckNvector(N_Vector tmpl) { if ((tmpl->ops->nvclone == NULL) || (tmpl->ops->nvdestroy == NULL) || (tmpl->ops->nvlinearsum == NULL) || (tmpl->ops->nvconst == NULL) || (tmpl->ops->nvprod == NULL) || (tmpl->ops->nvscale == NULL) || (tmpl->ops->nvabs == NULL) || (tmpl->ops->nvinv == NULL) || (tmpl->ops->nvaddconst == NULL) || (tmpl->ops->nvwrmsnorm == NULL) || (tmpl->ops->nvmin == NULL)) return(SUNFALSE); else return(SUNTRUE); } /* * ----------------------------------------------------------------- * Memory allocation/deallocation * ----------------------------------------------------------------- */ /* * IDAAllocVectors * * This routine allocates the IDA vectors ewt, tempv1, tempv2, and * phi[0], ..., phi[maxord]. * If all memory allocations are successful, IDAAllocVectors returns * SUNTRUE. Otherwise all allocated memory is freed and IDAAllocVectors * returns SUNFALSE. * This routine also sets the optional outputs lrw and liw, which are * (respectively) the lengths of the real and integer work spaces * allocated here. */ static booleantype IDAAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j, maxcol; /* Allocate ewt, ee, delta, yypredict, yppredict, savres, tempv1, tempv2, tempv3 */ IDA_mem->ida_ewt = N_VClone(tmpl); if (IDA_mem->ida_ewt == NULL) return(SUNFALSE); IDA_mem->ida_ee = N_VClone(tmpl); if (IDA_mem->ida_ee == NULL) { N_VDestroy(IDA_mem->ida_ewt); return(SUNFALSE); } IDA_mem->ida_delta = N_VClone(tmpl); if (IDA_mem->ida_delta == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); return(SUNFALSE); } IDA_mem->ida_yypredict = N_VClone(tmpl); if (IDA_mem->ida_yypredict == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); return(SUNFALSE); } IDA_mem->ida_yppredict = N_VClone(tmpl); if (IDA_mem->ida_yppredict == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); N_VDestroy(IDA_mem->ida_yypredict); return(SUNFALSE); } IDA_mem->ida_savres = N_VClone(tmpl); if (IDA_mem->ida_savres == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); N_VDestroy(IDA_mem->ida_yypredict); N_VDestroy(IDA_mem->ida_yppredict); return(SUNFALSE); } IDA_mem->ida_tempv1 = N_VClone(tmpl); if (IDA_mem->ida_tempv1 == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); N_VDestroy(IDA_mem->ida_yypredict); N_VDestroy(IDA_mem->ida_yppredict); N_VDestroy(IDA_mem->ida_savres); return(SUNFALSE); } IDA_mem->ida_tempv2 = N_VClone(tmpl); if (IDA_mem->ida_tempv2 == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); N_VDestroy(IDA_mem->ida_yypredict); N_VDestroy(IDA_mem->ida_yppredict); N_VDestroy(IDA_mem->ida_savres); N_VDestroy(IDA_mem->ida_tempv1); return(SUNFALSE); } IDA_mem->ida_tempv3 = N_VClone(tmpl); if (IDA_mem->ida_tempv3 == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); N_VDestroy(IDA_mem->ida_yypredict); N_VDestroy(IDA_mem->ida_yppredict); N_VDestroy(IDA_mem->ida_savres); N_VDestroy(IDA_mem->ida_tempv1); N_VDestroy(IDA_mem->ida_tempv2); return(SUNFALSE); } /* Allocate phi[0] ... phi[maxord]. Make sure phi[2] and phi[3] are allocated (for use as temporary vectors), regardless of maxord. */ maxcol = SUNMAX(IDA_mem->ida_maxord,3); for (j=0; j <= maxcol; j++) { IDA_mem->ida_phi[j] = N_VClone(tmpl); if (IDA_mem->ida_phi[j] == NULL) { N_VDestroy(IDA_mem->ida_ewt); N_VDestroy(IDA_mem->ida_ee); N_VDestroy(IDA_mem->ida_delta); N_VDestroy(IDA_mem->ida_yypredict); N_VDestroy(IDA_mem->ida_yppredict); N_VDestroy(IDA_mem->ida_savres); N_VDestroy(IDA_mem->ida_tempv1); N_VDestroy(IDA_mem->ida_tempv2); N_VDestroy(IDA_mem->ida_tempv3); for (i=0; i < j; i++) N_VDestroy(IDA_mem->ida_phi[i]); return(SUNFALSE); } } /* Update solver workspace lengths */ IDA_mem->ida_lrw += (maxcol + 10)*IDA_mem->ida_lrw1; IDA_mem->ida_liw += (maxcol + 10)*IDA_mem->ida_liw1; /* Store the value of maxord used here */ IDA_mem->ida_maxord_alloc = IDA_mem->ida_maxord; return(SUNTRUE); } /* * IDAfreeVectors * * This routine frees the IDA vectors allocated for IDA. */ static void IDAFreeVectors(IDAMem IDA_mem) { int j, maxcol; N_VDestroy(IDA_mem->ida_ewt); IDA_mem->ida_ewt = NULL; N_VDestroy(IDA_mem->ida_ee); IDA_mem->ida_ee = NULL; N_VDestroy(IDA_mem->ida_delta); IDA_mem->ida_delta = NULL; N_VDestroy(IDA_mem->ida_yypredict); IDA_mem->ida_yypredict = NULL; N_VDestroy(IDA_mem->ida_yppredict); IDA_mem->ida_yppredict = NULL; N_VDestroy(IDA_mem->ida_savres); IDA_mem->ida_savres = NULL; N_VDestroy(IDA_mem->ida_tempv1); IDA_mem->ida_tempv1 = NULL; N_VDestroy(IDA_mem->ida_tempv2); IDA_mem->ida_tempv2 = NULL; N_VDestroy(IDA_mem->ida_tempv3); IDA_mem->ida_tempv3 = NULL; maxcol = SUNMAX(IDA_mem->ida_maxord_alloc,3); for(j=0; j <= maxcol; j++) { N_VDestroy(IDA_mem->ida_phi[j]); IDA_mem->ida_phi[j] = NULL; } IDA_mem->ida_lrw -= (maxcol + 10)*IDA_mem->ida_lrw1; IDA_mem->ida_liw -= (maxcol + 10)*IDA_mem->ida_liw1; if (IDA_mem->ida_VatolMallocDone) { N_VDestroy(IDA_mem->ida_Vatol); IDA_mem->ida_Vatol = NULL; IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; IDA_mem->ida_liw -= IDA_mem->ida_liw1; } if (IDA_mem->ida_constraintsMallocDone) { N_VDestroy(IDA_mem->ida_constraints); IDA_mem->ida_constraints = NULL; IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; IDA_mem->ida_liw -= IDA_mem->ida_liw1; } if (IDA_mem->ida_idMallocDone) { N_VDestroy(IDA_mem->ida_id); IDA_mem->ida_id = NULL; IDA_mem->ida_lrw -= IDA_mem->ida_lrw1; IDA_mem->ida_liw -= IDA_mem->ida_liw1; } } /* * IDAQuadAllocVectors * * NOTE: Space for ewtQ is allocated even when errconQ=SUNFALSE, * although in this case, ewtQ is never used. The reason for this * decision is to allow the user to re-initialize the quadrature * computation with errconQ=SUNTRUE, after an initialization with * errconQ=SUNFALSE, without new memory allocation within * IDAQuadReInit. */ static booleantype IDAQuadAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j; /* Allocate yyQ */ IDA_mem->ida_yyQ = N_VClone(tmpl); if (IDA_mem->ida_yyQ == NULL) { return (SUNFALSE); } /* Allocate ypQ */ IDA_mem->ida_ypQ = N_VClone(tmpl); if (IDA_mem->ida_ypQ == NULL) { N_VDestroy(IDA_mem->ida_yyQ); return (SUNFALSE); } /* Allocate ewtQ */ IDA_mem->ida_ewtQ = N_VClone(tmpl); if (IDA_mem->ida_ewtQ == NULL) { N_VDestroy(IDA_mem->ida_yyQ); N_VDestroy(IDA_mem->ida_ypQ); return (SUNFALSE); } /* Allocate eeQ */ IDA_mem->ida_eeQ = N_VClone(tmpl); if (IDA_mem->ida_eeQ == NULL) { N_VDestroy(IDA_mem->ida_yyQ); N_VDestroy(IDA_mem->ida_ypQ); N_VDestroy(IDA_mem->ida_ewtQ); return (SUNFALSE); } for (j=0; j <= IDA_mem->ida_maxord; j++) { IDA_mem->ida_phiQ[j] = N_VClone(tmpl); if (IDA_mem->ida_phiQ[j] == NULL) { N_VDestroy(IDA_mem->ida_yyQ); N_VDestroy(IDA_mem->ida_ypQ); N_VDestroy(IDA_mem->ida_ewtQ); N_VDestroy(IDA_mem->ida_eeQ); for (i=0; i < j; i++) N_VDestroy(IDA_mem->ida_phiQ[i]); return(SUNFALSE); } } IDA_mem->ida_lrw += (IDA_mem->ida_maxord+4)*IDA_mem->ida_lrw1Q; IDA_mem->ida_liw += (IDA_mem->ida_maxord+4)*IDA_mem->ida_liw1Q; return(SUNTRUE); } /* * IDAQuadFreeVectors * * This routine frees the IDAS vectors allocated in IDAQuadAllocVectors. */ static void IDAQuadFreeVectors(IDAMem IDA_mem) { int j; N_VDestroy(IDA_mem->ida_yyQ); IDA_mem->ida_yyQ = NULL; N_VDestroy(IDA_mem->ida_ypQ); IDA_mem->ida_ypQ = NULL; N_VDestroy(IDA_mem->ida_ewtQ); IDA_mem->ida_ewtQ = NULL; N_VDestroy(IDA_mem->ida_eeQ); IDA_mem->ida_eeQ = NULL; for(j=0; j <= IDA_mem->ida_maxord; j++) { N_VDestroy(IDA_mem->ida_phiQ[j]); IDA_mem->ida_phiQ[j] = NULL; } IDA_mem->ida_lrw -= (IDA_mem->ida_maxord+5)*IDA_mem->ida_lrw1Q; IDA_mem->ida_liw -= (IDA_mem->ida_maxord+5)*IDA_mem->ida_liw1Q; if (IDA_mem->ida_VatolQMallocDone) { N_VDestroy(IDA_mem->ida_VatolQ); IDA_mem->ida_VatolQ = NULL; IDA_mem->ida_lrw -= IDA_mem->ida_lrw1Q; IDA_mem->ida_liw -= IDA_mem->ida_liw1Q; } IDA_mem->ida_VatolQMallocDone = SUNFALSE; } /* * IDASensAllocVectors * * Allocates space for the N_Vectors, plist, and pbar required for FSA. */ static booleantype IDASensAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int j, maxcol; IDA_mem->ida_tmpS1 = IDA_mem->ida_tempv1; IDA_mem->ida_tmpS2 = IDA_mem->ida_tempv2; /* Allocate space for workspace vectors */ IDA_mem->ida_tmpS3 = N_VClone(tmpl); if (IDA_mem->ida_tmpS3==NULL) { return(SUNFALSE); } IDA_mem->ida_ewtS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_ewtS==NULL) { N_VDestroy(IDA_mem->ida_tmpS3); return(SUNFALSE); } IDA_mem->ida_eeS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_eeS==NULL) { N_VDestroy(IDA_mem->ida_tmpS3); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); return(SUNFALSE); } IDA_mem->ida_yyS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_yyS==NULL) { N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_tmpS3); return(SUNFALSE); } IDA_mem->ida_ypS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_ypS==NULL) { N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_tmpS3); return(SUNFALSE); } IDA_mem->ida_yySpredict = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_yySpredict==NULL) { N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_tmpS3); return(SUNFALSE); } IDA_mem->ida_ypSpredict = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_ypSpredict==NULL) { N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_tmpS3); return(SUNFALSE); } IDA_mem->ida_deltaS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_deltaS==NULL) { N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_tmpS3); return(SUNFALSE); } /* Update solver workspace lengths */ IDA_mem->ida_lrw += (5*IDA_mem->ida_Ns+1)*IDA_mem->ida_lrw1; IDA_mem->ida_liw += (5*IDA_mem->ida_Ns+1)*IDA_mem->ida_liw1; /* Allocate space for phiS */ /* Make sure phiS[2], phiS[3] and phiS[4] are allocated (for use as temporary vectors), regardless of maxord.*/ maxcol = SUNMAX(IDA_mem->ida_maxord,4); for (j=0; j <= maxcol; j++) { IDA_mem->ida_phiS[j] = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_phiS[j] == NULL) { N_VDestroy(IDA_mem->ida_tmpS3); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns); return(SUNFALSE); } } /* Update solver workspace lengths */ IDA_mem->ida_lrw += maxcol*IDA_mem->ida_Ns*IDA_mem->ida_lrw1; IDA_mem->ida_liw += maxcol*IDA_mem->ida_Ns*IDA_mem->ida_liw1; /* Allocate space for pbar and plist */ IDA_mem->ida_pbar = NULL; IDA_mem->ida_pbar = (realtype *)malloc(IDA_mem->ida_Ns*sizeof(realtype)); if (IDA_mem->ida_pbar == NULL) { N_VDestroy(IDA_mem->ida_tmpS3); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns); for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiS[j], IDA_mem->ida_Ns); return(SUNFALSE); } IDA_mem->ida_plist = NULL; IDA_mem->ida_plist = (int *)malloc(IDA_mem->ida_Ns*sizeof(int)); if (IDA_mem->ida_plist == NULL) { N_VDestroy(IDA_mem->ida_tmpS3); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns); for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiS[j], IDA_mem->ida_Ns); free(IDA_mem->ida_pbar); IDA_mem->ida_pbar = NULL; return(SUNFALSE); } /* Update solver workspace lengths */ IDA_mem->ida_lrw += IDA_mem->ida_Ns; IDA_mem->ida_liw += IDA_mem->ida_Ns; return(SUNTRUE); } /* * IDASensFreeVectors * * Frees memory allocated by IDASensAllocVectors. */ static void IDASensFreeVectors(IDAMem IDA_mem) { int j, maxcol; N_VDestroyVectorArray(IDA_mem->ida_deltaS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypSpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yySpredict, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_yyS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_tmpS3); maxcol = SUNMAX(IDA_mem->ida_maxord_alloc, 4); for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiS[j], IDA_mem->ida_Ns); free(IDA_mem->ida_pbar); IDA_mem->ida_pbar = NULL; free(IDA_mem->ida_plist); IDA_mem->ida_plist = NULL; IDA_mem->ida_lrw -= ( (maxcol+3)*IDA_mem->ida_Ns + 1 ) * IDA_mem->ida_lrw1 + IDA_mem->ida_Ns; IDA_mem->ida_liw -= ( (maxcol+3)*IDA_mem->ida_Ns + 1 ) * IDA_mem->ida_liw1 + IDA_mem->ida_Ns; if (IDA_mem->ida_VatolSMallocDone) { N_VDestroyVectorArray(IDA_mem->ida_VatolS, IDA_mem->ida_Ns); IDA_mem->ida_lrw -= IDA_mem->ida_Ns*IDA_mem->ida_lrw1; IDA_mem->ida_liw -= IDA_mem->ida_Ns*IDA_mem->ida_liw1; IDA_mem->ida_VatolSMallocDone = SUNFALSE; } if (IDA_mem->ida_SatolSMallocDone) { free(IDA_mem->ida_SatolS); IDA_mem->ida_SatolS = NULL; IDA_mem->ida_lrw -= IDA_mem->ida_Ns; IDA_mem->ida_SatolSMallocDone = SUNFALSE; } } /* * IDAQuadSensAllocVectors * * Create (through duplication) N_Vectors used for quadrature sensitivity analysis, * using the N_Vector 'tmpl' as a template. */ static booleantype IDAQuadSensAllocVectors(IDAMem IDA_mem, N_Vector tmpl) { int i, j, maxcol; /* Allocate yQS */ IDA_mem->ida_yyQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_yyQS == NULL) { return(SUNFALSE); } /* Allocate ewtQS */ IDA_mem->ida_ewtQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_ewtQS == NULL) { N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns); return(SUNFALSE); } /* Allocate tempvQS */ IDA_mem->ida_tempvQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_tempvQS == NULL) { N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns); return(SUNFALSE); } IDA_mem->ida_eeQS = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_eeQS == NULL) { N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns); return(SUNFALSE); } IDA_mem->ida_savrhsQ = N_VClone(tmpl); if (IDA_mem->ida_savrhsQ == NULL) { N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeQS, IDA_mem->ida_Ns); } maxcol = SUNMAX(IDA_mem->ida_maxord,4); /* Allocate phiQS */ for (j=0; j<=maxcol; j++) { IDA_mem->ida_phiQS[j] = N_VCloneVectorArray(IDA_mem->ida_Ns, tmpl); if (IDA_mem->ida_phiQS[j] == NULL) { N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeQS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_savrhsQ); for (i=0; iida_phiQS[i], IDA_mem->ida_Ns); return(SUNFALSE); } } /* Update solver workspace lengths */ IDA_mem->ida_lrw += (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q; IDA_mem->ida_liw += (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_liw1Q; return(SUNTRUE); } /* * IDAQuadSensFreeVectors * * This routine frees the IDAS vectors allocated in IDAQuadSensAllocVectors. */ static void IDAQuadSensFreeVectors(IDAMem IDA_mem) { int j, maxcol; maxcol = SUNMAX(IDA_mem->ida_maxord, 4); N_VDestroyVectorArray(IDA_mem->ida_yyQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ewtQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_eeQS, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_tempvQS, IDA_mem->ida_Ns); N_VDestroy(IDA_mem->ida_savrhsQ); for (j=0; j<=maxcol; j++) N_VDestroyVectorArray(IDA_mem->ida_phiQS[j], IDA_mem->ida_Ns); IDA_mem->ida_lrw -= (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q; IDA_mem->ida_liw -= (maxcol + 5)*IDA_mem->ida_Ns*IDA_mem->ida_liw1Q; if (IDA_mem->ida_VatolQSMallocDone) { N_VDestroyVectorArray(IDA_mem->ida_VatolQS, IDA_mem->ida_Ns); IDA_mem->ida_lrw -= IDA_mem->ida_Ns*IDA_mem->ida_lrw1Q; IDA_mem->ida_liw -= IDA_mem->ida_Ns*IDA_mem->ida_liw1Q; } if (IDA_mem->ida_SatolQSMallocDone) { free(IDA_mem->ida_SatolQS); IDA_mem->ida_SatolQS = NULL; IDA_mem->ida_lrw -= IDA_mem->ida_Ns; } IDA_mem->ida_VatolQSMallocDone = SUNFALSE; IDA_mem->ida_SatolQSMallocDone = SUNFALSE; } /* * ----------------------------------------------------------------- * Initial setup * ----------------------------------------------------------------- */ /* * IDAInitialSetup * * This routine is called by IDASolve once at the first step. * It performs all checks on optional inputs and inputs to * IDAInit/IDAReInit that could not be done before. * * If no merror is encountered, IDAInitialSetup returns IDA_SUCCESS. * Otherwise, it returns an error flag and reported to the error * handler function. */ int IDAInitialSetup(IDAMem IDA_mem) { booleantype conOK; int ier, retval; /* Test for more vector operations, depending on options */ if (IDA_mem->ida_suppressalg) if (IDA_mem->ida_phi[0]->ops->nvwrmsnormmask == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_NVECTOR); return(IDA_ILL_INPUT); } /* Test id vector for legality */ if (IDA_mem->ida_suppressalg && (IDA_mem->ida_id==NULL)){ IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_MISSING_ID); return(IDA_ILL_INPUT); } /* Did the user specify tolerances? */ if (IDA_mem->ida_itol == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLS); return(IDA_ILL_INPUT); } /* Set data for efun */ if (IDA_mem->ida_user_efun) IDA_mem->ida_edata = IDA_mem->ida_user_data; else IDA_mem->ida_edata = IDA_mem; /* Initial error weight vectors */ ier = IDA_mem->ida_efun(IDA_mem->ida_phi[0], IDA_mem->ida_ewt, IDA_mem->ida_edata); if (ier != 0) { if (IDA_mem->ida_itol == IDA_WF) IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_FAIL_EWT); else IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWT); return(IDA_ILL_INPUT); } if (IDA_mem->ida_quadr) { /* Evaluate quadrature rhs and set phiQ[1] */ retval = IDA_mem->ida_rhsQ(IDA_mem->ida_tn, IDA_mem->ida_phi[0], IDA_mem->ida_phi[1], IDA_mem->ida_phiQ[1], IDA_mem->ida_user_data); IDA_mem->ida_nrQe++; if (retval < 0) { IDAProcessError(IDA_mem, IDA_QRHS_FAIL, "IDAS", "IDAInitialSetup", MSG_QRHSFUNC_FAILED); return(IDA_QRHS_FAIL); } else if (retval > 0) { IDAProcessError(IDA_mem, IDA_FIRST_QRHS_ERR, "IDAS", "IDAInitialSetup", MSG_QRHSFUNC_FIRST); return(IDA_FIRST_QRHS_ERR); } if (IDA_mem->ida_errconQ) { /* Did the user specify tolerances? */ if (IDA_mem->ida_itolQ == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLQ); return(IDA_ILL_INPUT); } /* Load ewtQ */ ier = IDAQuadEwtSet(IDA_mem, IDA_mem->ida_phiQ[0], IDA_mem->ida_ewtQ); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWTQ); return(IDA_ILL_INPUT); } } } else { IDA_mem->ida_errconQ = SUNFALSE; } if (IDA_mem->ida_sensi) { /* Did the user specify tolerances? */ if (IDA_mem->ida_itolS == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLS); return(IDA_ILL_INPUT); } /* Load ewtS */ ier = IDASensEwtSet(IDA_mem, IDA_mem->ida_phiS[0], IDA_mem->ida_ewtS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWTS); return(IDA_ILL_INPUT); } } else { IDA_mem->ida_errconS = SUNFALSE; } if (IDA_mem->ida_quadr_sensi) { /* store the quadrature sensitivity residual. */ retval = IDA_mem->ida_rhsQS(IDA_mem->ida_Ns, IDA_mem->ida_tn, IDA_mem->ida_phi[0], IDA_mem->ida_phi[1], IDA_mem->ida_phiS[0], IDA_mem->ida_phiS[1], IDA_mem->ida_phiQ[1], IDA_mem->ida_phiQS[1], IDA_mem->ida_user_dataQS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); IDA_mem->ida_nrQSe++; if (retval < 0) { IDAProcessError(IDA_mem, IDA_QSRHS_FAIL, "IDAS", "IDAInitialSetup", MSG_QSRHSFUNC_FAILED); return(IDA_QRHS_FAIL); } else if (retval > 0) { IDAProcessError(IDA_mem, IDA_FIRST_QSRHS_ERR, "IDAS", "IDAInitialSetup", MSG_QSRHSFUNC_FIRST); return(IDA_FIRST_QSRHS_ERR); } /* If using the internal DQ functions, we must have access to fQ * (i.e. quadrature integration must be enabled) and to the problem parameters */ if (IDA_mem->ida_rhsQSDQ) { /* Test if quadratures are defined, so we can use fQ */ if (!IDA_mem->ida_quadr) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NULL_RHSQ); return(IDA_ILL_INPUT); } /* Test if we have the problem parameters */ if (IDA_mem->ida_p == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NULL_P); return(IDA_ILL_INPUT); } } if (IDA_mem->ida_errconQS) { /* Did the user specify tolerances? */ if (IDA_mem->ida_itolQS == IDA_NN) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLQS); return(IDA_ILL_INPUT); } /* If needed, did the user provide quadrature tolerances? */ if ( (IDA_mem->ida_itolQS == IDA_EE) && (IDA_mem->ida_itolQ == IDA_NN) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_NO_TOLQ); return(IDA_ILL_INPUT); } /* Load ewtS */ ier = IDAQuadSensEwtSet(IDA_mem, IDA_mem->ida_phiQS[0], IDA_mem->ida_ewtQS); if (ier != 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_EWTQS); return(IDA_ILL_INPUT); } } } else { IDA_mem->ida_errconQS = SUNFALSE; } /* Check to see if y0 satisfies constraints. */ if (IDA_mem->ida_constraintsSet) { if (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_BAD_ISM_CONSTR); return(IDA_ILL_INPUT); } conOK = N_VConstrMask(IDA_mem->ida_constraints, IDA_mem->ida_phi[0], IDA_mem->ida_tempv2); if (!conOK) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDAInitialSetup", MSG_Y0_FAIL_CONSTR); return(IDA_ILL_INPUT); } } /* Call linit function if it exists. */ if (IDA_mem->ida_linit != NULL) { retval = IDA_mem->ida_linit(IDA_mem); if (retval != 0) { IDAProcessError(IDA_mem, IDA_LINIT_FAIL, "IDAS", "IDAInitialSetup", MSG_LINIT_FAIL); return(IDA_LINIT_FAIL); } } /* Initialize the nonlinear solver (must occur after linear solver is initialize) so * that lsetup and lsolve pointers have been set */ /* always initialize the DAE NLS in case the user disables sensitivities later */ ier = idaNlsInit(IDA_mem); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDAInitialSetup", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } if (IDA_mem->NLSsim != NULL) { ier = idaNlsInitSensSim(IDA_mem); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDAInitialSetup", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } } if (IDA_mem->NLSstg != NULL) { ier = idaNlsInitSensStg(IDA_mem); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_NLS_INIT_FAIL, "IDAS", "IDAInitialSetup", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } } return(IDA_SUCCESS); } /* * IDAEwtSet * * This routine is responsible for loading the error weight vector * ewt, according to itol, as follows: * (1) ewt[i] = 1 / (rtol * SUNRabs(ycur[i]) + atol), i=0,...,Neq-1 * if itol = IDA_SS * (2) ewt[i] = 1 / (rtol * SUNRabs(ycur[i]) + atol[i]), i=0,...,Neq-1 * if itol = IDA_SV * * IDAEwtSet returns 0 if ewt is successfully set as above to a * positive vector and -1 otherwise. In the latter case, ewt is * considered undefined. * * All the real work is done in the routines IDAEwtSetSS, IDAEwtSetSV. */ int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data) { IDAMem IDA_mem; int flag = 0; /* data points to IDA_mem here */ IDA_mem = (IDAMem) data; switch(IDA_mem->ida_itol) { case IDA_SS: flag = IDAEwtSetSS(IDA_mem, ycur, weight); break; case IDA_SV: flag = IDAEwtSetSV(IDA_mem, ycur, weight); break; } return(flag); } /* * IDAEwtSetSS * * This routine sets ewt as decribed above in the case itol=IDA_SS. * It tests for non-positive components before inverting. IDAEwtSetSS * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered * undefined. */ static int IDAEwtSetSS(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, IDA_mem->ida_tempv1); N_VScale(IDA_mem->ida_rtol, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1); N_VAddConst(IDA_mem->ida_tempv1, IDA_mem->ida_Satol, IDA_mem->ida_tempv1); if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1); N_VInv(IDA_mem->ida_tempv1, weight); return(0); } /* * IDAEwtSetSV * * This routine sets ewt as decribed above in the case itol=IDA_SV. * It tests for non-positive components before inverting. IDAEwtSetSV * returns 0 if ewt is successfully set to a positive vector * and -1 otherwise. In the latter case, ewt is considered * undefined. */ static int IDAEwtSetSV(IDAMem IDA_mem, N_Vector ycur, N_Vector weight) { N_VAbs(ycur, IDA_mem->ida_tempv1); N_VLinearSum(IDA_mem->ida_rtol, IDA_mem->ida_tempv1, ONE, IDA_mem->ida_Vatol, IDA_mem->ida_tempv1); if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1); N_VInv(IDA_mem->ida_tempv1, weight); return(0); } /* * IDAQuadEwtSet * */ static int IDAQuadEwtSet(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ) { int flag=0; switch (IDA_mem->ida_itolQ) { case IDA_SS: flag = IDAQuadEwtSetSS(IDA_mem, qcur, weightQ); break; case IDA_SV: flag = IDAQuadEwtSetSV(IDA_mem, qcur, weightQ); break; } return(flag); } /* * IDAQuadEwtSetSS * */ static int IDAQuadEwtSetSS(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ) { N_Vector tempvQ; /* Use ypQ as temporary storage */ tempvQ = IDA_mem->ida_ypQ; N_VAbs(qcur, tempvQ); N_VScale(IDA_mem->ida_rtolQ, tempvQ, tempvQ); N_VAddConst(tempvQ, IDA_mem->ida_SatolQ, tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQ); return(0); } /* * IDAQuadEwtSetSV * */ static int IDAQuadEwtSetSV(IDAMem IDA_mem, N_Vector qcur, N_Vector weightQ) { N_Vector tempvQ; /* Use ypQ as temporary storage */ tempvQ = IDA_mem->ida_ypQ; N_VAbs(qcur, tempvQ); N_VLinearSum(IDA_mem->ida_rtolQ, tempvQ, ONE, IDA_mem->ida_VatolQ, tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQ); return(0); } /* * IDASensEwtSet * */ int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS) { int flag=0; switch (IDA_mem->ida_itolS) { case IDA_EE: flag = IDASensEwtSetEE(IDA_mem, yScur, weightS); break; case IDA_SS: flag = IDASensEwtSetSS(IDA_mem, yScur, weightS); break; case IDA_SV: flag = IDASensEwtSetSV(IDA_mem, yScur, weightS); break; } return(flag); } /* * IDASensEwtSetEE * * In this case, the error weight vector for the i-th sensitivity is set to * * ewtS_i = pbar_i * efun(pbar_i*yS_i) * * In other words, the scaled sensitivity pbar_i * yS_i has the same error * weight vector calculation as the solution vector. * */ static int IDASensEwtSetEE(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS) { int is; N_Vector pyS; int flag; /* Use tempv1 as temporary storage for the scaled sensitivity */ pyS = IDA_mem->ida_tempv1; for (is=0; isida_Ns; is++) { N_VScale(IDA_mem->ida_pbar[is], yScur[is], pyS); flag = IDA_mem->ida_efun(pyS, weightS[is], IDA_mem->ida_edata); if (flag != 0) return(-1); N_VScale(IDA_mem->ida_pbar[is], weightS[is], weightS[is]); } return(0); } /* * IDASensEwtSetSS * */ static int IDASensEwtSetSS(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS) { int is; for (is=0; isida_Ns; is++) { N_VAbs(yScur[is], IDA_mem->ida_tempv1); N_VScale(IDA_mem->ida_rtolS, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1); N_VAddConst(IDA_mem->ida_tempv1, IDA_mem->ida_SatolS[is], IDA_mem->ida_tempv1); if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1); N_VInv(IDA_mem->ida_tempv1, weightS[is]); } return(0); } /* * IDASensEwtSetSV * */ static int IDASensEwtSetSV(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS) { int is; for (is=0; isida_Ns; is++) { N_VAbs(yScur[is], IDA_mem->ida_tempv1); N_VLinearSum(IDA_mem->ida_rtolS, IDA_mem->ida_tempv1, ONE, IDA_mem->ida_VatolS[is], IDA_mem->ida_tempv1); if (N_VMin(IDA_mem->ida_tempv1) <= ZERO) return(-1); N_VInv(IDA_mem->ida_tempv1, weightS[is]); } return(0); } /* * IDAQuadSensEwtSet * */ int IDAQuadSensEwtSet(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS) { int flag=0; switch (IDA_mem->ida_itolQS) { case IDA_EE: flag = IDAQuadSensEwtSetEE(IDA_mem, yQScur, weightQS); break; case IDA_SS: flag = IDAQuadSensEwtSetSS(IDA_mem, yQScur, weightQS); break; case IDA_SV: flag = IDAQuadSensEwtSetSV(IDA_mem, yQScur, weightQS); break; } return(flag); } /* * IDAQuadSensEwtSetEE * * In this case, the error weight vector for the i-th quadrature sensitivity * is set to * * ewtQS_i = pbar_i * IDAQuadEwtSet(pbar_i*yQS_i) * * In other words, the scaled sensitivity pbar_i * yQS_i has the same error * weight vector calculation as the quadrature vector. * */ static int IDAQuadSensEwtSetEE(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS) { int is; N_Vector pyS; int flag; /* Use tempvQS[0] as temporary storage for the scaled sensitivity */ pyS = IDA_mem->ida_tempvQS[0]; for (is=0; isida_Ns; is++) { N_VScale(IDA_mem->ida_pbar[is], yQScur[is], pyS); flag = IDAQuadEwtSet(IDA_mem, pyS, weightQS[is]); if (flag != 0) return(-1); N_VScale(IDA_mem->ida_pbar[is], weightQS[is], weightQS[is]); } return(0); } static int IDAQuadSensEwtSetSS(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS) { int is; N_Vector tempvQ; /* Use ypQ as temporary storage */ tempvQ = IDA_mem->ida_ypQ; for (is=0; isida_Ns; is++) { N_VAbs(yQScur[is], tempvQ); N_VScale(IDA_mem->ida_rtolQS, tempvQ, tempvQ); N_VAddConst(tempvQ, IDA_mem->ida_SatolQS[is], tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQS[is]); } return(0); } static int IDAQuadSensEwtSetSV(IDAMem IDA_mem, N_Vector *yQScur, N_Vector *weightQS) { int is; N_Vector tempvQ; /* Use ypQ as temporary storage */ tempvQ = IDA_mem->ida_ypQ; for (is=0; isida_Ns; is++) { N_VAbs(yQScur[is], tempvQ); N_VLinearSum(IDA_mem->ida_rtolQS, tempvQ, ONE, IDA_mem->ida_VatolQS[is], tempvQ); if (N_VMin(tempvQ) <= ZERO) return(-1); N_VInv(tempvQ, weightQS[is]); } return(0); } /* * ----------------------------------------------------------------- * Stopping tests * ----------------------------------------------------------------- */ /* * IDAStopTest1 * * This routine tests for stop conditions before taking a step. * The tests depend on the value of itask. * The variable tretlast is the previously returned value of tret. * * The return values are: * CONTINUE_STEPS if no stop conditions were found * IDA_SUCCESS for a normal return to the user * IDA_TSTOP_RETURN for a tstop-reached return to the user * IDA_ILL_INPUT for an illegal-input return to the user * * In the tstop cases, this routine may adjust the stepsize hh to cause * the next step to reach tstop exactly. */ static int IDAStopTest1(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { int ier; realtype troundoff; switch (itask) { case IDA_NORMAL: if (IDA_mem->ida_tstopset) { /* Test for tn past tstop, tn = tretlast, tn past tout, tn near tstop. */ if ( (IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } } /* Test for tout = tretlast, and for tn past tout. */ if (tout == IDA_mem->ida_tretlast) { *tret = IDA_mem->ida_tretlast = tout; return(IDA_SUCCESS); } if ((IDA_mem->ida_tn - tout)*IDA_mem->ida_hh >= ZERO) { ier = IDAGetSolution(IDA_mem, tout, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TOUT, tout); return(IDA_ILL_INPUT); } *tret = IDA_mem->ida_tretlast = tout; return(IDA_SUCCESS); } if (IDA_mem->ida_tstopset) { troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; IDA_mem->ida_tstopset = SUNFALSE; return(IDA_TSTOP_RETURN); } if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); } return(CONTINUE_STEPS); case IDA_ONE_STEP: if (IDA_mem->ida_tstopset) { /* Test for tn past tstop, tn past tretlast, and tn near tstop. */ if ((IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } } /* Test for tn past tretlast. */ if ((IDA_mem->ida_tn - IDA_mem->ida_tretlast)*IDA_mem->ida_hh > ZERO) { ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tn, yret, ypret); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; return(IDA_SUCCESS); } if (IDA_mem->ida_tstopset) { troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { ier = IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); if (ier != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDA", "IDASolve", MSG_BAD_TSTOP, IDA_mem->ida_tstop, IDA_mem->ida_tn); return(IDA_ILL_INPUT); } *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; IDA_mem->ida_tstopset = SUNFALSE; return(IDA_TSTOP_RETURN); } if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); } return(CONTINUE_STEPS); } return(IDA_ILL_INPUT); /* This return should never happen. */ } /* * IDAStopTest2 * * This routine tests for stop conditions after taking a step. * The tests depend on the value of itask. * * The return values are: * CONTINUE_STEPS if no stop conditions were found * IDA_SUCCESS for a normal return to the user * IDA_TSTOP_RETURN for a tstop-reached return to the user * IDA_ILL_INPUT for an illegal-input return to the user * * In the two cases with tstop, this routine may reset the stepsize hh * to cause the next step to reach tstop exactly. * * In the two cases with ONE_STEP mode, no interpolation to tn is needed * because yret and ypret already contain the current y and y' values. * * Note: No test is made for an error return from IDAGetSolution here, * because the same test was made prior to the step. */ static int IDAStopTest2(IDAMem IDA_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask) { /* int ier; */ realtype troundoff; switch (itask) { case IDA_NORMAL: /* Test for tn past tout. */ if ((IDA_mem->ida_tn - tout)*IDA_mem->ida_hh >= ZERO) { /* ier = */ IDAGetSolution(IDA_mem, tout, yret, ypret); *tret = IDA_mem->ida_tretlast = tout; return(IDA_SUCCESS); } if (IDA_mem->ida_tstopset) { /* Test for tn at tstop and for tn near tstop */ troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { /* ier = */ IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; IDA_mem->ida_tstopset = SUNFALSE; return(IDA_TSTOP_RETURN); } if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); } return(CONTINUE_STEPS); case IDA_ONE_STEP: if (IDA_mem->ida_tstopset) { /* Test for tn at tstop and for tn near tstop */ troundoff = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (SUNRabs(IDA_mem->ida_tn - IDA_mem->ida_tstop) <= troundoff) { /* ier = */ IDAGetSolution(IDA_mem, IDA_mem->ida_tstop, yret, ypret); *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tstop; IDA_mem->ida_tstopset = SUNFALSE; return(IDA_TSTOP_RETURN); } if ((IDA_mem->ida_tn + IDA_mem->ida_hh - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) IDA_mem->ida_hh = (IDA_mem->ida_tstop - IDA_mem->ida_tn)*(ONE - FOUR * IDA_mem->ida_uround); } *tret = IDA_mem->ida_tretlast = IDA_mem->ida_tn; return(IDA_SUCCESS); } return IDA_ILL_INPUT; /* This return should never happen. */ } /* * ----------------------------------------------------------------- * Error handler * ----------------------------------------------------------------- */ /* * IDAHandleFailure * * This routine prints error messages for all cases of failure by * IDAStep. It returns to IDASolve the value that it is to return to * the user. */ static int IDAHandleFailure(IDAMem IDA_mem, int sflag) { /* Depending on sflag, print error message and return error flag */ switch (sflag) { case IDA_ERR_FAIL: IDAProcessError(IDA_mem, IDA_ERR_FAIL, "IDAS", "IDASolve", MSG_ERR_FAILS, IDA_mem->ida_tn, IDA_mem->ida_hh); return(IDA_ERR_FAIL); case IDA_CONV_FAIL: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDAS", "IDASolve", MSG_CONV_FAILS, IDA_mem->ida_tn, IDA_mem->ida_hh); return(IDA_CONV_FAIL); case IDA_LSETUP_FAIL: IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDAS", "IDASolve", MSG_SETUP_FAILED, IDA_mem->ida_tn); return(IDA_LSETUP_FAIL); case IDA_LSOLVE_FAIL: IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDAS", "IDASolve", MSG_SOLVE_FAILED, IDA_mem->ida_tn); return(IDA_LSOLVE_FAIL); case IDA_REP_RES_ERR: IDAProcessError(IDA_mem, IDA_REP_RES_ERR, "IDAS", "IDASolve", MSG_REP_RES_ERR, IDA_mem->ida_tn); return(IDA_REP_RES_ERR); case IDA_RES_FAIL: IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDAS", "IDASolve", MSG_RES_NONRECOV, IDA_mem->ida_tn); return(IDA_RES_FAIL); case IDA_CONSTR_FAIL: IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDAS", "IDASolve", MSG_FAILED_CONSTR, IDA_mem->ida_tn); return(IDA_CONSTR_FAIL); case IDA_MEM_NULL: IDAProcessError(NULL, IDA_MEM_NULL, "IDA", "IDASolve", MSG_NO_MEM); return(IDA_MEM_NULL); case SUN_NLS_MEM_NULL: IDAProcessError(IDA_mem, IDA_MEM_NULL, "IDA", "IDASolve", MSG_NLS_INPUT_NULL, IDA_mem->ida_tn); return(IDA_MEM_NULL); case IDA_NLS_SETUP_FAIL: IDAProcessError(IDA_mem, IDA_NLS_SETUP_FAIL, "IDA", "IDASolve", MSG_NLS_SETUP_FAILED, IDA_mem->ida_tn); return(IDA_NLS_SETUP_FAIL); } /* This return should never happen */ IDAProcessError(IDA_mem, IDA_UNRECOGNIZED_ERROR, "IDA", "IDASolve", "IDA encountered an unrecognized error. Please report this to the Sundials developers at sundials-users@llnl.gov"); return (IDA_UNRECOGNIZED_ERROR); } /* * ----------------------------------------------------------------- * Main IDAStep function * ----------------------------------------------------------------- */ /* * IDAStep * * This routine performs one internal IDA step, from tn to tn + hh. * It calls other routines to do all the work. * * It solves a system of differential/algebraic equations of the form * F(t,y,y') = 0, for one step. In IDA, tt is used for t, * yy is used for y, and yp is used for y'. The function F is supplied as 'res' * by the user. * * The methods used are modified divided difference, fixed leading * coefficient forms of backward differentiation formulas. * The code adjusts the stepsize and order to control the local error per step. * * The main operations done here are as follows: * * initialize various quantities; * * setting of multistep method coefficients; * * solution of the nonlinear system for yy at t = tn + hh; * * deciding on order reduction and testing the local error; * * attempting to recover from failure in nonlinear solver or error test; * * resetting stepsize and order for the next step. * * updating phi and other state data if successful; * * On a failure in the nonlinear system solution or error test, the * step may be reattempted, depending on the nature of the failure. * * Variables or arrays (all in the IDAMem structure) used in IDAStep are: * * tt -- Independent variable. * yy -- Solution vector at tt. * yp -- Derivative of solution vector after successful stelp. * res -- User-supplied function to evaluate the residual. See the * description given in file ida.h . * lsetup -- Routine to prepare for the linear solver call. It may either * save or recalculate quantities used by lsolve. (Optional) * lsolve -- Routine to solve a linear system. A prior call to lsetup * may be required. * hh -- Appropriate step size for next step. * ewt -- Vector of weights used in all convergence tests. * phi -- Array of divided differences used by IDAStep. This array is composed * of (maxord+1) nvectors (each of size Neq). (maxord+1) is the maximum * order for the problem, maxord, plus 1. * * Return values are: * IDA_SUCCESS IDA_RES_FAIL LSETUP_ERROR_NONRECVR * IDA_LSOLVE_FAIL IDA_ERR_FAIL * IDA_CONSTR_FAIL IDA_CONV_FAIL * IDA_REP_RES_ERR */ static int IDAStep(IDAMem IDA_mem) { realtype saved_t, ck; realtype err_k, err_km1, err_km2; int ncf, nef; int nflag, kflag; int retval; booleantype sensi_stg, sensi_sim; /* Are we computing sensitivities with the staggered or simultaneous approach? */ sensi_stg = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_STAGGERED)); sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); saved_t = IDA_mem->ida_tn; ncf = nef = 0; if (IDA_mem->ida_nst == ZERO){ IDA_mem->ida_kk = 1; IDA_mem->ida_kused = 0; IDA_mem->ida_hused = ZERO; IDA_mem->ida_psi[0] = IDA_mem->ida_hh; IDA_mem->ida_cj = ONE/IDA_mem->ida_hh; IDA_mem->ida_phase = 0; IDA_mem->ida_ns = 0; } /* To prevent 'unintialized variable' warnings */ err_k = ZERO; err_km1 = ZERO; err_km2 = ZERO; /* Looping point for attempts to take a step */ for(;;) { /*----------------------- Set method coefficients -----------------------*/ IDASetCoeffs(IDA_mem, &ck); kflag = IDA_SUCCESS; /*---------------------------------------------------- If tn is past tstop (by roundoff), reset it to tstop. -----------------------------------------------------*/ IDA_mem->ida_tn = IDA_mem->ida_tn + IDA_mem->ida_hh; if (IDA_mem->ida_tstopset) { if ((IDA_mem->ida_tn - IDA_mem->ida_tstop)*IDA_mem->ida_hh > ZERO) IDA_mem->ida_tn = IDA_mem->ida_tstop; } /*----------------------- Advance state variables -----------------------*/ /* Compute predicted values for yy and yp */ IDAPredict(IDA_mem); /* Compute predicted values for yyS and ypS (if simultaneous approach) */ if (sensi_sim) IDASensPredict(IDA_mem, IDA_mem->ida_yySpredict, IDA_mem->ida_ypSpredict); /* Nonlinear system solution */ nflag = IDANls(IDA_mem); /* If NLS was successful, perform error test */ if (nflag == IDA_SUCCESS) nflag = IDATestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &(IDA_mem->ida_ncfn), &ncf, &(IDA_mem->ida_netf), &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(IDA_mem->ida_nst==0) IDAReset(IDA_mem); continue; } /*---------------------------- Advance quadrature variables ----------------------------*/ if (IDA_mem->ida_quadr) { nflag = IDAQuadNls(IDA_mem); /* If NLS was successful, perform error test */ if (IDA_mem->ida_errconQ && (nflag == IDA_SUCCESS)) nflag = IDAQuadTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &(IDA_mem->ida_ncfnQ), &ncf, &(IDA_mem->ida_netfQ), &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(IDA_mem->ida_nst==0) IDAReset(IDA_mem); continue; } } /*-------------------------------------------------- Advance sensitivity variables (Staggered approach) --------------------------------------------------*/ if (sensi_stg) { /* Evaluate res at converged y, needed for future evaluations of sens. RHS If res() fails recoverably, treat it as a convergence failure and attempt the step again */ retval = IDA_mem->ida_res(IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_delta, IDA_mem->ida_user_data); if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) continue; /* Compute predicted values for yyS and ypS */ IDASensPredict(IDA_mem, IDA_mem->ida_yySpredict, IDA_mem->ida_ypSpredict); /* Nonlinear system solution */ nflag = IDASensNls(IDA_mem); /* If NLS was successful, perform error test */ if (IDA_mem->ida_errconS && (nflag == IDA_SUCCESS)) nflag = IDASensTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &(IDA_mem->ida_ncfnQ), &ncf, &(IDA_mem->ida_netfQ), &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(IDA_mem->ida_nst==0) IDAReset(IDA_mem); continue; } } /*------------------------------------------- Advance quadrature sensitivity variables -------------------------------------------*/ if (IDA_mem->ida_quadr_sensi) { nflag = IDAQuadSensNls(IDA_mem); /* If NLS was successful, perform error test */ if (IDA_mem->ida_errconQS && (nflag == IDA_SUCCESS)) nflag = IDAQuadSensTestError(IDA_mem, ck, &err_k, &err_km1, &err_km2); /* Test for convergence or error test failures */ if (nflag != IDA_SUCCESS) { /* restore and decide what to do */ IDARestore(IDA_mem, saved_t); kflag = IDAHandleNFlag(IDA_mem, nflag, err_k, err_km1, &(IDA_mem->ida_ncfnQ), &ncf, &(IDA_mem->ida_netfQ), &nef); /* exit on nonrecoverable failure */ if (kflag != PREDICT_AGAIN) return(kflag); /* recoverable error; predict again */ if(IDA_mem->ida_nst==0) IDAReset(IDA_mem); continue; } } /* kflag == IDA_SUCCESS */ break; } /* end loop */ /* Nonlinear system solve and error test were both successful; update data, and consider change of step and/or order */ IDACompleteStep(IDA_mem, err_k, err_km1); /* Rescale ee vector to be the estimated local error Notes: (1) altering the value of ee is permissible since it will be overwritten by IDASolve()->IDAStep()->IDANls() before it is needed again (2) the value of ee is only valid if IDAHandleNFlag() returns either PREDICT_AGAIN or IDA_SUCCESS */ N_VScale(ck, IDA_mem->ida_ee, IDA_mem->ida_ee); return(IDA_SUCCESS); } /* * IDAGetSolution * * This routine evaluates y(t) and y'(t) as the value and derivative of * the interpolating polynomial at the independent variable t, and stores * the results in the vectors yret and ypret. It uses the current * independent variable value, tn, and the method order last used, kused. * This function is called by IDASolve with t = tout, t = tn, or t = tstop. * * If kused = 0 (no step has been taken), or if t = tn, then the order used * here is taken to be 1, giving yret = phi[0], ypret = phi[1]/psi[0]. * * The return values are: * IDA_SUCCESS if t is legal, or * IDA_BAD_T if t is not within the interval of the last step taken. */ int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret) { IDAMem IDA_mem; realtype tfuzz, tp, delt, c, d, gam; int j, kord, retval; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDAGetSolution", MSG_NO_MEM); return (IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check t for legality. Here tn - hused is t_{n-1}. */ tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)); if (IDA_mem->ida_hh < ZERO) tfuzz = - tfuzz; tp = IDA_mem->ida_tn - IDA_mem->ida_hused - tfuzz; if ((t - tp)*IDA_mem->ida_hh < ZERO) { IDAProcessError(IDA_mem, IDA_BAD_T, "IDAS", "IDAGetSolution", MSG_BAD_T, t, IDA_mem->ida_tn-IDA_mem->ida_hused, IDA_mem->ida_tn); return(IDA_BAD_T); } /* Initialize kord = (kused or 1). */ kord = IDA_mem->ida_kused; if (IDA_mem->ida_kused == 0) kord = 1; /* Accumulate multiples of columns phi[j] into yret and ypret. */ delt = t - IDA_mem->ida_tn; c = ONE; d = ZERO; gam = delt / IDA_mem->ida_psi[0]; IDA_mem->ida_cvals[0] = c; for (j=1; j <= kord; j++) { d = d*gam + c / IDA_mem->ida_psi[j-1]; c = c*gam; gam = (delt + IDA_mem->ida_psi[j-1]) / IDA_mem->ida_psi[j]; IDA_mem->ida_cvals[j] = c; IDA_mem->ida_dvals[j-1] = d; } retval = N_VLinearCombination(kord+1, IDA_mem->ida_cvals, IDA_mem->ida_phi, yret); if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR); retval = N_VLinearCombination(kord, IDA_mem->ida_dvals, IDA_mem->ida_phi+1, ypret); if (retval != IDA_SUCCESS) return(IDA_VECTOROP_ERR); return(IDA_SUCCESS); } /* * IDASetCoeffs * * This routine computes the coefficients relevant to the current step. * The counter ns counts the number of consecutive steps taken at * constant stepsize h and order k, up to a maximum of k + 2. * Then the first ns components of beta will be one, and on a step * with ns = k + 2, the coefficients alpha, etc. need not be reset here. * Also, IDACompleteStep prohibits an order increase until ns = k + 2. */ static void IDASetCoeffs(IDAMem IDA_mem, realtype *ck) { int i, j, is; realtype temp1, temp2, alpha0, alphas; /* Set coefficients for the current stepsize h */ if ( (IDA_mem->ida_hh != IDA_mem->ida_hused) || (IDA_mem->ida_kk != IDA_mem->ida_kused) ) IDA_mem->ida_ns = 0; IDA_mem->ida_ns = SUNMIN(IDA_mem->ida_ns+1, IDA_mem->ida_kused+2); if (IDA_mem->ida_kk+1 >= IDA_mem->ida_ns) { IDA_mem->ida_beta[0] = ONE; IDA_mem->ida_alpha[0] = ONE; temp1 = IDA_mem->ida_hh; IDA_mem->ida_gamma[0] = ZERO; IDA_mem->ida_sigma[0] = ONE; for(i=1;i<=IDA_mem->ida_kk;i++){ temp2 = IDA_mem->ida_psi[i-1]; IDA_mem->ida_psi[i-1] = temp1; IDA_mem->ida_beta[i] = IDA_mem->ida_beta[i-1] * IDA_mem->ida_psi[i-1] / temp2; temp1 = temp2 + IDA_mem->ida_hh; IDA_mem->ida_alpha[i] = IDA_mem->ida_hh / temp1; IDA_mem->ida_sigma[i] = i * IDA_mem->ida_sigma[i-1] * IDA_mem->ida_alpha[i]; IDA_mem->ida_gamma[i] = IDA_mem->ida_gamma[i-1] + IDA_mem->ida_alpha[i-1] / IDA_mem->ida_hh; } IDA_mem->ida_psi[IDA_mem->ida_kk] = temp1; } /* compute alphas, alpha0 */ alphas = ZERO; alpha0 = ZERO; for(i=0;iida_kk;i++){ alphas = alphas - ONE/(i+1); alpha0 = alpha0 - IDA_mem->ida_alpha[i]; } /* compute leading coefficient cj */ IDA_mem->ida_cjlast = IDA_mem->ida_cj; IDA_mem->ida_cj = -alphas/IDA_mem->ida_hh; /* compute variable stepsize error coefficient ck */ *ck = SUNRabs(IDA_mem->ida_alpha[IDA_mem->ida_kk] + alphas - alpha0); *ck = SUNMAX(*ck, IDA_mem->ida_alpha[IDA_mem->ida_kk]); /* change phi to phi-star */ if (IDA_mem->ida_ns <= IDA_mem->ida_kk) { for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) IDA_mem->ida_cvals[i-IDA_mem->ida_ns] = IDA_mem->ida_beta[i]; (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1, IDA_mem->ida_cvals, IDA_mem->ida_phi+IDA_mem->ida_ns, IDA_mem->ida_phi+IDA_mem->ida_ns); if (IDA_mem->ida_quadr) (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1, IDA_mem->ida_cvals, IDA_mem->ida_phiQ+IDA_mem->ida_ns, IDA_mem->ida_phiQ+IDA_mem->ida_ns); if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) { j = 0; for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) { for(is=0; isida_Ns; is++) { IDA_mem->ida_cvals[j] = IDA_mem->ida_beta[i]; j++; } } } if (IDA_mem->ida_sensi) { j = 0; for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) { for(is=0; isida_Ns; is++) { IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiS[i][is]; j++; } } (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs, IDA_mem->ida_Xvecs); } if (IDA_mem->ida_quadr_sensi) { j = 0; for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) { for(is=0; isida_Ns; is++) { IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiQS[i][is]; j++; } } (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs, IDA_mem->ida_Xvecs); } } } /* * ----------------------------------------------------------------- * Nonlinear solver functions * ----------------------------------------------------------------- */ /* * IDANls * * This routine attempts to solve the nonlinear system using the linear * solver specified. NOTE: this routine uses N_Vector ee as the scratch * vector tempv3 passed to lsetup. * * Possible return values: * * IDA_SUCCESS * * IDA_RES_RECVR IDA_RES_FAIL * IDA_SRES_RECVR IDA_SRES_FAIL * IDA_LSETUP_RECVR IDA_LSETUP_FAIL * IDA_LSOLVE_RECVR IDA_LSOLVE_FAIL * * IDA_CONSTR_RECVR * SUN_NLS_CONV_RECVR * IDA_MEM_NULL */ static int IDANls(IDAMem IDA_mem) { int retval; booleantype constraintsPassed, callLSetup, sensi_sim; realtype temp1, temp2, vnorm; /* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); callLSetup = SUNFALSE; /* Initialize if the first time called */ if (IDA_mem->ida_nst == 0){ IDA_mem->ida_cjold = IDA_mem->ida_cj; IDA_mem->ida_ss = TWENTY; IDA_mem->ida_ssS = TWENTY; if (IDA_mem->ida_lsetup) callLSetup = SUNTRUE; } /* Decide if lsetup is to be called */ if (IDA_mem->ida_lsetup) { IDA_mem->ida_cjratio = IDA_mem->ida_cj / IDA_mem->ida_cjold; temp1 = (ONE - XRATE) / (ONE + XRATE); temp2 = ONE/temp1; if (IDA_mem->ida_cjratio < temp1 || IDA_mem->ida_cjratio > temp2) callLSetup = SUNTRUE; if (IDA_mem->ida_forceSetup) callLSetup = SUNTRUE; if (IDA_mem->ida_cj != IDA_mem->ida_cjlast) {IDA_mem->ida_ss = HUNDRED; IDA_mem->ida_ssS = HUNDRED;} } /* initial guess for the correction to the predictor */ if (sensi_sim) N_VConst(ZERO, IDA_mem->ycor0Sim); else N_VConst(ZERO, IDA_mem->ida_delta); /* call nonlinear solver setup if it exists */ if ((IDA_mem->NLS)->ops->setup) { if (sensi_sim) retval = SUNNonlinSolSetup(IDA_mem->NLS, IDA_mem->ycor0Sim, IDA_mem); else retval = SUNNonlinSolSetup(IDA_mem->NLS, IDA_mem->ida_delta, IDA_mem); if (retval < 0) return(IDA_NLS_SETUP_FAIL); if (retval > 0) return(IDA_NLS_SETUP_RECVR); } /* solve the nonlinear system */ if (sensi_sim) retval = SUNNonlinSolSolve(IDA_mem->NLSsim, IDA_mem->ycor0Sim, IDA_mem->ycorSim, IDA_mem->ewtSim, IDA_mem->ida_epsNewt, callLSetup, IDA_mem); else retval = SUNNonlinSolSolve(IDA_mem->NLS, IDA_mem->ida_delta, IDA_mem->ida_ee, IDA_mem->ida_ewt, IDA_mem->ida_epsNewt, callLSetup, IDA_mem); /* update the state using the final correction from the nonlinear solver */ N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, IDA_mem->ida_ee, IDA_mem->ida_yy); N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, IDA_mem->ida_ee, IDA_mem->ida_yp); /* update the sensitivities based on the final correction from the nonlinear solver */ if (sensi_sim) { N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_yySpredict, ONE, IDA_mem->ida_eeS, IDA_mem->ida_yyS); N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_ypSpredict, IDA_mem->ida_cj, IDA_mem->ida_eeS, IDA_mem->ida_ypS); } /* return if nonlinear solver failed */ if (retval != IDA_SUCCESS) return(retval); /* If otherwise successful, check and enforce inequality constraints. */ if (IDA_mem->ida_constraintsSet){ /* Check constraints and get mask vector mm, set where constraints failed */ IDA_mem->ida_mm = IDA_mem->ida_tempv2; constraintsPassed = N_VConstrMask(IDA_mem->ida_constraints,IDA_mem->ida_yy,IDA_mem->ida_mm); if (constraintsPassed) return(IDA_SUCCESS); else { N_VCompare(ONEPT5, IDA_mem->ida_constraints, IDA_mem->ida_tempv1); /* a , where a[i] =1. when |c[i]| = 2 , c the vector of constraints */ N_VProd(IDA_mem->ida_tempv1, IDA_mem->ida_constraints, IDA_mem->ida_tempv1); /* a * c */ N_VDiv(IDA_mem->ida_tempv1, IDA_mem->ida_ewt, IDA_mem->ida_tempv1); /* a * c * wt */ N_VLinearSum(ONE, IDA_mem->ida_yy, -PT1, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1);/* y - 0.1 * a * c * wt */ N_VProd(IDA_mem->ida_tempv1, IDA_mem->ida_mm, IDA_mem->ida_tempv1); /* v = mm*(y-.1*a*c*wt) */ vnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_tempv1, IDA_mem->ida_ewt, SUNFALSE); /* ||v|| */ /* If vector v of constraint corrections is small in norm, correct and accept this step */ if (vnorm <= IDA_mem->ida_epsNewt){ N_VLinearSum(ONE, IDA_mem->ida_ee, -ONE, IDA_mem->ida_tempv1, IDA_mem->ida_ee); /* ee <- ee - v */ return(IDA_SUCCESS); } else { /* Constraints not met -- reduce h by computing rr = h'/h */ N_VLinearSum(ONE, IDA_mem->ida_phi[0], -ONE, IDA_mem->ida_yy, IDA_mem->ida_tempv1); N_VProd(IDA_mem->ida_mm, IDA_mem->ida_tempv1, IDA_mem->ida_tempv1); IDA_mem->ida_rr = PT9*N_VMinQuotient(IDA_mem->ida_phi[0], IDA_mem->ida_tempv1); IDA_mem->ida_rr = SUNMAX(IDA_mem->ida_rr,PT1); return(IDA_CONSTR_RECVR); } } } return(IDA_SUCCESS); } /* * IDAPredict * * This routine predicts the new values for vectors yy and yp. */ static void IDAPredict(IDAMem IDA_mem) { int j; for(j=0; j<=IDA_mem->ida_kk; j++) IDA_mem->ida_cvals[j] = ONE; (void) N_VLinearCombination(IDA_mem->ida_kk+1, IDA_mem->ida_cvals, IDA_mem->ida_phi, IDA_mem->ida_yypredict); (void) N_VLinearCombination(IDA_mem->ida_kk, IDA_mem->ida_gamma+1, IDA_mem->ida_phi+1, IDA_mem->ida_yppredict); } /* * IDAQuadNls * * This routine solves for the quadrature variables at the new step. * It does not solve a nonlinear system, but rather updates the * quadrature variables. The name for this function is just for * uniformity purposes. * */ static int IDAQuadNls(IDAMem IDA_mem) { int retval; /* Predict: load yyQ and ypQ */ IDAQuadPredict(IDA_mem); /* Compute correction eeQ */ retval = IDA_mem->ida_rhsQ(IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_eeQ, IDA_mem->ida_user_data); IDA_mem->ida_nrQe++; if (retval < 0) return(IDA_QRHS_FAIL); else if (retval > 0) return(IDA_QRHS_RECVR); if (IDA_mem->ida_quadr_sensi) N_VScale(ONE, IDA_mem->ida_eeQ, IDA_mem->ida_savrhsQ); N_VLinearSum(ONE, IDA_mem->ida_eeQ, -ONE, IDA_mem->ida_ypQ, IDA_mem->ida_eeQ); N_VScale(ONE/IDA_mem->ida_cj, IDA_mem->ida_eeQ, IDA_mem->ida_eeQ); /* Apply correction: yyQ = yyQ + eeQ */ N_VLinearSum(ONE, IDA_mem->ida_yyQ, ONE, IDA_mem->ida_eeQ, IDA_mem->ida_yyQ); return(IDA_SUCCESS); } /* * IDAQuadPredict * * This routine predicts the new value for vectors yyQ and ypQ */ static void IDAQuadPredict(IDAMem IDA_mem) { int j; for(j=0; j<=IDA_mem->ida_kk; j++) IDA_mem->ida_cvals[j] = ONE; (void) N_VLinearCombination(IDA_mem->ida_kk+1, IDA_mem->ida_cvals, IDA_mem->ida_phiQ, IDA_mem->ida_yyQ); (void) N_VLinearCombination(IDA_mem->ida_kk, IDA_mem->ida_gamma+1, IDA_mem->ida_phiQ+1, IDA_mem->ida_ypQ); } /* * IDASensNls * * This routine attempts to solve, one by one, all the sensitivity * linear systems using nonlinear iterations and the linear solver * specified (Staggered approach). */ static int IDASensNls(IDAMem IDA_mem) { booleantype callLSetup; int retval; callLSetup = SUNFALSE; /* initial guess for the correction to the predictor */ N_VConst(ZERO, IDA_mem->ycor0Stg); /* solve the nonlinear system */ retval = SUNNonlinSolSolve(IDA_mem->NLSstg, IDA_mem->ycor0Stg, IDA_mem->ycorStg, IDA_mem->ewtStg, IDA_mem->ida_epsNewt, callLSetup, IDA_mem); /* update using the final correction from the nonlinear solver */ N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_yySpredict, ONE, IDA_mem->ida_eeS, IDA_mem->ida_yyS); N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_ypSpredict, IDA_mem->ida_cj, IDA_mem->ida_eeS, IDA_mem->ida_ypS); if (retval != IDA_SUCCESS) IDA_mem->ida_ncfnS++; return(retval); } /* * IDASensPredict * * This routine loads the predicted values for the is-th sensitivity * in the vectors yySens and ypSens. * * When ism=IDA_STAGGERED, yySens = yyS[is] and ypSens = ypS[is] */ static void IDASensPredict(IDAMem IDA_mem, N_Vector *yySens, N_Vector *ypSens) { int j; for(j=0; j<=IDA_mem->ida_kk; j++) IDA_mem->ida_cvals[j] = ONE; (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk+1, IDA_mem->ida_cvals, IDA_mem->ida_phiS, yySens); (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk, IDA_mem->ida_gamma+1, IDA_mem->ida_phiS+1, ypSens); } /* * IDAQuadSensNls * * This routine solves for the snesitivity quadrature variables at the * new step. It does not solve a nonlinear system, but rather updates * the sensitivity variables. The name for this function is just for * uniformity purposes. * */ static int IDAQuadSensNls(IDAMem IDA_mem) { int retval; N_Vector *ypQS; /* Predict: load yyQS and ypQS for each sensitivity. Store 1st order information in tempvQS. */ ypQS = IDA_mem->ida_tempvQS; IDAQuadSensPredict(IDA_mem, IDA_mem->ida_yyQS, ypQS); /* Compute correction eeQS */ retval = IDA_mem->ida_rhsQS(IDA_mem->ida_Ns, IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_yyS, IDA_mem->ida_ypS, IDA_mem->ida_savrhsQ, IDA_mem->ida_eeQS, IDA_mem->ida_user_dataQS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); IDA_mem->ida_nrQSe++; if (retval < 0) return(IDA_QSRHS_FAIL); else if (retval > 0) return(IDA_QSRHS_RECVR); retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE/IDA_mem->ida_cj, IDA_mem->ida_eeQS, -ONE/IDA_mem->ida_cj, ypQS, IDA_mem->ida_eeQS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Apply correction: yyQS[is] = yyQ[is] + eeQ[is] */ retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_yyQS, ONE, IDA_mem->ida_eeQS, IDA_mem->ida_yyQS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(IDA_SUCCESS); } /* * IDAQuadSensPredict * * This routine predicts the new value for vectors yyQS and ypQS */ static void IDAQuadSensPredict(IDAMem IDA_mem, N_Vector *yQS, N_Vector *ypQS) { int j; for(j=0; j<=IDA_mem->ida_kk; j++) IDA_mem->ida_cvals[j] = ONE; (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk+1, IDA_mem->ida_cvals, IDA_mem->ida_phiQS, yQS); (void) N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_kk, IDA_mem->ida_gamma+1, IDA_mem->ida_phiQS+1, ypQS); } /* * ----------------------------------------------------------------- * Error test * ----------------------------------------------------------------- */ /* * IDATestError * * This routine estimates errors at orders k, k-1, k-2, decides * whether or not to suggest an order reduction, and performs * the local error test. * * IDATestError returns either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDATestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enorm_k, enorm_km1, enorm_km2; /* error norms */ realtype terr_k, terr_km1, terr_km2; /* local truncation error norms */ /* Compute error for order k. */ enorm_k = IDAWrmsNorm(IDA_mem, IDA_mem->ida_ee, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); *err_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enorm_k; terr_k = (IDA_mem->ida_kk+1) * (*err_k); IDA_mem->ida_knew = IDA_mem->ida_kk; if ( IDA_mem->ida_kk > 1 ) { /* Compute error at order k-1 */ N_VLinearSum(ONE, IDA_mem->ida_phi[IDA_mem->ida_kk], ONE, IDA_mem->ida_ee, IDA_mem->ida_delta); enorm_km1 = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); *err_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] * enorm_km1; terr_km1 = IDA_mem->ida_kk * (*err_km1); if ( IDA_mem->ida_kk > 2 ) { /* Compute error at order k-2 */ N_VLinearSum(ONE, IDA_mem->ida_phi[IDA_mem->ida_kk-1], ONE, IDA_mem->ida_delta, IDA_mem->ida_delta); enorm_km2 = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); *err_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] * enorm_km2; terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2); /* Reduce order if errors are reduced */ if (SUNMAX(terr_km1, terr_km2) <= terr_k) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } else { /* Reduce order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } } /* Perform error test */ if (ck * enorm_k > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDAQuadTestError * * This routine estimates quadrature errors and updates errors at * orders k, k-1, k-2, decides whether or not to suggest an order reduction, * and performs the local error test. * * IDAQuadTestError returns the updated local error estimate at orders k, * k-1, and k-2. These are norms of type SUNMAX(|err|,|errQ|). * * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDAQuadTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enormQ; realtype errQ_k, errQ_km1, errQ_km2; realtype terr_k, terr_km1, terr_km2; N_Vector tempv; booleantype check_for_reduction = SUNFALSE; /* Rename ypQ */ tempv = IDA_mem->ida_ypQ; /* Update error for order k. */ enormQ = N_VWrmsNorm(IDA_mem->ida_eeQ, IDA_mem->ida_ewtQ); errQ_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enormQ; if (errQ_k > *err_k) { *err_k = errQ_k; check_for_reduction = SUNTRUE; } terr_k = (IDA_mem->ida_kk+1) * (*err_k); if ( IDA_mem->ida_kk > 1 ) { /* Update error at order k-1 */ N_VLinearSum(ONE, IDA_mem->ida_phiQ[IDA_mem->ida_kk], ONE, IDA_mem->ida_eeQ, tempv); errQ_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] * N_VWrmsNorm(tempv, IDA_mem->ida_ewtQ); if (errQ_km1 > *err_km1) { *err_km1 = errQ_km1; check_for_reduction = SUNTRUE; } terr_km1 = IDA_mem->ida_kk * (*err_km1); /* Has an order decrease already been decided in IDATestError? */ if (IDA_mem->ida_knew != IDA_mem->ida_kk) check_for_reduction = SUNFALSE; if (check_for_reduction) { if ( IDA_mem->ida_kk > 2 ) { /* Update error at order k-2 */ N_VLinearSum(ONE, IDA_mem->ida_phiQ[IDA_mem->ida_kk-1], ONE, tempv, tempv); errQ_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] * N_VWrmsNorm(tempv, IDA_mem->ida_ewtQ); if (errQ_km2 > *err_km2) { *err_km2 = errQ_km2; } terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2); /* Decrease order if errors are reduced */ if (SUNMAX(terr_km1, terr_km2) <= terr_k) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } } } /* Perform error test */ if (ck * enormQ > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDASensTestError * * This routine estimates sensitivity errors and updates errors at * orders k, k-1, k-2, decides whether or not to suggest an order reduction, * and performs the local error test. (Used only in staggered approach). * * IDASensTestError returns the updated local error estimate at orders k, * k-1, and k-2. These are norms of type SUNMAX(|err|,|errQ|,|errS|). * * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDASensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enormS; realtype errS_k, errS_km1, errS_km2; realtype terr_k, terr_km1, terr_km2; N_Vector *tempv; booleantype check_for_reduction = SUNFALSE; int retval; /* Rename deltaS */ tempv = IDA_mem->ida_deltaS; /* Update error for order k. */ enormS = IDASensWrmsNorm(IDA_mem, IDA_mem->ida_eeS, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg); errS_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enormS; if (errS_k > *err_k) { *err_k = errS_k; check_for_reduction = SUNTRUE; } terr_k = (IDA_mem->ida_kk+1) * (*err_k); if ( IDA_mem->ida_kk > 1 ) { /* Update error at order k-1 */ retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_phiS[IDA_mem->ida_kk], ONE, IDA_mem->ida_eeS, tempv); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); errS_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] * IDASensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg); if (errS_km1 > *err_km1) { *err_km1 = errS_km1; check_for_reduction = SUNTRUE; } terr_km1 = IDA_mem->ida_kk * (*err_km1); /* Has an order decrease already been decided in IDATestError? */ if (IDA_mem->ida_knew != IDA_mem->ida_kk) check_for_reduction = SUNFALSE; if (check_for_reduction) { if ( IDA_mem->ida_kk > 2 ) { /* Update error at order k-2 */ retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_phiS[IDA_mem->ida_kk-1], ONE, tempv, tempv); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); errS_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] * IDASensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg); if (errS_km2 > *err_km2) { *err_km2 = errS_km2; } terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2); /* Decrease order if errors are reduced */ if (SUNMAX(terr_km1, terr_km2) <= terr_k) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } } } /* Perform error test */ if (ck * enormS > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDAQuadSensTestError * * This routine estimates quadrature sensitivity errors and updates * errors at orders k, k-1, k-2, decides whether or not to suggest * an order reduction and performs the local error test. (Used * only in staggered approach). * * IDAQuadSensTestError returns the updated local error estimate at * orders k, k-1, and k-2. These are norms of type * SUNMAX(|err|,|errQ|,|errS|,|errQS|). * * The return flag can be either IDA_SUCCESS or ERROR_TEST_FAIL. */ static int IDAQuadSensTestError(IDAMem IDA_mem, realtype ck, realtype *err_k, realtype *err_km1, realtype *err_km2) { realtype enormQS; realtype errQS_k, errQS_km1, errQS_km2; realtype terr_k, terr_km1, terr_km2; N_Vector *tempv; booleantype check_for_reduction = SUNFALSE; int retval; tempv = IDA_mem->ida_yyQS; enormQS = IDAQuadSensWrmsNorm(IDA_mem, IDA_mem->ida_eeQS, IDA_mem->ida_ewtQS); errQS_k = IDA_mem->ida_sigma[IDA_mem->ida_kk] * enormQS; if (errQS_k > *err_k) { *err_k = errQS_k; check_for_reduction = SUNTRUE; } terr_k = (IDA_mem->ida_kk+1) * (*err_k); if ( IDA_mem->ida_kk > 1 ) { /* Update error at order k-1 */ retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_phiQS[IDA_mem->ida_kk], ONE, IDA_mem->ida_eeQS, tempv); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); errQS_km1 = IDA_mem->ida_sigma[IDA_mem->ida_kk-1] * IDAQuadSensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtQS); if (errQS_km1 > *err_km1) { *err_km1 = errQS_km1; check_for_reduction = SUNTRUE; } terr_km1 = IDA_mem->ida_kk * (*err_km1); /* Has an order decrease already been decided in IDATestError? */ if (IDA_mem->ida_knew != IDA_mem->ida_kk) check_for_reduction = SUNFALSE; if (check_for_reduction) { if ( IDA_mem->ida_kk > 2 ) { /* Update error at order k-2 */ retval = N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_phiQS[IDA_mem->ida_kk-1], ONE, tempv, tempv); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); errQS_km2 = IDA_mem->ida_sigma[IDA_mem->ida_kk-2] * IDAQuadSensWrmsNorm(IDA_mem, tempv, IDA_mem->ida_ewtQS); if (errQS_km2 > *err_km2) { *err_km2 = errQS_km2; } terr_km2 = (IDA_mem->ida_kk-1) * (*err_km2); /* Decrease order if errors are reduced */ if (SUNMAX(terr_km1, terr_km2) <= terr_k) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } else { /* Decrease order to 1 if errors are reduced by at least 1/2 */ if (terr_km1 <= (HALF * terr_k) ) IDA_mem->ida_knew = IDA_mem->ida_kk - 1; } } } /* Perform error test */ if (ck * enormQS > ONE) return(ERROR_TEST_FAIL); else return(IDA_SUCCESS); } /* * IDARestore * * This routine restores IDA_mem->ida_tn, psi, and phi in the event of a failure. * It changes back phi-star to phi (changed in IDASetCoeffs) */ static void IDARestore(IDAMem IDA_mem, realtype saved_t) { int i, j, is; IDA_mem->ida_tn = saved_t; for (i = 1; i <= IDA_mem->ida_kk; i++) IDA_mem->ida_psi[i-1] = IDA_mem->ida_psi[i] - IDA_mem->ida_hh; if (IDA_mem->ida_ns <= IDA_mem->ida_kk) { for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) IDA_mem->ida_cvals[i-IDA_mem->ida_ns] = ONE/IDA_mem->ida_beta[i]; (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1, IDA_mem->ida_cvals, IDA_mem->ida_phi+IDA_mem->ida_ns, IDA_mem->ida_phi+IDA_mem->ida_ns); if (IDA_mem->ida_quadr) (void) N_VScaleVectorArray(IDA_mem->ida_kk - IDA_mem->ida_ns + 1, IDA_mem->ida_cvals, IDA_mem->ida_phiQ+IDA_mem->ida_ns, IDA_mem->ida_phiQ+IDA_mem->ida_ns); if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) { j = 0; for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) { for(is=0; isida_Ns; is++) { IDA_mem->ida_cvals[j] = ONE/IDA_mem->ida_beta[i]; j++; } } } if (IDA_mem->ida_sensi) { j = 0; for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) { for(is=0; isida_Ns; is++) { IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiS[i][is]; j++; } } (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs, IDA_mem->ida_Xvecs); } if (IDA_mem->ida_quadr_sensi) { j = 0; for(i=IDA_mem->ida_ns; i<=IDA_mem->ida_kk; i++) { for(is=0; isida_Ns; is++) { IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiQS[i][is]; j++; } } (void) N_VScaleVectorArray(j, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs, IDA_mem->ida_Xvecs); } } } /* * ----------------------------------------------------------------- * Handler for convergence and/or error test failures * ----------------------------------------------------------------- */ /* * IDAHandleNFlag * * This routine handles failures indicated by the input variable nflag. * Positive values indicate various recoverable failures while negative * values indicate nonrecoverable failures. This routine adjusts the * step size for recoverable failures. * * Possible nflag values (input): * * --convergence failures-- * IDA_RES_RECVR > 0 * IDA_LSOLVE_RECVR > 0 * IDA_CONSTR_RECVR > 0 * SUN_NLS_CONV_RECVR > 0 * IDA_QRHS_RECVR > 0 * IDA_QSRHS_RECVR > 0 * IDA_RES_FAIL < 0 * IDA_LSOLVE_FAIL < 0 * IDA_LSETUP_FAIL < 0 * IDA_QRHS_FAIL < 0 * * --error test failure-- * ERROR_TEST_FAIL > 0 * * Possible kflag values (output): * * --recoverable-- * PREDICT_AGAIN * * --nonrecoverable-- * IDA_CONSTR_FAIL * IDA_REP_RES_ERR * IDA_ERR_FAIL * IDA_CONV_FAIL * IDA_RES_FAIL * IDA_LSETUP_FAIL * IDA_LSOLVE_FAIL * IDA_QRHS_FAIL * IDA_REP_QRHS_ERR */ static int IDAHandleNFlag(IDAMem IDA_mem, int nflag, realtype err_k, realtype err_km1, long int *ncfnPtr, int *ncfPtr, long int *netfPtr, int *nefPtr) { realtype err_knew; IDA_mem->ida_phase = 1; if (nflag != ERROR_TEST_FAIL) { /*----------------------- Nonlinear solver failed -----------------------*/ (*ncfPtr)++; /* local counter for convergence failures */ (*ncfnPtr)++; /* global counter for convergence failures */ if (nflag < 0) { /* nonrecoverable failure */ return(nflag); } else { /* recoverable failure */ /* Reduce step size for a new prediction Note that if nflag=IDA_CONSTR_RECVR then rr was already set in IDANls */ if (nflag != IDA_CONSTR_RECVR) IDA_mem->ida_rr = QUARTER; IDA_mem->ida_hh *= IDA_mem->ida_rr; /* Test if there were too many convergence failures */ if (*ncfPtr < IDA_mem->ida_maxncf) return(PREDICT_AGAIN); else if (nflag == IDA_RES_RECVR) return(IDA_REP_RES_ERR); else if (nflag == IDA_SRES_RECVR) return(IDA_REP_SRES_ERR); else if (nflag == IDA_QRHS_RECVR) return(IDA_REP_QRHS_ERR); else if (nflag == IDA_QSRHS_RECVR) return(IDA_REP_QSRHS_ERR); else if (nflag == IDA_CONSTR_RECVR) return(IDA_CONSTR_FAIL); else return(IDA_CONV_FAIL); } } else { /*----------------- Error Test failed -----------------*/ (*nefPtr)++; /* local counter for error test failures */ (*netfPtr)++; /* global counter for error test failures */ if (*nefPtr == 1) { /* On first error test failure, keep current order or lower order by one. Compute new stepsize based on differences of the solution. */ err_knew = (IDA_mem->ida_kk==IDA_mem->ida_knew)? err_k : err_km1; IDA_mem->ida_kk = IDA_mem->ida_knew; IDA_mem->ida_rr = PT9 * SUNRpowerR( TWO * err_knew + PT0001,(-ONE/(IDA_mem->ida_kk+1)) ); IDA_mem->ida_rr = SUNMAX(QUARTER, SUNMIN(PT9,IDA_mem->ida_rr)); IDA_mem->ida_hh *= IDA_mem->ida_rr; return(PREDICT_AGAIN); } else if (*nefPtr == 2) { /* On second error test failure, use current order or decrease order by one. Reduce stepsize by factor of 1/4. */ IDA_mem->ida_kk = IDA_mem->ida_knew; IDA_mem->ida_rr = QUARTER; IDA_mem->ida_hh *= IDA_mem->ida_rr; return(PREDICT_AGAIN); } else if (*nefPtr < IDA_mem->ida_maxnef) { /* On third and subsequent error test failures, set order to 1. Reduce stepsize by factor of 1/4. */ IDA_mem->ida_kk = 1; IDA_mem->ida_rr = QUARTER; IDA_mem->ida_hh *= IDA_mem->ida_rr; return(PREDICT_AGAIN); } else { /* Too many error test failures */ return(IDA_ERR_FAIL); } } } /* * IDAReset * * This routine is called only if we need to predict again at the * very first step. In such a case, reset phi[1] and psi[0]. */ static void IDAReset(IDAMem IDA_mem) { int is; IDA_mem->ida_psi[0] = IDA_mem->ida_hh; N_VScale(IDA_mem->ida_rr, IDA_mem->ida_phi[1], IDA_mem->ida_phi[1]); if (IDA_mem->ida_quadr) N_VScale(IDA_mem->ida_rr, IDA_mem->ida_phiQ[1], IDA_mem->ida_phiQ[1]); if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) for(is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = IDA_mem->ida_rr; if (IDA_mem->ida_sensi) (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiS[1], IDA_mem->ida_phiS[1]); if (IDA_mem->ida_quadr_sensi) (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiQS[1], IDA_mem->ida_phiQS[1]); } /* * ----------------------------------------------------------------- * Function called after a successful step * ----------------------------------------------------------------- */ /* * IDACompleteStep * * This routine completes a successful step. It increments nst, * saves the stepsize and order used, makes the final selection of * stepsize and order for the next step, and updates the phi array. * Its return value is IDA_SUCCESS = 0. */ static void IDACompleteStep(IDAMem IDA_mem, realtype err_k, realtype err_km1) { int i, j, is, kdiff, action; realtype terr_k, terr_km1, terr_kp1; realtype err_knew, err_kp1; realtype enorm, tmp, hnew; N_Vector tempvQ, *tempvS; IDA_mem->ida_nst++; kdiff = IDA_mem->ida_kk - IDA_mem->ida_kused; IDA_mem->ida_kused = IDA_mem->ida_kk; IDA_mem->ida_hused = IDA_mem->ida_hh; if ( (IDA_mem->ida_knew == IDA_mem->ida_kk-1) || (IDA_mem->ida_kk == IDA_mem->ida_maxord) ) IDA_mem->ida_phase = 1; /* For the first few steps, until either a step fails, or the order is reduced, or the order reaches its maximum, we raise the order and double the stepsize. During these steps, phase = 0. Thereafter, phase = 1, and stepsize and order are set by the usual local error algorithm. Note that, after the first step, the order is not increased, as not all of the neccessary information is available yet. */ if (IDA_mem->ida_phase == 0) { if(IDA_mem->ida_nst > 1) { IDA_mem->ida_kk++; hnew = TWO * IDA_mem->ida_hh; if( (tmp = SUNRabs(hnew) * IDA_mem->ida_hmax_inv) > ONE ) hnew /= tmp; IDA_mem->ida_hh = hnew; } } else { action = UNSET; /* Set action = LOWER/MAINTAIN/RAISE to specify order decision */ if (IDA_mem->ida_knew == IDA_mem->ida_kk-1) {action = LOWER; goto takeaction;} if (IDA_mem->ida_kk == IDA_mem->ida_maxord) {action = MAINTAIN; goto takeaction;} if ( (IDA_mem->ida_kk+1 >= IDA_mem->ida_ns ) || (kdiff == 1)) {action = MAINTAIN; goto takeaction;} /* Estimate the error at order k+1, unless already decided to reduce order, or already using maximum order, or stepsize has not been constant, or order was just raised. */ N_VLinearSum(ONE, IDA_mem->ida_ee, -ONE, IDA_mem->ida_phi[IDA_mem->ida_kk+1], IDA_mem->ida_tempv1); enorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_tempv1, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); if (IDA_mem->ida_errconQ) { tempvQ = IDA_mem->ida_ypQ; N_VLinearSum (ONE, IDA_mem->ida_eeQ, -ONE, IDA_mem->ida_phiQ[IDA_mem->ida_kk+1], tempvQ); enorm = IDAQuadWrmsNormUpdate(IDA_mem, enorm, tempvQ, IDA_mem->ida_ewtQ); } if (IDA_mem->ida_errconS) { tempvS = IDA_mem->ida_ypS; (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_eeS, -ONE, IDA_mem->ida_phiS[IDA_mem->ida_kk+1], tempvS); enorm = IDASensWrmsNormUpdate(IDA_mem, enorm, tempvS, IDA_mem->ida_ewtS, IDA_mem->ida_suppressalg); } if (IDA_mem->ida_errconQS) { (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_eeQS, -ONE, IDA_mem->ida_phiQS[IDA_mem->ida_kk+1], IDA_mem->ida_tempvQS); enorm = IDAQuadSensWrmsNormUpdate(IDA_mem, enorm, IDA_mem->ida_tempvQS, IDA_mem->ida_ewtQS); } err_kp1= enorm/(IDA_mem->ida_kk+2); /* Choose among orders k-1, k, k+1 using local truncation error norms. */ terr_k = (IDA_mem->ida_kk+1) * err_k; terr_kp1 = (IDA_mem->ida_kk+2) * err_kp1; if (IDA_mem->ida_kk == 1) { if (terr_kp1 >= HALF * terr_k) {action = MAINTAIN; goto takeaction;} else {action = RAISE; goto takeaction;} } else { terr_km1 = IDA_mem->ida_kk * err_km1; if (terr_km1 <= SUNMIN(terr_k, terr_kp1)) {action = LOWER; goto takeaction;} else if (terr_kp1 >= terr_k) {action = MAINTAIN; goto takeaction;} else {action = RAISE; goto takeaction;} } takeaction: /* Set the estimated error norm and, on change of order, reset kk. */ if (action == RAISE) { IDA_mem->ida_kk++; err_knew = err_kp1; } else if (action == LOWER) { IDA_mem->ida_kk--; err_knew = err_km1; } else { err_knew = err_k; } /* Compute rr = tentative ratio hnew/hh from error norm. Reduce hh if rr <= 1, double hh if rr >= 2, else leave hh as is. If hh is reduced, hnew/hh is restricted to be between .5 and .9. */ hnew = IDA_mem->ida_hh; IDA_mem->ida_rr = SUNRpowerR( (TWO * err_knew + PT0001) , (-ONE/(IDA_mem->ida_kk+1) ) ); if (IDA_mem->ida_rr >= TWO) { hnew = TWO * IDA_mem->ida_hh; if( (tmp = SUNRabs(hnew) * IDA_mem->ida_hmax_inv) > ONE ) hnew /= tmp; } else if (IDA_mem->ida_rr <= ONE ) { IDA_mem->ida_rr = SUNMAX(HALF, SUNMIN(PT9,IDA_mem->ida_rr)); hnew = IDA_mem->ida_hh * IDA_mem->ida_rr; } IDA_mem->ida_hh = hnew; } /* end of phase if block */ /* Save ee etc. for possible order increase on next step */ if (IDA_mem->ida_kused < IDA_mem->ida_maxord) { N_VScale(ONE, IDA_mem->ida_ee, IDA_mem->ida_phi[IDA_mem->ida_kused+1]); if (IDA_mem->ida_quadr) N_VScale(ONE, IDA_mem->ida_eeQ, IDA_mem->ida_phiQ[IDA_mem->ida_kused+1]); if (IDA_mem->ida_sensi || IDA_mem->ida_quadr_sensi) for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; if (IDA_mem->ida_sensi) (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_eeS, IDA_mem->ida_phiS[IDA_mem->ida_kused+1]); if (IDA_mem->ida_quadr_sensi) (void) N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_eeQS, IDA_mem->ida_phiQS[IDA_mem->ida_kused+1]); } /* Update phi arrays */ /* To update phi arrays compute X += Z where */ /* X = [ phi[kused], phi[kused-1], phi[kused-2], ... phi[1] ] */ /* Z = [ ee, phi[kused], phi[kused-1], ... phi[0] ] */ IDA_mem->ida_Zvecs[0] = IDA_mem->ida_ee; IDA_mem->ida_Xvecs[0] = IDA_mem->ida_phi[IDA_mem->ida_kused]; for (j=1; j<=IDA_mem->ida_kused; j++) { IDA_mem->ida_Zvecs[j] = IDA_mem->ida_phi[IDA_mem->ida_kused-j+1]; IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phi[IDA_mem->ida_kused-j]; } (void) N_VLinearSumVectorArray(IDA_mem->ida_kused+1, ONE, IDA_mem->ida_Xvecs, ONE, IDA_mem->ida_Zvecs, IDA_mem->ida_Xvecs); if (IDA_mem->ida_quadr) { IDA_mem->ida_Zvecs[0] = IDA_mem->ida_eeQ; IDA_mem->ida_Xvecs[0] = IDA_mem->ida_phiQ[IDA_mem->ida_kused]; for (j=1; j<=IDA_mem->ida_kused; j++) { IDA_mem->ida_Zvecs[j] = IDA_mem->ida_phiQ[IDA_mem->ida_kused-j+1]; IDA_mem->ida_Xvecs[j] = IDA_mem->ida_phiQ[IDA_mem->ida_kused-j]; } (void) N_VLinearSumVectorArray(IDA_mem->ida_kused+1, ONE, IDA_mem->ida_Xvecs, ONE, IDA_mem->ida_Zvecs, IDA_mem->ida_Xvecs); } if (IDA_mem->ida_sensi) { i=0; for (is=0; isida_Ns; is++) { IDA_mem->ida_Zvecs[i] = IDA_mem->ida_eeS[is]; IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiS[IDA_mem->ida_kused][is]; i++; for (j=1; j<=IDA_mem->ida_kused; j++) { IDA_mem->ida_Zvecs[i] = IDA_mem->ida_phiS[IDA_mem->ida_kused-j+1][is]; IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiS[IDA_mem->ida_kused-j][is]; i++; } } (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns*(IDA_mem->ida_kused+1), ONE, IDA_mem->ida_Xvecs, ONE, IDA_mem->ida_Zvecs, IDA_mem->ida_Xvecs); } if (IDA_mem->ida_quadr_sensi) { i=0; for (is=0; isida_Ns; is++) { IDA_mem->ida_Zvecs[i] = IDA_mem->ida_eeQS[is]; IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiQS[IDA_mem->ida_kused][is]; i++; for (j=1; j<=IDA_mem->ida_kused; j++) { IDA_mem->ida_Zvecs[i] = IDA_mem->ida_phiQS[IDA_mem->ida_kused-j+1][is]; IDA_mem->ida_Xvecs[i] = IDA_mem->ida_phiQS[IDA_mem->ida_kused-j][is]; i++; } } (void) N_VLinearSumVectorArray(IDA_mem->ida_Ns*(IDA_mem->ida_kused+1), ONE, IDA_mem->ida_Xvecs, ONE, IDA_mem->ida_Zvecs, IDA_mem->ida_Xvecs); } } /* * ----------------------------------------------------------------- * Norm functions * ----------------------------------------------------------------- */ /* * IDAWrmsNorm * * Returns the WRMS norm of vector x with weights w. * If mask = SUNTRUE, the weight vector w is masked by id, i.e., * nrm = N_VWrmsNormMask(x,w,id); * Otherwise, * nrm = N_VWrmsNorm(x,w); * * mask = SUNFALSE when the call is made from the nonlinear solver. * mask = suppressalg otherwise. */ realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask) { realtype nrm; if (mask) nrm = N_VWrmsNormMask(x, w, IDA_mem->ida_id); else nrm = N_VWrmsNorm(x, w); return(nrm); } /* * IDASensWrmsNorm * * This routine returns the maximum over the weighted root mean * square norm of xS with weight vectors wS: * * max { wrms(xS[0],wS[0]) ... wrms(xS[Ns-1],wS[Ns-1]) } * * Called by IDASensUpdateNorm or directly in the IDA_STAGGERED approach * during the NLS solution and before the error test. * * Declared global for use in the computation of IC for sensitivities. */ realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS, booleantype mask) { int is; realtype nrm; if (mask) (void) N_VWrmsNormMaskVectorArray(IDA_mem->ida_Ns, xS, wS, IDA_mem->ida_id, IDA_mem->ida_cvals); else (void) N_VWrmsNormVectorArray(IDA_mem->ida_Ns, xS, wS, IDA_mem->ida_cvals); nrm = IDA_mem->ida_cvals[0]; for (is=1; isida_Ns; is++) if ( IDA_mem->ida_cvals[is] > nrm ) nrm = IDA_mem->ida_cvals[is]; return (nrm); } /* * IDAQuadSensWrmsNorm * * This routine returns the maximum over the weighted root mean * square norm of xQS with weight vectors wQS: * * max { wrms(xQS[0],wQS[0]) ... wrms(xQS[Ns-1],wQS[Ns-1]) } */ static realtype IDAQuadSensWrmsNorm(IDAMem IDA_mem, N_Vector *xQS, N_Vector *wQS) { int is; realtype nrm; (void) N_VWrmsNormVectorArray(IDA_mem->ida_Ns, xQS, wQS, IDA_mem->ida_cvals); nrm = IDA_mem->ida_cvals[0]; for (is=1; isida_Ns; is++) if ( IDA_mem->ida_cvals[is] > nrm ) nrm = IDA_mem->ida_cvals[is]; return (nrm); } /* * IDAQuadWrmsNormUpdate * * Updates the norm old_nrm to account for all quadratures. */ static realtype IDAQuadWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector xQ, N_Vector wQ) { realtype qnrm; qnrm = N_VWrmsNorm(xQ, wQ); if (old_nrm > qnrm) return(old_nrm); else return(qnrm); } /* * IDASensWrmsNormUpdate * * Updates the norm old_nrm to account for all sensitivities. * * This function is declared global since it is used for finding * IC for sensitivities, */ realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS, booleantype mask) { realtype snrm; snrm = IDASensWrmsNorm(IDA_mem, xS, wS, mask); if (old_nrm > snrm) return(old_nrm); else return(snrm); } static realtype IDAQuadSensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xQS, N_Vector *wQS) { realtype qsnrm; qsnrm = IDAQuadSensWrmsNorm(IDA_mem, xQS, wQS); if (old_nrm > qsnrm) return(old_nrm); else return(qsnrm); } /* * ----------------------------------------------------------------- * Functions for rootfinding * ----------------------------------------------------------------- */ /* * IDARcheck1 * * This routine completes the initialization of rootfinding memory * information, and checks whether g has a zero both at and very near * the initial point of the IVP. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL < 0 if the g function failed, or * IDA_SUCCESS = 0 otherwise. */ static int IDARcheck1(IDAMem IDA_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_iroots[i] = 0; IDA_mem->ida_tlo = IDA_mem->ida_tn; IDA_mem->ida_ttol = (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) * IDA_mem->ida_uround * HUNDRED; /* Evaluate g at initial t and check for zero values. */ retval = IDA_mem->ida_gfun(IDA_mem->ida_tlo, IDA_mem->ida_phi[0], IDA_mem->ida_phi[1], IDA_mem->ida_glo, IDA_mem->ida_user_data); IDA_mem->ida_nge = 1; if (retval != 0) return(IDA_RTFUNC_FAIL); zroot = SUNFALSE; for (i = 0; i < IDA_mem->ida_nrtfn; i++) { if (SUNRabs(IDA_mem->ida_glo[i]) == ZERO) { zroot = SUNTRUE; IDA_mem->ida_gactive[i] = SUNFALSE; } } if (!zroot) return(IDA_SUCCESS); /* Some g_i is zero at t0; look at g at t0+(small increment). */ hratio = SUNMAX(IDA_mem->ida_ttol / SUNRabs(IDA_mem->ida_hh), PT1); smallh = hratio*IDA_mem->ida_hh; tplus = IDA_mem->ida_tlo + smallh; N_VLinearSum(ONE, IDA_mem->ida_phi[0], smallh, IDA_mem->ida_phi[1], IDA_mem->ida_yy); retval = IDA_mem->ida_gfun(tplus, IDA_mem->ida_yy, IDA_mem->ida_phi[1], IDA_mem->ida_ghi, IDA_mem->ida_user_data); IDA_mem->ida_nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* We check now only the components of g which were exactly 0.0 at t0 * to see if we can 'activate' them. */ for (i = 0; i < IDA_mem->ida_nrtfn; i++) { if (!IDA_mem->ida_gactive[i] && SUNRabs(IDA_mem->ida_ghi[i]) != ZERO) { IDA_mem->ida_gactive[i] = SUNTRUE; IDA_mem->ida_glo[i] = IDA_mem->ida_ghi[i]; } } return(IDA_SUCCESS); } /* * IDARcheck2 * * This routine checks for exact zeros of g at the last root found, * if the last return was a root. It then checks for a close pair of * zeros (an error condition), and for a new root at a nearby point. * The array glo = g(tlo) at the left endpoint of the search interval * is adjusted if necessary to assure that all g_i are nonzero * there, before returning to do a root search in the interval. * * On entry, tlo = tretlast is the last value of tret returned by * IDASolve. This may be the previous tn, the previous tout value, * or the last root location. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL < 0 if the g function failed, or * CLOSERT = 3 if a close pair of zeros was found, or * RTFOUND = 1 if a new zero of g was found near tlo, or * IDA_SUCCESS = 0 otherwise. */ static int IDARcheck2(IDAMem IDA_mem) { int i, retval; realtype smallh, hratio, tplus; booleantype zroot; if (IDA_mem->ida_irfnd == 0) return(IDA_SUCCESS); (void) IDAGetSolution(IDA_mem, IDA_mem->ida_tlo, IDA_mem->ida_yy, IDA_mem->ida_yp); retval = IDA_mem->ida_gfun(IDA_mem->ida_tlo, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_glo, IDA_mem->ida_user_data); IDA_mem->ida_nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); zroot = SUNFALSE; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_iroots[i] = 0; for (i = 0; i < IDA_mem->ida_nrtfn; i++) { if (!IDA_mem->ida_gactive[i]) continue; if (SUNRabs(IDA_mem->ida_glo[i]) == ZERO) { zroot = SUNTRUE; IDA_mem->ida_iroots[i] = 1; } } if (!zroot) return(IDA_SUCCESS); /* One or more g_i has a zero at tlo. Check g at tlo+smallh. */ IDA_mem->ida_ttol = (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) * IDA_mem->ida_uround * HUNDRED; smallh = (IDA_mem->ida_hh > ZERO) ? IDA_mem->ida_ttol : -IDA_mem->ida_ttol; tplus = IDA_mem->ida_tlo + smallh; if ( (tplus - IDA_mem->ida_tn)*IDA_mem->ida_hh >= ZERO) { hratio = smallh/IDA_mem->ida_hh; N_VLinearSum(ONE, IDA_mem->ida_yy, hratio, IDA_mem->ida_phi[1], IDA_mem->ida_yy); } else { (void) IDAGetSolution(IDA_mem, tplus, IDA_mem->ida_yy, IDA_mem->ida_yp); } retval = IDA_mem->ida_gfun(tplus, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_ghi, IDA_mem->ida_user_data); IDA_mem->ida_nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* Check for close roots (error return), for a new zero at tlo+smallh, and for a g_i that changed from zero to nonzero. */ zroot = SUNFALSE; for (i = 0; i < IDA_mem->ida_nrtfn; i++) { if (!IDA_mem->ida_gactive[i]) continue; if (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) { if (IDA_mem->ida_iroots[i] == 1) return(CLOSERT); zroot = SUNTRUE; IDA_mem->ida_iroots[i] = 1; } else { if (IDA_mem->ida_iroots[i] == 1) IDA_mem->ida_glo[i] = IDA_mem->ida_ghi[i]; } } if (zroot) return(RTFOUND); return(IDA_SUCCESS); } /* * IDARcheck3 * * This routine interfaces to IDARootfind to look for a root of g * between tlo and either tn or tout, whichever comes first. * Only roots beyond tlo in the direction of integration are sought. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL < 0 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * IDA_SUCCESS = 0 otherwise. */ static int IDARcheck3(IDAMem IDA_mem) { int i, ier, retval; /* Set thi = tn or tout, whichever comes first. */ if (IDA_mem->ida_taskc == IDA_ONE_STEP) IDA_mem->ida_thi = IDA_mem->ida_tn; if (IDA_mem->ida_taskc == IDA_NORMAL) { IDA_mem->ida_thi = ((IDA_mem->ida_toutc - IDA_mem->ida_tn)*IDA_mem->ida_hh >= ZERO) ? IDA_mem->ida_tn : IDA_mem->ida_toutc; } /* Get y and y' at thi. */ (void) IDAGetSolution(IDA_mem, IDA_mem->ida_thi, IDA_mem->ida_yy, IDA_mem->ida_yp); /* Set ghi = g(thi) and call IDARootfind to search (tlo,thi) for roots. */ retval = IDA_mem->ida_gfun(IDA_mem->ida_thi, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_ghi, IDA_mem->ida_user_data); IDA_mem->ida_nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); IDA_mem->ida_ttol = (SUNRabs(IDA_mem->ida_tn) + SUNRabs(IDA_mem->ida_hh)) * IDA_mem->ida_uround * HUNDRED; ier = IDARootfind(IDA_mem); if (ier == IDA_RTFUNC_FAIL) return(IDA_RTFUNC_FAIL); for(i=0; iida_nrtfn; i++) { if(!IDA_mem->ida_gactive[i] && IDA_mem->ida_grout[i] != ZERO) IDA_mem->ida_gactive[i] = SUNTRUE; } IDA_mem->ida_tlo = IDA_mem->ida_trout; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_glo[i] = IDA_mem->ida_grout[i]; /* If no root found, return IDA_SUCCESS. */ if (ier == IDA_SUCCESS) return(IDA_SUCCESS); /* If a root was found, interpolate to get y(trout) and return. */ (void) IDAGetSolution(IDA_mem, IDA_mem->ida_trout, IDA_mem->ida_yy, IDA_mem->ida_yp); return(RTFOUND); } /* * IDARootfind * * This routine solves for a root of g(t) between tlo and thi, if * one exists. Only roots of odd multiplicity (i.e. with a change * of sign in one of the g_i), or exact zeros, are found. * Here the sign of tlo - thi is arbitrary, but if multiple roots * are found, the one closest to tlo is returned. * * The method used is the Illinois algorithm, a modified secant method. * Reference: Kathie L. Hiebert and Lawrence F. Shampine, Implicitly * Defined Output Points for Solutions of ODEs, Sandia National * Laboratory Report SAND80-0180, February 1980. * * This routine uses the following parameters for communication: * * nrtfn = number of functions g_i, or number of components of * the vector-valued function g(t). Input only. * * gfun = user-defined function for g(t). Its form is * (void) gfun(t, y, yp, gt, user_data) * * rootdir = in array specifying the direction of zero-crossings. * If rootdir[i] > 0, search for roots of g_i only if * g_i is increasing; if rootdir[i] < 0, search for * roots of g_i only if g_i is decreasing; otherwise * always search for roots of g_i. * * gactive = array specifying whether a component of g should * or should not be monitored. gactive[i] is initially * set to SUNTRUE for all i=0,...,nrtfn-1, but it may be * reset to SUNFALSE if at the first step g[i] is 0.0 * both at the I.C. and at a small perturbation of them. * gactive[i] is then set back on SUNTRUE only after the * corresponding g function moves away from 0.0. * * nge = cumulative counter for gfun calls. * * ttol = a convergence tolerance for trout. Input only. * When a root at trout is found, it is located only to * within a tolerance of ttol. Typically, ttol should * be set to a value on the order of * 100 * UROUND * max (SUNRabs(tlo), SUNRabs(thi)) * where UROUND is the unit roundoff of the machine. * * tlo, thi = endpoints of the interval in which roots are sought. * On input, these must be distinct, but tlo - thi may * be of either sign. The direction of integration is * assumed to be from tlo to thi. On return, tlo and thi * are the endpoints of the final relevant interval. * * glo, ghi = arrays of length nrtfn containing the vectors g(tlo) * and g(thi) respectively. Input and output. On input, * none of the glo[i] should be zero. * * trout = root location, if a root was found, or thi if not. * Output only. If a root was found other than an exact * zero of g, trout is the endpoint thi of the final * interval bracketing the root, with size at most ttol. * * grout = array of length nrtfn containing g(trout) on return. * * iroots = int array of length nrtfn with root information. * Output only. If a root was found, iroots indicates * which components g_i have a root at trout. For * i = 0, ..., nrtfn-1, iroots[i] = 1 if g_i has a root * and g_i is increasing, iroots[i] = -1 if g_i has a * root and g_i is decreasing, and iroots[i] = 0 if g_i * has no roots or g_i varies in the direction opposite * to that indicated by rootdir[i]. * * This routine returns an int equal to: * IDA_RTFUNC_FAIL < 0 if the g function failed, or * RTFOUND = 1 if a root of g was found, or * IDA_SUCCESS = 0 otherwise. * */ static int IDARootfind(IDAMem IDA_mem) { realtype alph, tmid, gfrac, maxfrac, fracint, fracsub; int i, retval, imax, side, sideprev; booleantype zroot, sgnchg; imax = 0; /* First check for change in sign in ghi or for a zero in ghi. */ maxfrac = ZERO; zroot = SUNFALSE; sgnchg = SUNFALSE; for (i = 0; i < IDA_mem->ida_nrtfn; i++) { if(!IDA_mem->ida_gactive[i]) continue; if (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) { if(IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) { zroot = SUNTRUE; } } else { if ( (IDA_mem->ida_glo[i]*IDA_mem->ida_ghi[i] < ZERO) && (IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) ) { gfrac = SUNRabs(IDA_mem->ida_ghi[i]/(IDA_mem->ida_ghi[i] - IDA_mem->ida_glo[i])); if (gfrac > maxfrac) { sgnchg = SUNTRUE; maxfrac = gfrac; imax = i; } } } } /* If no sign change was found, reset trout and grout. Then return IDA_SUCCESS if no zero was found, or set iroots and return RTFOUND. */ if (!sgnchg) { IDA_mem->ida_trout = IDA_mem->ida_thi; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_grout[i] = IDA_mem->ida_ghi[i]; if (!zroot) return(IDA_SUCCESS); for (i = 0; i < IDA_mem->ida_nrtfn; i++) { IDA_mem->ida_iroots[i] = 0; if(!IDA_mem->ida_gactive[i]) continue; if ( (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) && (IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) ) IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1; } return(RTFOUND); } /* Initialize alph to avoid compiler warning */ alph = ONE; /* A sign change was found. Loop to locate nearest root. */ side = 0; sideprev = -1; for(;;) { /* Looping point */ /* If interval size is already less than tolerance ttol, break. */ if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol) break; /* Set weight alph. On the first two passes, set alph = 1. Thereafter, reset alph according to the side (low vs high) of the subinterval in which the sign change was found in the previous two passes. If the sides were opposite, set alph = 1. If the sides were the same, then double alph (if high side), or halve alph (if low side). The next guess tmid is the secant method value if alph = 1, but is closer to tlo if alph < 1, and closer to thi if alph > 1. */ if (sideprev == side) { alph = (side == 2) ? alph*TWO : alph*HALF; } else { alph = ONE; } /* Set next root approximation tmid and get g(tmid). If tmid is too close to tlo or thi, adjust it inward, by a fractional distance that is between 0.1 and 0.5. */ tmid = IDA_mem->ida_thi - (IDA_mem->ida_thi - IDA_mem->ida_tlo) * IDA_mem->ida_ghi[imax]/(IDA_mem->ida_ghi[imax] - alph*IDA_mem->ida_glo[imax]); if (SUNRabs(tmid - IDA_mem->ida_tlo) < HALF * IDA_mem->ida_ttol) { fracint = SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) / IDA_mem->ida_ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = IDA_mem->ida_tlo + fracsub*(IDA_mem->ida_thi - IDA_mem->ida_tlo); } if (SUNRabs(IDA_mem->ida_thi - tmid) < HALF * IDA_mem->ida_ttol) { fracint = SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) / IDA_mem->ida_ttol; fracsub = (fracint > FIVE) ? PT1 : HALF/fracint; tmid = IDA_mem->ida_thi - fracsub*(IDA_mem->ida_thi - IDA_mem->ida_tlo); } (void) IDAGetSolution(IDA_mem, tmid, IDA_mem->ida_yy, IDA_mem->ida_yp); retval = IDA_mem->ida_gfun(tmid, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_grout, IDA_mem->ida_user_data); IDA_mem->ida_nge++; if (retval != 0) return(IDA_RTFUNC_FAIL); /* Check to see in which subinterval g changes sign, and reset imax. Set side = 1 if sign change is on low side, or 2 if on high side. */ maxfrac = ZERO; zroot = SUNFALSE; sgnchg = SUNFALSE; sideprev = side; for (i = 0; i < IDA_mem->ida_nrtfn; i++) { if(!IDA_mem->ida_gactive[i]) continue; if (SUNRabs(IDA_mem->ida_grout[i]) == ZERO) { if(IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) zroot = SUNTRUE; } else { if ( (IDA_mem->ida_glo[i]*IDA_mem->ida_grout[i] < ZERO) && (IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) ) { gfrac = SUNRabs(IDA_mem->ida_grout[i] / (IDA_mem->ida_grout[i] - IDA_mem->ida_glo[i])); if (gfrac > maxfrac) { sgnchg = SUNTRUE; maxfrac = gfrac; imax = i; } } } } if (sgnchg) { /* Sign change found in (tlo,tmid); replace thi with tmid. */ IDA_mem->ida_thi = tmid; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_ghi[i] = IDA_mem->ida_grout[i]; side = 1; /* Stop at root thi if converged; otherwise loop. */ if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol) break; continue; /* Return to looping point. */ } if (zroot) { /* No sign change in (tlo,tmid), but g = 0 at tmid; return root tmid. */ IDA_mem->ida_thi = tmid; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_ghi[i] = IDA_mem->ida_grout[i]; break; } /* No sign change in (tlo,tmid), and no zero at tmid. Sign change must be in (tmid,thi). Replace tlo with tmid. */ IDA_mem->ida_tlo = tmid; for (i = 0; i < IDA_mem->ida_nrtfn; i++) IDA_mem->ida_glo[i] = IDA_mem->ida_grout[i]; side = 2; /* Stop at root thi if converged; otherwise loop back. */ if (SUNRabs(IDA_mem->ida_thi - IDA_mem->ida_tlo) <= IDA_mem->ida_ttol) break; } /* End of root-search loop */ /* Reset trout and grout, set iroots, and return RTFOUND. */ IDA_mem->ida_trout = IDA_mem->ida_thi; for (i = 0; i < IDA_mem->ida_nrtfn; i++) { IDA_mem->ida_grout[i] = IDA_mem->ida_ghi[i]; IDA_mem->ida_iroots[i] = 0; if(!IDA_mem->ida_gactive[i]) continue; if ( (SUNRabs(IDA_mem->ida_ghi[i]) == ZERO) && (IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) ) IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1; if ( (IDA_mem->ida_glo[i]*IDA_mem->ida_ghi[i] < ZERO) && (IDA_mem->ida_rootdir[i]*IDA_mem->ida_glo[i] <= ZERO) ) IDA_mem->ida_iroots[i] = IDA_mem->ida_glo[i] > 0 ? -1:1; } return(RTFOUND); } /* * ================================================================= * Internal DQ approximations for sensitivity RHS * ================================================================= */ #undef user_dataS /* * IDASensResDQ * * IDASensRhsDQ computes the residuals of the sensitivity equations * by finite differences. It is of type IDASensResFn. * Returns 0 if successful, <0 if an unrecoverable failure occurred, * >0 for a recoverable error. */ int IDASensResDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp) { int retval, is; for (is=0; is0 if res has a recoverable error). */ static int IDASensRes1DQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, int is, N_Vector yyS, N_Vector ypS, N_Vector resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp) { IDAMem IDA_mem; int method; int which; int retval; realtype psave, pbari; realtype del , rdel; realtype Delp, rDelp, r2Delp; realtype Dely, rDely, r2Dely; realtype Del , rDel , r2Del ; realtype norms, ratio; /* user_dataS points to IDA_mem */ IDA_mem = (IDAMem) user_dataS; /* Set base perturbation del */ del = SUNRsqrt(SUNMAX(IDA_mem->ida_rtol, IDA_mem->ida_uround)); rdel = ONE/del; pbari = IDA_mem->ida_pbar[is]; which = IDA_mem->ida_plist[is]; psave = IDA_mem->ida_p[which]; Delp = pbari * del; rDelp = ONE/Delp; norms = N_VWrmsNorm(yyS, IDA_mem->ida_ewt) * pbari; rDely = SUNMAX(norms, rdel) / pbari; Dely = ONE/rDely; if (IDA_mem->ida_DQrhomax == ZERO) { /* No switching */ method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1; } else { /* switch between simultaneous/separate DQ */ ratio = Dely * rDelp; if ( SUNMAX(ONE/ratio, ratio) <= IDA_mem->ida_DQrhomax ) method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1; else method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED2 : FORWARD2; } switch (method) { case CENTERED1: Del = SUNMIN(Dely, Delp); r2Del = HALF/Del; /* Forward perturb y, y' and parameter */ N_VLinearSum(Del, yyS, ONE, yy, ytemp); N_VLinearSum(Del, ypS, ONE, yp, yptemp); IDA_mem->ida_p[which] = psave + Del; /* Save residual in resvalS */ retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Backward perturb y, y' and parameter */ N_VLinearSum(-Del, yyS, ONE, yy, ytemp); N_VLinearSum(-Del, ypS, ONE, yp, yptemp); IDA_mem->ida_p[which] = psave - Del; /* Save residual in restemp */ retval = IDA_mem->ida_res(t, ytemp, yptemp, restemp, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Estimate the residual for the i-th sensitivity equation */ N_VLinearSum(r2Del, resvalS, -r2Del, restemp, resvalS); break; case CENTERED2: r2Delp = HALF/Delp; r2Dely = HALF/Dely; /* Forward perturb y and y' */ N_VLinearSum(Dely, yyS, ONE, yy, ytemp); N_VLinearSum(Dely, ypS, ONE, yp, yptemp); /* Save residual in resvalS */ retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Backward perturb y and y' */ N_VLinearSum(-Dely, yyS, ONE, yy, ytemp); N_VLinearSum(-Dely, ypS, ONE, yp, yptemp); /* Save residual in restemp */ retval = IDA_mem->ida_res(t, ytemp, yptemp, restemp, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Save the first difference quotient in resvalS */ N_VLinearSum(r2Dely, resvalS, -r2Dely, restemp, resvalS); /* Forward perturb parameter */ IDA_mem->ida_p[which] = psave + Delp; /* Save residual in ytemp */ retval = IDA_mem->ida_res(t, yy, yp, ytemp, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Backward perturb parameter */ IDA_mem->ida_p[which] = psave - Delp; /* Save residual in yptemp */ retval = IDA_mem->ida_res(t, yy, yp, yptemp, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Save the second difference quotient in restemp */ N_VLinearSum(r2Delp, ytemp, -r2Delp, yptemp, restemp); /* Add the difference quotients for the sensitivity residual */ N_VLinearSum(ONE, resvalS, ONE, restemp, resvalS); break; case FORWARD1: Del = SUNMIN(Dely, Delp); rDel = ONE/Del; /* Forward perturb y, y' and parameter */ N_VLinearSum(Del, yyS, ONE, yy, ytemp); N_VLinearSum(Del, ypS, ONE, yp, yptemp); IDA_mem->ida_p[which] = psave + Del; /* Save residual in resvalS */ retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Estimate the residual for the i-th sensitivity equation */ N_VLinearSum(rDel, resvalS, -rDel, resval, resvalS); break; case FORWARD2: /* Forward perturb y and y' */ N_VLinearSum(Dely, yyS, ONE, yy, ytemp); N_VLinearSum(Dely, ypS, ONE, yp, yptemp); /* Save residual in resvalS */ retval = IDA_mem->ida_res(t, ytemp, yptemp, resvalS, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Save the first difference quotient in resvalS */ N_VLinearSum(rDely, resvalS, -rDely, resval, resvalS); /* Forward perturb parameter */ IDA_mem->ida_p[which] = psave + Delp; /* Save residual in restemp */ retval = IDA_mem->ida_res(t, yy, yp, restemp, IDA_mem->ida_user_data); IDA_mem->ida_nreS++; if (retval != 0) return(retval); /* Save the second difference quotient in restemp */ N_VLinearSum(rDelp, restemp, -rDelp, resval, restemp); /* Add the difference quotients for the sensitivity residual */ N_VLinearSum(ONE, resvalS, ONE, restemp, resvalS); break; } /* Restore original value of parameter */ IDA_mem->ida_p[which] = psave; return(0); } /* IDAQuadSensRhsInternalDQ - internal IDAQuadSensRhsFn * * IDAQuadSensRhsInternalDQ computes right hand side of all quadrature * sensitivity equations by finite differences. All work is actually * done in IDAQuadSensRhs1InternalDQ. */ static int IDAQuadSensRhsInternalDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *resvalQS, void *ida_mem, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS) { IDAMem IDA_mem; int is, retval; /* cvode_mem is passed here as user data */ IDA_mem = (IDAMem) ida_mem; for (is=0; isida_rtol, IDA_mem->ida_uround)); rdel = ONE/del; pbari = IDA_mem->ida_pbar[is]; which = IDA_mem->ida_plist[is]; psave = IDA_mem->ida_p[which]; Delp = pbari * del; norms = N_VWrmsNorm(yyS, IDA_mem->ida_ewt) * pbari; rDely = SUNMAX(norms, rdel) / pbari; Dely = ONE/rDely; method = (IDA_mem->ida_DQtype==IDA_CENTERED) ? CENTERED1 : FORWARD1; switch(method) { case CENTERED1: Del = SUNMIN(Dely, Delp); r2Del = HALF/Del; N_VLinearSum(ONE, yy, Del, yyS, yytmp); N_VLinearSum(ONE, yp, Del, ypS, yptmp); IDA_mem->ida_p[which] = psave + Del; retval = IDA_mem->ida_rhsQ(t, yytmp, yptmp, resvalQS, IDA_mem->ida_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(-Del, yyS, ONE, yy, yytmp); N_VLinearSum(-Del, ypS, ONE, yp, yptmp); IDA_mem->ida_p[which] = psave - Del; retval = IDA_mem->ida_rhsQ(t, yytmp, yptmp, tmpQS, IDA_mem->ida_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(r2Del, resvalQS, -r2Del, tmpQS, resvalQS); break; case FORWARD1: Del = SUNMIN(Dely, Delp); rdel = ONE/Del; N_VLinearSum(ONE, yy, Del, yyS, yytmp); N_VLinearSum(ONE, yp, Del, ypS, yptmp); IDA_mem->ida_p[which] = psave + Del; retval = IDA_mem->ida_rhsQ(t, yytmp, yptmp, resvalQS, IDA_mem->ida_user_data); nfel++; if (retval != 0) return(retval); N_VLinearSum(rdel, resvalQS, -rdel, resvalQ, resvalQS); break; } IDA_mem->ida_p[which] = psave; /* Increment counter nrQeS */ IDA_mem->ida_nrQeS += nfel; return(0); } /* * ================================================================= * IDA Error message handling functions * ================================================================= */ /* * IDAProcessError is a high level error handling function. * - If ida_mem==NULL it prints the error message to stderr. * - Otherwise, it sets up and calls the error handling function * pointed to by ida_ehfun. */ void IDAProcessError(IDAMem IDA_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...) { va_list ap; char msg[256]; /* Initialize the argument pointer variable (msgfmt is the last required argument to IDAProcessError) */ va_start(ap, msgfmt); /* Compose the message */ vsprintf(msg, msgfmt, ap); if (IDA_mem == NULL) { /* We write to stderr */ #ifndef NO_FPRINTF_OUTPUT STAN_SUNDIALS_FPRINTF(stderr, "\n[%s ERROR] %s\n ", module, fname); STAN_SUNDIALS_FPRINTF(stderr, "%s\n\n", msg); #endif } else { /* We can call ehfun */ IDA_mem->ida_ehfun(error_code, module, fname, msg, IDA_mem->ida_eh_data); } /* Finalize argument processing */ va_end(ap); return; } /* IDAErrHandler is the default error handling function. It sends the error message to the stream pointed to by ida_errfp */ void IDAErrHandler(int error_code, const char *module, const char *function, char *msg, void *data) { IDAMem IDA_mem; char err_type[10]; /* data points to IDA_mem here */ IDA_mem = (IDAMem) data; if (error_code == IDA_WARNING) sprintf(err_type,"WARNING"); else sprintf(err_type,"ERROR"); #ifndef NO_FPRINTF_OUTPUT if (IDA_mem->ida_errfp != NULL) { STAN_SUNDIALS_FPRINTF(IDA_mem->ida_errfp,"\n[%s %s] %s\n",module,err_type,function); STAN_SUNDIALS_FPRINTF(IDA_mem->ida_errfp," %s\n\n",msg); } #endif return; } StanHeaders/src/idas/LICENSE0000644000176200001440000000305013766554457015213 0ustar liggesusersBSD 3-Clause License Copyright (c) 2002-2019, Lawrence Livermore National Security and Southern Methodist University. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. StanHeaders/src/idas/idas_ls.c0000644000176200001440000023752113766554457016004 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Alan C. Hindmarsh and Radu Serban @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation file for IDAS' linear solver interface *-----------------------------------------------------------------*/ #include #include #include #include "idas_impl.h" #include "idas_ls_impl.h" #include #include #include #include /* constants */ #define MAX_ITERS 3 /* max. number of attempts to recover in DQ J*v */ #define ZERO RCONST(0.0) #define PT25 RCONST(0.25) #define PT05 RCONST(0.05) #define PT9 RCONST(0.9) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /*================================================================= PRIVATE FUNCTION PROTOTYPES =================================================================*/ static int idaLsJacBWrapper(realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rBr, SUNMatrix JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int idaLsJacBSWrapper(realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rBr, SUNMatrix JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); static int idaLsPrecSetupB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *idaadj_mem); static int idaLsPrecSetupBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *idaadj_mem); static int idaLsPrecSolveB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *idaadj_mem); static int idaLsPrecSolveBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *idaadj_mem); static int idaLsJacTimesSetupB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *idaadj_mem); static int idaLsJacTimesSetupBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *idaadj_mem); static int idaLsJacTimesVecB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *idaadj_mem, N_Vector tmp1B, N_Vector tmp2B); static int idaLsJacTimesVecBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *idaadj_mem, N_Vector tmp1B, N_Vector tmp2B); /*================================================================ PART I - forward problems ================================================================*/ /*--------------------------------------------------------------- IDASLS Exported functions -- Required ---------------------------------------------------------------*/ /* IDASetLinearSolver specifies the linear solver */ int IDASetLinearSolver(void *ida_mem, SUNLinearSolver LS, SUNMatrix A) { IDAMem IDA_mem; IDALsMem idals_mem; int retval, LSType; /* Return immediately if any input is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASLS", "IDASetLinearSolver", MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } if (LS == NULL) { IDAProcessError(NULL, IDALS_ILL_INPUT, "IDASLS", "IDASetLinearSolver", "LS must be non-NULL"); return(IDALS_ILL_INPUT); } IDA_mem = (IDAMem) ida_mem; /* Test if solver is compatible with LS interface */ if ( (LS->ops->gettype == NULL) || (LS->ops->initialize == NULL) || (LS->ops->setup == NULL) || (LS->ops->solve == NULL) ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetLinearSolver", "LS object is missing a required operation"); return(IDALS_ILL_INPUT); } /* Test if vector is compatible with LS */ if ( (IDA_mem->ida_tempv1->ops->nvdotprod == NULL) || (IDA_mem->ida_tempv1->ops->nvconst == NULL) ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetLinearSolver", MSG_LS_BAD_NVECTOR); return(IDALS_ILL_INPUT); } /* Retrieve the LS type */ LSType = SUNLinSolGetType(LS); /* Check for compatible LS type, matrix and "atimes" support */ if ( ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) && ( (LS->ops->resid == NULL) || (LS->ops->numiters == NULL) ) ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", "Iterative LS object requires 'resid' and 'numiters' routines"); return(IDALS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_ITERATIVE) && (LS->ops->setatimes == NULL)) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", "Incompatible inputs: iterative LS must support ATimes routine"); return(IDALS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_DIRECT) && (A == NULL)) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", "Incompatible inputs: direct LS requires non-NULL matrix"); return(IDALS_ILL_INPUT); } if ((LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) && (A == NULL)) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDALS", "IDASetLinearSolver", "Incompatible inputs: matrix-iterative LS requires non-NULL matrix"); return(IDALS_ILL_INPUT); } /* free any existing system solver attached to IDA */ if (IDA_mem->ida_lfree) IDA_mem->ida_lfree(IDA_mem); /* Set four main system linear solver function fields in IDA_mem */ IDA_mem->ida_linit = idaLsInitialize; IDA_mem->ida_lsetup = idaLsSetup; IDA_mem->ida_lsolve = idaLsSolve; IDA_mem->ida_lfree = idaLsFree; /* Set ida_lperf if using an iterative SUNLinearSolver object */ IDA_mem->ida_lperf = ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) ? idaLsPerf : NULL; /* Allocate memory for IDALsMemRec */ idals_mem = NULL; idals_mem = (IDALsMem) malloc(sizeof(struct IDALsMemRec)); if (idals_mem == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASLS", "IDASetLinearSolver", MSG_LS_MEM_FAIL); return(IDALS_MEM_FAIL); } memset(idals_mem, 0, sizeof(struct IDALsMemRec)); /* set SUNLinearSolver pointer */ idals_mem->LS = LS; /* Set defaults for Jacobian-related fields */ idals_mem->J = A; if (A != NULL) { idals_mem->jacDQ = SUNTRUE; idals_mem->jac = idaLsDQJac; idals_mem->J_data = IDA_mem; } else { idals_mem->jacDQ = SUNFALSE; idals_mem->jac = NULL; idals_mem->J_data = NULL; } idals_mem->jtimesDQ = SUNTRUE; idals_mem->jtsetup = NULL; idals_mem->jtimes = idaLsDQJtimes; idals_mem->jt_data = IDA_mem; /* Set defaults for preconditioner-related fields */ idals_mem->pset = NULL; idals_mem->psolve = NULL; idals_mem->pfree = NULL; idals_mem->pdata = IDA_mem->ida_user_data; /* Initialize counters */ idaLsInitializeCounters(idals_mem); /* Set default values for the rest of the Ls parameters */ idals_mem->eplifac = PT05; idals_mem->dqincfac = ONE; idals_mem->last_flag = IDALS_SUCCESS; /* Attach default IDALs interface routines to LS object */ if (LS->ops->setatimes) { retval = SUNLinSolSetATimes(LS, IDA_mem, idaLsATimes); if (retval != SUNLS_SUCCESS) { IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASLS", "IDASetLinearSolver", "Error in calling SUNLinSolSetATimes"); free(idals_mem); idals_mem = NULL; return(IDALS_SUNLS_FAIL); } } if (LS->ops->setpreconditioner) { retval = SUNLinSolSetPreconditioner(LS, IDA_mem, NULL, NULL); if (retval != SUNLS_SUCCESS) { IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASLS", "IDASetLinearSolver", "Error in calling SUNLinSolSetPreconditioner"); free(idals_mem); idals_mem = NULL; return(IDALS_SUNLS_FAIL); } } /* Allocate memory for ytemp, yptemp and x */ idals_mem->ytemp = N_VClone(IDA_mem->ida_tempv1); if (idals_mem->ytemp == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASLS", "IDASetLinearSolver", MSG_LS_MEM_FAIL); free(idals_mem); idals_mem = NULL; return(IDALS_MEM_FAIL); } idals_mem->yptemp = N_VClone(IDA_mem->ida_tempv1); if (idals_mem->yptemp == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASLS", "IDASetLinearSolver", MSG_LS_MEM_FAIL); N_VDestroy(idals_mem->ytemp); free(idals_mem); idals_mem = NULL; return(IDALS_MEM_FAIL); } idals_mem->x = N_VClone(IDA_mem->ida_tempv1); if (idals_mem->x == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASLS", "IDASetLinearSolver", MSG_LS_MEM_FAIL); N_VDestroy(idals_mem->ytemp); N_VDestroy(idals_mem->yptemp); free(idals_mem); idals_mem = NULL; return(IDALS_MEM_FAIL); } /* Compute sqrtN from a dot product */ N_VConst(ONE, idals_mem->ytemp); idals_mem->sqrtN = SUNRsqrt( N_VDotProd(idals_mem->ytemp, idals_mem->ytemp) ); /* Attach linear solver memory to integrator memory */ IDA_mem->ida_lmem = idals_mem; return(IDALS_SUCCESS); } /*--------------------------------------------------------------- IDASLS Exported functions -- Optional input/output ---------------------------------------------------------------*/ /* IDASetJacFn specifies the Jacobian function */ int IDASetJacFn(void *ida_mem, IDALsJacFn jac) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "IDALsSetJacFn", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* return with failure if jac cannot be used */ if ((jac != NULL) && (idals_mem->J == NULL)) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetJacFn", "Jacobian routine cannot be supplied for NULL SUNMatrix"); return(IDALS_ILL_INPUT); } /* set Jacobian routine pointer, and update relevant flags */ if (jac != NULL) { idals_mem->jacDQ = SUNFALSE; idals_mem->jac = jac; idals_mem->J_data = IDA_mem->ida_user_data; } else { idals_mem->jacDQ = SUNTRUE; idals_mem->jac = idaLsDQJac; idals_mem->J_data = IDA_mem; } return(IDALS_SUCCESS); } /* IDASetEpsLin specifies the nonlinear -> linear tolerance scale factor */ int IDASetEpsLin(void *ida_mem, realtype eplifac) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "IDASetEpsLin", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* Check for legal eplifac */ if (eplifac < ZERO) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetEpsLin", MSG_LS_NEG_EPLIFAC); return(IDALS_ILL_INPUT); } idals_mem->eplifac = (eplifac == ZERO) ? PT05 : eplifac; return(IDALS_SUCCESS); } /* IDASetIncrementFactor specifies increment factor for DQ approximations to Jv */ int IDASetIncrementFactor(void *ida_mem, realtype dqincfac) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "IDASetIncrementFactor", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* Check for legal dqincfac */ if (dqincfac <= ZERO) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetIncrementFactor", MSG_LS_NEG_DQINCFAC); return(IDALS_ILL_INPUT); } idals_mem->dqincfac = dqincfac; return(IDALS_SUCCESS); } /* IDASetPreconditioner specifies the user-supplied psetup and psolve routines */ int IDASetPreconditioner(void *ida_mem, IDALsPrecSetupFn psetup, IDALsPrecSolveFn psolve) { IDAMem IDA_mem; IDALsMem idals_mem; PSetupFn idals_psetup; PSolveFn idals_psolve; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "IDASetPreconditioner", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* store function pointers for user-supplied routines in IDALs interface */ idals_mem->pset = psetup; idals_mem->psolve = psolve; /* issue error if LS object does not allow user-supplied preconditioning */ if (idals_mem->LS->ops->setpreconditioner == NULL) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetPreconditioner", "SUNLinearSolver object does not support user-supplied preconditioning"); return(IDALS_ILL_INPUT); } /* notify iterative linear solver to call IDALs interface routines */ idals_psetup = (psetup == NULL) ? NULL : idaLsPSetup; idals_psolve = (psolve == NULL) ? NULL : idaLsPSolve; retval = SUNLinSolSetPreconditioner(idals_mem->LS, IDA_mem, idals_psetup, idals_psolve); if (retval != SUNLS_SUCCESS) { IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASLS", "IDASetPreconditioner", "Error in calling SUNLinSolSetPreconditioner"); return(IDALS_SUNLS_FAIL); } return(IDALS_SUCCESS); } /* IDASetJacTimes specifies the user-supplied Jacobian-vector product setup and multiply routines */ int IDASetJacTimes(void *ida_mem, IDALsJacTimesSetupFn jtsetup, IDALsJacTimesVecFn jtimes) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "IDASetJacTimes", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* issue error if LS object does not allow user-supplied ATimes */ if (idals_mem->LS->ops->setatimes == NULL) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetJacTimes", "SUNLinearSolver object does not support user-supplied ATimes routine"); return(IDALS_ILL_INPUT); } /* store function pointers for user-supplied routines in IDALs interface (NULL jtimes implies use of DQ default) */ if (jtimes != NULL) { idals_mem->jtimesDQ = SUNFALSE; idals_mem->jtsetup = jtsetup; idals_mem->jtimes = jtimes; idals_mem->jt_data = IDA_mem->ida_user_data; } else { idals_mem->jtimesDQ = SUNTRUE; idals_mem->jtsetup = NULL; idals_mem->jtimes = idaLsDQJtimes; idals_mem->jt_data = IDA_mem; } return(IDALS_SUCCESS); } /* IDAGetLinWorkSpace returns the length of workspace allocated for the IDALS linear solver interface */ int IDAGetLinWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { IDAMem IDA_mem; IDALsMem idals_mem; sunindextype lrw1, liw1; long int lrw, liw; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "IDAGetLinWorkSpace", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* start with fixed sizes plus vector/matrix pointers */ *lenrwLS = 3; *leniwLS = 34; /* add N_Vector sizes */ if (IDA_mem->ida_tempv1->ops->nvspace) { N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1); *lenrwLS += 3*lrw1; *leniwLS += 3*liw1; } /* add LS sizes */ if (idals_mem->LS->ops->space) { retval = SUNLinSolSpace(idals_mem->LS, &lrw, &liw); if (retval == 0) { *lenrwLS += lrw; *leniwLS += liw; } } return(IDALS_SUCCESS); } /* IDAGetNumJacEvals returns the number of Jacobian evaluations */ int IDAGetNumJacEvals(void *ida_mem, long int *njevals) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumJacEvals", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *njevals = idals_mem->nje; return(IDALS_SUCCESS); } /* IDAGetNumPrecEvals returns the number of preconditioner evaluations */ int IDAGetNumPrecEvals(void *ida_mem, long int *npevals) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumPrecEvals", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *npevals = idals_mem->npe; return(IDALS_SUCCESS); } /* IDAGetNumPrecSolves returns the number of preconditioner solves */ int IDAGetNumPrecSolves(void *ida_mem, long int *npsolves) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumPrecSolves", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *npsolves = idals_mem->nps; return(IDALS_SUCCESS); } /* IDAGetNumLinIters returns the number of linear iterations */ int IDAGetNumLinIters(void *ida_mem, long int *nliters) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumLinIters", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *nliters = idals_mem->nli; return(IDALS_SUCCESS); } /* IDAGetNumLinConvFails returns the number of linear convergence failures */ int IDAGetNumLinConvFails(void *ida_mem, long int *nlcfails) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumLinConvFails", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *nlcfails = idals_mem->ncfl; return(IDALS_SUCCESS); } /* IDAGetNumJTSetupEvals returns the number of calls to the user-supplied Jacobian-vector product setup routine */ int IDAGetNumJTSetupEvals(void *ida_mem, long int *njtsetups) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumJTSetupEvals", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *njtsetups = idals_mem->njtsetup; return(IDALS_SUCCESS); } /* IDAGetNumJtimesEvals returns the number of calls to the Jacobian-vector product multiply routine */ int IDAGetNumJtimesEvals(void *ida_mem, long int *njvevals) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumJtimesEvals", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *njvevals = idals_mem->njtimes; return(IDALS_SUCCESS); } /* IDAGetNumLinResEvals returns the number of calls to the DAE residual needed for the DQ Jacobian approximation or J*v product approximation */ int IDAGetNumLinResEvals(void *ida_mem, long int *nrevalsLS) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetNumLinResEvals", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *nrevalsLS = idals_mem->nreDQ; return(IDALS_SUCCESS); } /* IDAGetLastLinFlag returns the last flag set in a IDALS function */ int IDAGetLastLinFlag(void *ida_mem, long int *flag) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure; store output and return */ retval = idaLs_AccessLMem(ida_mem, "IDAGetLastLinFlag", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); *flag = idals_mem->last_flag; return(IDALS_SUCCESS); } /* IDAGetLinReturnFlagName translates from the integer error code returned by an IDALs routine to the corresponding string equivalent for that flag */ char *IDAGetLinReturnFlagName(long int flag) { char *name = (char *)malloc(30*sizeof(char)); switch(flag) { case IDALS_SUCCESS: sprintf(name,"IDALS_SUCCESS"); break; case IDALS_MEM_NULL: sprintf(name,"IDALS_MEM_NULL"); break; case IDALS_LMEM_NULL: sprintf(name,"IDALS_LMEM_NULL"); break; case IDALS_ILL_INPUT: sprintf(name,"IDALS_ILL_INPUT"); break; case IDALS_MEM_FAIL: sprintf(name,"IDALS_MEM_FAIL"); break; case IDALS_PMEM_NULL: sprintf(name,"IDALS_PMEM_NULL"); break; case IDALS_JACFUNC_UNRECVR: sprintf(name,"IDALS_JACFUNC_UNRECVR"); break; case IDALS_JACFUNC_RECVR: sprintf(name,"IDALS_JACFUNC_RECVR"); break; case IDALS_SUNMAT_FAIL: sprintf(name,"IDALS_SUNMAT_FAIL"); break; case IDALS_SUNLS_FAIL: sprintf(name,"IDALS_SUNLS_FAIL"); break; default: sprintf(name,"NONE"); } return(name); } /*----------------------------------------------------------------- IDASLS Private functions -----------------------------------------------------------------*/ /*--------------------------------------------------------------- idaLsATimes: This routine generates the matrix-vector product z = Jv, where J is the system Jacobian, by calling either the user provided routine or the internal DQ routine. The return value is the same as the value returned by jtimes -- 0 if successful, nonzero otherwise. ---------------------------------------------------------------*/ int idaLsATimes(void *ida_mem, N_Vector v, N_Vector z) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "idaLsATimes", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* call Jacobian-times-vector product routine (either user-supplied or internal DQ) */ retval = idals_mem->jtimes(IDA_mem->ida_tn, idals_mem->ycur, idals_mem->ypcur, idals_mem->rcur, v, z, IDA_mem->ida_cj, idals_mem->jt_data, idals_mem->ytemp, idals_mem->yptemp); idals_mem->njtimes++; return(retval); } /*--------------------------------------------------------------- idaLsPSetup: This routine interfaces between the generic iterative linear solvers and the user's psetup routine. It passes to psetup all required state information from ida_mem. Its return value is the same as that returned by psetup. Note that the generic iterative linear solvers guarantee that idaLsPSetup will only be called in the case that the user's psetup routine is non-NULL. ---------------------------------------------------------------*/ int idaLsPSetup(void *ida_mem) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "idaLsPSetup", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* Call user pset routine to update preconditioner and possibly reset jcur (pass !jbad as update suggestion) */ retval = idals_mem->pset(IDA_mem->ida_tn, idals_mem->ycur, idals_mem->ypcur, idals_mem->rcur, IDA_mem->ida_cj, idals_mem->pdata); idals_mem->npe++; return(retval); } /*--------------------------------------------------------------- idaLsPSolve: This routine interfaces between the generic SUNLinSolSolve routine and the user's psolve routine. It passes to psolve all required state information from ida_mem. Its return value is the same as that returned by psolve. Note that the generic SUNLinSol solver guarantees that IDASilsPSolve will not be called in the case in which preconditioning is not done. This is the only case in which the user's psolve routine is allowed to be NULL. ---------------------------------------------------------------*/ int idaLsPSolve(void *ida_mem, N_Vector r, N_Vector z, realtype tol, int lr) { IDAMem IDA_mem; IDALsMem idals_mem; int retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "idaLsPSolve", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); /* call the user-supplied psolve routine, and accumulate count */ retval = idals_mem->psolve(IDA_mem->ida_tn, idals_mem->ycur, idals_mem->ypcur, idals_mem->rcur, r, z, IDA_mem->ida_cj, tol, idals_mem->pdata); idals_mem->nps++; return(retval); } /*--------------------------------------------------------------- idaLsDQJac: This routine is a wrapper for the Dense and Band implementations of the difference quotient Jacobian approximation routines. ---------------------------------------------------------------*/ int idaLsDQJac(realtype t, realtype c_j, N_Vector y, N_Vector yp, N_Vector r, SUNMatrix Jac, void *ida_mem, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { int retval; IDAMem IDA_mem; IDA_mem = (IDAMem) ida_mem; /* access IDAMem structure */ if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASLS", "idaLsDQJac", MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } /* verify that Jac is non-NULL */ if (Jac == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASLS", "idaLsDQJac", MSG_LS_LMEM_NULL); return(IDALS_LMEM_NULL); } /* Verify that N_Vector supports required operations */ if (IDA_mem->ida_tempv1->ops->nvcloneempty == NULL || IDA_mem->ida_tempv1->ops->nvwrmsnorm == NULL || IDA_mem->ida_tempv1->ops->nvlinearsum == NULL || IDA_mem->ida_tempv1->ops->nvdestroy == NULL || IDA_mem->ida_tempv1->ops->nvscale == NULL || IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL || IDA_mem->ida_tempv1->ops->nvsetarraypointer == NULL) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "idaLsDQJac", MSG_LS_BAD_NVECTOR); return(IDALS_ILL_INPUT); } /* Call the matrix-structure-specific DQ approximation routine */ if (SUNMatGetID(Jac) == SUNMATRIX_DENSE) { retval = idaLsDenseDQJac(t, c_j, y, yp, r, Jac, IDA_mem, tmp1); } else if (SUNMatGetID(Jac) == SUNMATRIX_BAND) { retval = idaLsBandDQJac(t, c_j, y, yp, r, Jac, IDA_mem, tmp1, tmp2, tmp3); } else { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDASLS", "idaLsDQJac", "unrecognized matrix type for idaLsDQJac"); retval = IDA_ILL_INPUT; } return(retval); } /*--------------------------------------------------------------- idaLsDenseDQJac This routine generates a dense difference quotient approximation to the Jacobian F_y + c_j*F_y'. It assumes a dense SUNmatrix input (stored column-wise, and that elements within each column are contiguous). The address of the jth column of J is obtained via the function SUNDenseMatrix_Column() and this pointer is associated with an N_Vector using the N_VGetArrayPointer/N_VSetArrayPointer functions. Finally, the actual computation of the jth column of the Jacobian is done with a call to N_VLinearSum. ---------------------------------------------------------------*/ int idaLsDenseDQJac(realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, SUNMatrix Jac, IDAMem IDA_mem, N_Vector tmp1) { realtype inc, inc_inv, yj, ypj, srur, conj; realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; N_Vector rtemp, jthCol; sunindextype j, N; IDALsMem idals_mem; int retval = 0; /* access LsMem interface structure */ idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* access matrix dimension */ N = SUNDenseMatrix_Rows(Jac); /* Rename work vectors for readibility */ rtemp = tmp1; /* Create an empty vector for matrix column calculations */ jthCol = N_VCloneEmpty(tmp1); /* Obtain pointers to the data for ewt, yy, yp. */ ewt_data = N_VGetArrayPointer(IDA_mem->ida_ewt); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); if(IDA_mem->ida_constraints!=NULL) cns_data = N_VGetArrayPointer(IDA_mem->ida_constraints); srur = SUNRsqrt(IDA_mem->ida_uround); for (j=0; j < N; j++) { /* Generate the jth col of J(tt,yy,yp) as delta(F)/delta(y_j). */ /* Set data address of jthCol, and save y_j and yp_j values. */ N_VSetArrayPointer(SUNDenseMatrix_Column(Jac,j), jthCol); yj = y_data[j]; ypj = yp_data[j]; /* Set increment inc to y_j based on sqrt(uround)*abs(y_j), with adjustments using yp_j and ewt_j if this is small, and a further adjustment to give it the same sign as hh*yp_j. */ inc = SUNMAX( srur * SUNMAX( SUNRabs(yj), SUNRabs(IDA_mem->ida_hh*ypj) ), ONE/ewt_data[j] ); if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if y_j has an inequality constraint. */ if (IDA_mem->ida_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment y_j and yp_j, call res, and break on error return. */ y_data[j] += inc; yp_data[j] += c_j*inc; retval = IDA_mem->ida_res(tt, yy, yp, rtemp, IDA_mem->ida_user_data); idals_mem->nreDQ++; if (retval != 0) break; /* Construct difference quotient in jthCol */ inc_inv = ONE/inc; N_VLinearSum(inc_inv, rtemp, -inc_inv, rr, jthCol); /* reset y_j, yp_j */ y_data[j] = yj; yp_data[j] = ypj; } /* Destroy jthCol vector */ N_VSetArrayPointer(NULL, jthCol); /* SHOULDN'T BE NEEDED */ N_VDestroy(jthCol); return(retval); } /*--------------------------------------------------------------- idaLsBandDQJac This routine generates a banded difference quotient approximation JJ to the DAE system Jacobian J. It assumes a band SUNMatrix input (stored column-wise, and that elements within each column are contiguous). This makes it possible to get the address of a column of JJ via the function SUNBandMatrix_Column(). The columns of the Jacobian are constructed using mupper + mlower + 1 calls to the res routine, and appropriate differencing. The return value is either IDABAND_SUCCESS = 0, or the nonzero value returned by the res routine, if any. ---------------------------------------------------------------*/ int idaLsBandDQJac(realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, SUNMatrix Jac, IDAMem IDA_mem, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { realtype inc, inc_inv, yj, ypj, srur, conj, ewtj; realtype *y_data, *yp_data, *ewt_data, *cns_data = NULL; realtype *ytemp_data, *yptemp_data, *rtemp_data, *r_data, *col_j; N_Vector rtemp, ytemp, yptemp; sunindextype i, j, i1, i2, width, ngroups, group; sunindextype N, mupper, mlower; IDALsMem idals_mem; int retval = 0; /* access LsMem interface structure */ idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* access matrix dimensions */ N = SUNBandMatrix_Columns(Jac); mupper = SUNBandMatrix_UpperBandwidth(Jac); mlower = SUNBandMatrix_LowerBandwidth(Jac); /* Rename work vectors for use as temporary values of r, y and yp */ rtemp = tmp1; ytemp = tmp2; yptemp= tmp3; /* Obtain pointers to the data for all eight vectors used. */ ewt_data = N_VGetArrayPointer(IDA_mem->ida_ewt); r_data = N_VGetArrayPointer(rr); y_data = N_VGetArrayPointer(yy); yp_data = N_VGetArrayPointer(yp); rtemp_data = N_VGetArrayPointer(rtemp); ytemp_data = N_VGetArrayPointer(ytemp); yptemp_data = N_VGetArrayPointer(yptemp); if (IDA_mem->ida_constraints != NULL) cns_data = N_VGetArrayPointer(IDA_mem->ida_constraints); /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Compute miscellaneous values for the Jacobian computation. */ srur = SUNRsqrt(IDA_mem->ida_uround); width = mlower + mupper + 1; ngroups = SUNMIN(width, N); /* Loop over column groups. */ for (group=1; group <= ngroups; group++) { /* Increment all yy[j] and yp[j] for j in this group. */ for (j=group-1; jida_hh*ypj) ), ONE/ewtj ); if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (IDA_mem->ida_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment yj and ypj. */ ytemp_data[j] += inc; yptemp_data[j] += IDA_mem->ida_cj*inc; } /* Call res routine with incremented arguments. */ retval = IDA_mem->ida_res(tt, ytemp, yptemp, rtemp, IDA_mem->ida_user_data); idals_mem->nreDQ++; if (retval != 0) break; /* Loop over the indices j in this group again. */ for (j=group-1; jida_hh*ypj) ), ONE/ewtj ); if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; if (IDA_mem->ida_constraints != NULL) { conj = cns_data[j]; if (SUNRabs(conj) == ONE) {if((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if((yj+inc)*conj <= ZERO) inc = -inc;} } /* Load the difference quotient Jacobian elements for column j */ inc_inv = ONE/inc; i1 = SUNMAX(0, j-mupper); i2 = SUNMIN(j+mlower,N-1); for (i=i1; i<=i2; i++) SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (rtemp_data[i]-r_data[i]); } } return(retval); } /*--------------------------------------------------------------- idaLsDQJtimes This routine generates a difference quotient approximation to the matrix-vector product z = Jv, where J is the system Jacobian. The approximation is Jv = [F(t,y1,yp1) - F(t,y,yp)]/sigma, where y1 = y + sigma*v, yp1 = yp + cj*sigma*v, sigma = sqrt(Neq)*dqincfac. The return value from the call to res is saved in order to set the return flag from idaLsSolve. ---------------------------------------------------------------*/ int idaLsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *ida_mem, N_Vector work1, N_Vector work2) { IDAMem IDA_mem; IDALsMem idals_mem; N_Vector y_tmp, yp_tmp; realtype sig, siginv; int iter, retval; /* access IDALsMem structure */ retval = idaLs_AccessLMem(ida_mem, "idaLsDQJtimes", &IDA_mem, &idals_mem); if (retval != IDALS_SUCCESS) return(retval); sig = idals_mem->sqrtN * idals_mem->dqincfac; /* GMRES */ /*sig = idals_mem->dqincfac / N_VWrmsNorm(v, IDA_mem->ida_ewt);*/ /* BiCGStab/TFQMR */ /* Rename work1 and work2 for readibility */ y_tmp = work1; yp_tmp = work2; for (iter=0; iterida_res(tt, y_tmp, yp_tmp, Jv, IDA_mem->ida_user_data); idals_mem->nreDQ++; if (retval == 0) break; if (retval < 0) return(-1); sig *= PT25; } if (retval > 0) return(+1); /* Set Jv to [Jv - rr]/sig and return. */ siginv = ONE/sig; N_VLinearSum(siginv, Jv, -siginv, rr, Jv); return(0); } /*--------------------------------------------------------------- idaLsInitialize This routine performs remaining initializations specific to the iterative linear solver interface (and solver itself) ---------------------------------------------------------------*/ int idaLsInitialize(IDAMem IDA_mem) { IDALsMem idals_mem; int retval; /* access IDALsMem structure */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASLS", "idaLsInitialize", MSG_LS_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Test for valid combinations of matrix & Jacobian routines: */ if (idals_mem->J == NULL) { /* If SUNMatrix A is NULL: ensure 'jac' function pointer is NULL */ idals_mem->jacDQ = SUNFALSE; idals_mem->jac = NULL; idals_mem->J_data = NULL; } else if (idals_mem->jacDQ) { /* If J is non-NULL, and 'jac' is not user-supplied: - if J is dense or band, ensure that our DQ approx. is used - otherwise => error */ retval = 0; if (idals_mem->J->ops->getid) { if ( (SUNMatGetID(idals_mem->J) == SUNMATRIX_DENSE) || (SUNMatGetID(idals_mem->J) == SUNMATRIX_BAND) ) { idals_mem->jac = idaLsDQJac; idals_mem->J_data = IDA_mem; } else { retval++; } } else { retval++; } if (retval) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "idaLsInitialize", "No Jacobian constructor available for SUNMatrix type"); idals_mem->last_flag = IDALS_ILL_INPUT; return(IDALS_ILL_INPUT); } } else { /* If J is non-NULL, and 'jac' is user-supplied, reset J_data pointer (just in case) */ idals_mem->J_data = IDA_mem->ida_user_data; } /* reset counters */ idaLsInitializeCounters(idals_mem); /* Set Jacobian-related fields, based on jtimesDQ */ if (idals_mem->jtimesDQ) { idals_mem->jtsetup = NULL; idals_mem->jtimes = idaLsDQJtimes; idals_mem->jt_data = IDA_mem; } else { idals_mem->jt_data = IDA_mem->ida_user_data; } /* if J is NULL and psetup is not present, then idaLsSetup does not need to be called, so set the lsetup function to NULL */ if ( (idals_mem->J == NULL) && (idals_mem->pset == NULL) ) IDA_mem->ida_lsetup = NULL; /* Call LS initialize routine */ idals_mem->last_flag = SUNLinSolInitialize(idals_mem->LS); return(idals_mem->last_flag); } /*--------------------------------------------------------------- idaLsSetup This calls the Jacobian evaluation routine (if using a SUNMatrix object), updates counters, and calls the LS 'setup' routine to prepare for subsequent calls to the LS 'solve' routine. ---------------------------------------------------------------*/ int idaLsSetup(IDAMem IDA_mem, N_Vector y, N_Vector yp, N_Vector r, N_Vector vt1, N_Vector vt2, N_Vector vt3) { IDALsMem idals_mem; int retval; /* access IDALsMem structure */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASLS", "idaLsSetup", MSG_LS_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Set IDALs N_Vector pointers to inputs */ idals_mem->ycur = y; idals_mem->ypcur = yp; idals_mem->rcur = r; /* recompute if J if it is non-NULL */ if (idals_mem->J) { /* Increment nje counter. */ idals_mem->nje++; /* Zero out J; call Jacobian routine jac; return if it failed. */ retval = SUNMatZero(idals_mem->J); if (retval != 0) { IDAProcessError(IDA_mem, IDALS_SUNMAT_FAIL, "IDASLS", "idaLsSetup", MSG_LS_MATZERO_FAILED); idals_mem->last_flag = IDALS_SUNMAT_FAIL; return(idals_mem->last_flag); } /* Call Jacobian routine */ retval = idals_mem->jac(IDA_mem->ida_tn, IDA_mem->ida_cj, y, yp, r, idals_mem->J, idals_mem->J_data, vt1, vt2, vt3); if (retval < 0) { IDAProcessError(IDA_mem, IDALS_JACFUNC_UNRECVR, "IDASLS", "idaLsSetup", MSG_LS_JACFUNC_FAILED); idals_mem->last_flag = IDALS_JACFUNC_UNRECVR; return(-1); } if (retval > 0) { idals_mem->last_flag = IDALS_JACFUNC_RECVR; return(1); } } /* Call LS setup routine -- the LS will call idaLsPSetup if applicable */ idals_mem->last_flag = SUNLinSolSetup(idals_mem->LS, idals_mem->J); return(idals_mem->last_flag); } /*--------------------------------------------------------------- idaLsSolve This routine interfaces between IDA and the generic SUNLinearSolver object LS, by setting the appropriate tolerance and scaling vectors, calling the solver, accumulating statistics from the solve for use/reporting by IDA, and scaling the result if using a non-NULL SUNMatrix and cjratio does not equal one. ---------------------------------------------------------------*/ int idaLsSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rescur) { IDALsMem idals_mem; int nli_inc, retval, LSType; realtype tol, w_mean; /* access IDALsMem structure */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASLS", "idaLsSolve", MSG_LS_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Retrieve the LS type */ LSType = SUNLinSolGetType(idals_mem->LS); /* If the linear solver is iterative: set convergence test constant tol, in terms of the Newton convergence test constant epsNewt and safety factors. The factor sqrt(Neq) assures that the convergence test is applied to the WRMS norm of the residual vector, rather than the weighted L2 norm. */ if ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) { tol = idals_mem->sqrtN * idals_mem->eplifac * IDA_mem->ida_epsNewt; } else { tol = ZERO; } /* Set vectors ycur, ypcur and rcur for use by the Atimes and Psolve interface routines */ idals_mem->ycur = ycur; idals_mem->ypcur = ypcur; idals_mem->rcur = rescur; /* Set initial guess x = 0 to LS */ N_VConst(ZERO, idals_mem->x); /* Set scaling vectors for LS to use (if applicable) */ if (idals_mem->LS->ops->setscalingvectors) { retval = SUNLinSolSetScalingVectors(idals_mem->LS, weight, weight); if (retval != SUNLS_SUCCESS) { IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASLS", "idaLsSolve", "Error in calling SUNLinSolSetScalingVectors"); idals_mem->last_flag = IDALS_SUNLS_FAIL; return(idals_mem->last_flag); } /* If solver is iterative and does not support scaling vectors, update the tolerance in an attempt to account for weight vector. We make the following assumptions: 1. w_i = w_mean, for i=0,...,n-1 (i.e. the weights are homogeneous) 2. the linear solver uses a basic 2-norm to measure convergence Hence (using the notation from sunlinsol_spgmr.h, with S = diag(w)), || bbar - Abar xbar ||_2 < tol <=> || S b - S A x ||_2 < tol <=> || S (b - A x) ||_2 < tol <=> \sum_{i=0}^{n-1} (w_i (b - A x)_i)^2 < tol^2 <=> w_mean^2 \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 <=> \sum_{i=0}^{n-1} (b - A x_i)^2 < tol^2 / w_mean^2 <=> || b - A x ||_2 < tol / w_mean So we compute w_mean = ||w||_RMS = ||w||_2 / sqrt(n), and scale the desired tolerance accordingly. */ } else if ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) { w_mean = SUNRsqrt( N_VDotProd(weight, weight) ) / idals_mem->sqrtN; tol /= w_mean; } /* If a user-provided jtsetup routine is supplied, call that here */ if (idals_mem->jtsetup) { idals_mem->last_flag = idals_mem->jtsetup(IDA_mem->ida_tn, ycur, ypcur, rescur, IDA_mem->ida_cj, idals_mem->jt_data); idals_mem->njtsetup++; if (idals_mem->last_flag != 0) { IDAProcessError(IDA_mem, retval, "IDASLS", "idaLsSolve", MSG_LS_JTSETUP_FAILED); return(idals_mem->last_flag); } } /* Call solver */ retval = SUNLinSolSolve(idals_mem->LS, idals_mem->J, idals_mem->x, b, tol); /* Copy appropriate result to b (depending on solver type) */ if ( (LSType == SUNLINEARSOLVER_ITERATIVE) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE) ) { /* Retrieve solver statistics */ nli_inc = SUNLinSolNumIters(idals_mem->LS); /* Copy x (or preconditioned residual vector if no iterations required) to b */ if (nli_inc == 0) N_VScale(ONE, SUNLinSolResid(idals_mem->LS), b); else N_VScale(ONE, idals_mem->x, b); /* Increment nli counter */ idals_mem->nli += nli_inc; } else { /* Copy x to b */ N_VScale(ONE, idals_mem->x, b); } /* If using a direct or matrix-iterative solver, scale the correction to account for change in cj */ if ( ((LSType == SUNLINEARSOLVER_DIRECT) || (LSType == SUNLINEARSOLVER_MATRIX_ITERATIVE)) && (IDA_mem->ida_cjratio != ONE) ) N_VScale(TWO/(ONE + IDA_mem->ida_cjratio), b, b); /* Increment ncfl counter */ if (retval != SUNLS_SUCCESS) idals_mem->ncfl++; /* Interpret solver return value */ idals_mem->last_flag = retval; switch(retval) { case SUNLS_SUCCESS: return(0); break; case SUNLS_RES_REDUCED: case SUNLS_CONV_FAIL: case SUNLS_PSOLVE_FAIL_REC: case SUNLS_PACKAGE_FAIL_REC: case SUNLS_QRFACT_FAIL: case SUNLS_LUFACT_FAIL: return(1); break; case SUNLS_MEM_NULL: case SUNLS_ILL_INPUT: case SUNLS_MEM_FAIL: case SUNLS_GS_FAIL: case SUNLS_QRSOL_FAIL: return(-1); break; case SUNLS_PACKAGE_FAIL_UNREC: IDAProcessError(IDA_mem, SUNLS_PACKAGE_FAIL_UNREC, "IDASLS", "idaLsSolve", "Failure in SUNLinSol external package"); return(-1); break; case SUNLS_PSOLVE_FAIL_UNREC: IDAProcessError(IDA_mem, SUNLS_PSOLVE_FAIL_UNREC, "IDASLS", "idaLsSolve", MSG_LS_PSOLVE_FAILED); return(-1); break; } return(0); } /*--------------------------------------------------------------- idaLsPerf: accumulates performance statistics information for IDA ---------------------------------------------------------------*/ int idaLsPerf(IDAMem IDA_mem, int perftask) { IDALsMem idals_mem; realtype rcfn, rcfl; long int nstd, nnid; booleantype lcfn, lcfl; /* access IDALsMem structure */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASLS", "idaLsPerf", MSG_LS_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* when perftask == 0, store current performance statistics */ if (perftask == 0) { idals_mem->nst0 = IDA_mem->ida_nst; idals_mem->nni0 = IDA_mem->ida_nni; idals_mem->ncfn0 = IDA_mem->ida_ncfn; idals_mem->ncfl0 = idals_mem->ncfl; idals_mem->nwarn = 0; return(0); } /* Compute statistics since last call Note: the performance monitor that checked whether the average number of linear iterations was too close to maxl has been removed, since the 'maxl' value is no longer owned by the IDALs interface. */ nstd = IDA_mem->ida_nst - idals_mem->nst0; nnid = IDA_mem->ida_nni - idals_mem->nni0; if (nstd == 0 || nnid == 0) return(0); rcfn = (realtype) ( (IDA_mem->ida_ncfn - idals_mem->ncfn0) / ((realtype) nstd) ); rcfl = (realtype) ( (idals_mem->ncfl - idals_mem->ncfl0) / ((realtype) nnid) ); lcfn = (rcfn > PT9); lcfl = (rcfl > PT9); if (!(lcfn || lcfl)) return(0); idals_mem->nwarn++; if (idals_mem->nwarn > 10) return(1); if (lcfn) IDAProcessError(IDA_mem, IDA_WARNING, "IDASLS", "idaLsPerf", MSG_LS_CFN_WARN, IDA_mem->ida_tn, rcfn); if (lcfl) IDAProcessError(IDA_mem, IDA_WARNING, "IDASLS", "idaLsPerf", MSG_LS_CFL_WARN, IDA_mem->ida_tn, rcfl); return(0); } /*--------------------------------------------------------------- idaLsFree frees memory associates with the IDALs system solver interface. ---------------------------------------------------------------*/ int idaLsFree(IDAMem IDA_mem) { IDALsMem idals_mem; /* Return immediately if IDA_mem or IDA_mem->ida_lmem are NULL */ if (IDA_mem == NULL) return (IDALS_SUCCESS); if (IDA_mem->ida_lmem == NULL) return(IDALS_SUCCESS); idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Free N_Vector memory */ if (idals_mem->ytemp) { N_VDestroy(idals_mem->ytemp); idals_mem->ytemp = NULL; } if (idals_mem->yptemp) { N_VDestroy(idals_mem->yptemp); idals_mem->yptemp = NULL; } if (idals_mem->x) { N_VDestroy(idals_mem->x); idals_mem->x = NULL; } /* Nullify other N_Vector pointers */ idals_mem->ycur = NULL; idals_mem->ypcur = NULL; idals_mem->rcur = NULL; /* Nullify SUNMatrix pointer */ idals_mem->J = NULL; /* Free preconditioner memory (if applicable) */ if (idals_mem->pfree) idals_mem->pfree(IDA_mem); /* free IDALs interface structure */ free(IDA_mem->ida_lmem); return(IDALS_SUCCESS); } /*--------------------------------------------------------------- idaLsInitializeCounters resets all counters from an IDALsMem structure. ---------------------------------------------------------------*/ int idaLsInitializeCounters(IDALsMem idals_mem) { idals_mem->nje = 0; idals_mem->nreDQ = 0; idals_mem->npe = 0; idals_mem->nli = 0; idals_mem->nps = 0; idals_mem->ncfl = 0; idals_mem->njtsetup = 0; idals_mem->njtimes = 0; return(0); } /*--------------------------------------------------------------- idaLs_AccessLMem This routine unpacks the IDA_mem and idals_mem structures from the void* ida_mem pointer. If either is missing it returns IDALS_MEM_NULL or IDALS_LMEM_NULL. ---------------------------------------------------------------*/ int idaLs_AccessLMem(void* ida_mem, const char* fname, IDAMem* IDA_mem, IDALsMem* idals_mem) { if (ida_mem==NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASLS", fname, MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } *IDA_mem = (IDAMem) ida_mem; if ((*IDA_mem)->ida_lmem==NULL) { IDAProcessError(*IDA_mem, IDALS_LMEM_NULL, "IDASLS", fname, MSG_LS_LMEM_NULL); return(IDALS_LMEM_NULL); } *idals_mem = (IDALsMem) (*IDA_mem)->ida_lmem; return(IDALS_SUCCESS); } /*================================================================ PART II - backward problems ================================================================*/ /*--------------------------------------------------------------- IDASLS Exported functions -- Required ---------------------------------------------------------------*/ /* IDASetLinearSolverB specifies the iterative linear solver for backward integration */ int IDASetLinearSolverB(void *ida_mem, int which, SUNLinearSolver LS, SUNMatrix A) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; void *ida_memB; int retval; /* Check if ida_mem exists */ if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASLS", "IDASetLinearSolverB", MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Was ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDALS_NO_ADJ, "IDASLS", "IDASetLinearSolverB", MSG_LS_NO_ADJ); return(IDALS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASLS", "IDASetLinearSolverB", MSG_LS_BAD_WHICH); return(IDALS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; IDAB_mem = IDAB_mem->ida_next; } /* Get memory for IDALsMemRecB */ idalsB_mem = NULL; idalsB_mem = (IDALsMemB) malloc(sizeof(struct IDALsMemRecB)); if (idalsB_mem == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASLS", "IDASetLinearSolverB", MSG_LS_MEM_FAIL); return(IDALS_MEM_FAIL); } /* initialize Jacobian and preconditioner functions */ idalsB_mem->jacB = NULL; idalsB_mem->jacBS = NULL; idalsB_mem->jtsetupB = NULL; idalsB_mem->jtsetupBS = NULL; idalsB_mem->jtimesB = NULL; idalsB_mem->jtimesBS = NULL; idalsB_mem->psetB = NULL; idalsB_mem->psetBS = NULL; idalsB_mem->psolveB = NULL; idalsB_mem->psolveBS = NULL; idalsB_mem->P_dataB = NULL; /* free any existing system solver attached to IDAB */ if (IDAB_mem->ida_lfree) IDAB_mem->ida_lfree(IDAB_mem); /* Attach lmemB data and lfreeB function. */ IDAB_mem->ida_lmem = idalsB_mem; IDAB_mem->ida_lfree = idaLsFreeB; /* set the linear solver for this backward problem */ ida_memB = (void *)IDAB_mem->IDA_mem; retval = IDASetLinearSolver(ida_memB, LS, A); if (retval != IDALS_SUCCESS) { free(idalsB_mem); idalsB_mem = NULL; } return(retval); } /*--------------------------------------------------------------- IDASLS Exported functions -- Optional input/output ---------------------------------------------------------------*/ int IDASetJacFnB(void *ida_mem, int which, IDALsJacFnB jacB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; void *ida_memB; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetJacFnB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* set jacB function pointer */ idalsB_mem->jacB = jacB; /* call corresponding routine for IDAB_mem structure */ ida_memB = (void*) IDAB_mem->IDA_mem; if (jacB != NULL) { retval = IDASetJacFn(ida_memB, idaLsJacBWrapper); } else { retval = IDASetJacFn(ida_memB, NULL); } return(retval); } int IDASetJacFnBS(void *ida_mem, int which, IDALsJacFnBS jacBS) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; void *ida_memB; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetJacFnBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* set jacBS function pointer */ idalsB_mem->jacBS = jacBS; /* call corresponding routine for IDAB_mem structure */ ida_memB = (void*) IDAB_mem->IDA_mem; if (jacBS != NULL) { retval = IDASetJacFn(ida_memB, idaLsJacBSWrapper); } else { retval = IDASetJacFn(ida_memB, NULL); } return(retval); } int IDASetEpsLinB(void *ida_mem, int which, realtype eplifacB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; void *ida_memB; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetEpsLinB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* call corresponding routine for IDAB_mem structure */ ida_memB = (void *) IDAB_mem->IDA_mem; return(IDASetEpsLin(ida_memB, eplifacB)); } int IDASetIncrementFactorB(void *ida_mem, int which, realtype dqincfacB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; void *ida_memB; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetIncrementFactorB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* call corresponding routine for IDAB_mem structure */ ida_memB = (void *) IDAB_mem->IDA_mem; return(IDASetIncrementFactor(ida_memB, dqincfacB)); } int IDASetPreconditionerB(void *ida_mem, int which, IDALsPrecSetupFnB psetupB, IDALsPrecSolveFnB psolveB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; IDALsMemB idalsB_mem; IDALsPrecSetupFn idals_psetup; IDALsPrecSolveFn idals_psolve; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetPreconditionerB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* Set preconditioners for the backward problem. */ idalsB_mem->psetB = psetupB; idalsB_mem->psolveB = psolveB; /* Call the corresponding "set" routine for the backward problem */ ida_memB = (void *) IDAB_mem->IDA_mem; idals_psetup = (psetupB == NULL) ? NULL : idaLsPrecSetupB; idals_psolve = (psolveB == NULL) ? NULL : idaLsPrecSolveB; return(IDASetPreconditioner(ida_memB, idals_psetup, idals_psolve)); } int IDASetPreconditionerBS(void *ida_mem, int which, IDALsPrecSetupFnBS psetupBS, IDALsPrecSolveFnBS psolveBS) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; IDALsMemB idalsB_mem; IDALsPrecSetupFn idals_psetup; IDALsPrecSolveFn idals_psolve; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetPreconditionerBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* Set preconditioners for the backward problem. */ idalsB_mem->psetBS = psetupBS; idalsB_mem->psolveBS = psolveBS; /* Call the corresponding "set" routine for the backward problem */ ida_memB = (void *) IDAB_mem->IDA_mem; idals_psetup = (psetupBS == NULL) ? NULL : idaLsPrecSetupBS; idals_psolve = (psolveBS == NULL) ? NULL : idaLsPrecSolveBS; return(IDASetPreconditioner(ida_memB, idals_psetup, idals_psolve)); } int IDASetJacTimesB(void *ida_mem, int which, IDALsJacTimesSetupFnB jtsetupB, IDALsJacTimesVecFnB jtimesB) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; IDALsMemB idalsB_mem; IDALsJacTimesSetupFn idals_jtsetup; IDALsJacTimesVecFn idals_jtimes; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetJacTimesB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* Set jacobian routines for the backward problem. */ idalsB_mem->jtsetupB = jtsetupB; idalsB_mem->jtimesB = jtimesB; /* Call the corresponding "set" routine for the backward problem */ ida_memB = (void *) IDAB_mem->IDA_mem; idals_jtsetup = (jtsetupB == NULL) ? NULL : idaLsJacTimesSetupB; idals_jtimes = (jtimesB == NULL) ? NULL : idaLsJacTimesVecB; return(IDASetJacTimes(ida_memB, idals_jtsetup, idals_jtimes)); } int IDASetJacTimesBS(void *ida_mem, int which, IDALsJacTimesSetupFnBS jtsetupBS, IDALsJacTimesVecFnBS jtimesBS) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void *ida_memB; IDALsMemB idalsB_mem; IDALsJacTimesSetupFn idals_jtsetup; IDALsJacTimesVecFn idals_jtimes; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemB(ida_mem, which, "IDASetJacTimesBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); if (retval != IDALS_SUCCESS) return(retval); /* Set jacobian routines for the backward problem. */ idalsB_mem->jtsetupBS = jtsetupBS; idalsB_mem->jtimesBS = jtimesBS; /* Call the corresponding "set" routine for the backward problem */ ida_memB = (void *) IDAB_mem->IDA_mem; idals_jtsetup = (jtsetupBS == NULL) ? NULL : idaLsJacTimesSetupBS; idals_jtimes = (jtimesBS == NULL) ? NULL : idaLsJacTimesVecBS; return(IDASetJacTimes(ida_memB, idals_jtsetup, idals_jtimes)); } /*----------------------------------------------------------------- IDASLS Private functions for backwards problems -----------------------------------------------------------------*/ /* idaLsJacBWrapper interfaces to the IDAJacFnB routine provided by the user. idaLsJacBWrapper is of type IDALsJacFn. */ static int idaLsJacBWrapper(realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rrB, SUNMatrix JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsJacBWrapper", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Forward solution from interpolation */ if (IDAADJ_mem->ia_noInterp == SUNFALSE) { retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsJacBWrapper", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint jacB routine */ return(idalsB_mem->jacB(tt, c_jB, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, rrB, JacB, IDAB_mem->ida_user_data, tmp1B, tmp2B, tmp3B)); } /* idaLsJacBSWrapper interfaces to the IDAJacFnBS routine provided by the user. idaLsJacBSWrapper is of type IDALsJacFn. */ static int idaLsJacBSWrapper(realtype tt, realtype c_jB, N_Vector yyB, N_Vector ypB, N_Vector rrB, SUNMatrix JacB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; IDALsMemB idalsB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsJacBSWrapper", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if(IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); else retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsJacBSWrapper", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint jacBS routine */ return(idalsB_mem->jacBS(tt, c_jB, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, rrB, JacB, IDAB_mem->ida_user_data, tmp1B, tmp2B, tmp3B)); } /* idaLsPrecSetupB interfaces to the IDALsPrecSetupFnB routine provided by the user */ static int idaLsPrecSetupB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsPrecSetupB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp==SUNFALSE) { retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsPrecSetupB", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint precondB routine */ return(idalsB_mem->psetB(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, rrB, c_jB, IDAB_mem->ida_user_data)); } /* idaLsPrecSetupBS interfaces to the IDALsPrecSetupFnBS routine provided by the user */ static int idaLsPrecSetupBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsPrecSetupBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if(IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); else retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsPrecSetupBS", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint precondBS routine */ return(idalsB_mem->psetBS(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, rrB, c_jB, IDAB_mem->ida_user_data)); } /* idaLsPrecSolveB interfaces to the IDALsPrecSolveFnB routine provided by the user */ static int idaLsPrecSolveB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsPrecSolveB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp==SUNFALSE) { retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsPrecSolveB", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint psolveB routine */ return(idalsB_mem->psolveB(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, rrB, rvecB, zvecB, c_jB, deltaB, IDAB_mem->ida_user_data)); } /* idaLsPrecSolveBS interfaces to the IDALsPrecSolveFnBS routine provided by the user */ static int idaLsPrecSolveBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsPrecSolveBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if(IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); else retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsPrecSolveBS", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint psolveBS routine */ return(idalsB_mem->psolveBS(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, rrB, rvecB, zvecB, c_jB, deltaB, IDAB_mem->ida_user_data)); } /* idaLsJacTimesSetupB interfaces to the IDALsJacTimesSetupFnB routine provided by the user */ static int idaLsJacTimesSetupB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsJacTimesSetupB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp==SUNFALSE) { retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsJacTimesSetupB", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint jtsetupB routine */ return(idalsB_mem->jtsetupB(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, rrB, c_jB, IDAB_mem->ida_user_data)); } /* idaLsJacTimesSetupBS interfaces to the IDALsJacTimesSetupFnBS routine provided by the user */ static int idaLsJacTimesSetupBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsJacTimesSetupBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if(IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); else retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsJacTimesSetupBS", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint jtimesBS routine */ return(idalsB_mem->jtsetupBS(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, rrB, c_jB, IDAB_mem->ida_user_data)); } /* idaLsJacTimesVecB interfaces to the IDALsJacTimesVecFnB routine provided by the user */ static int idaLsJacTimesVecB(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsJacTimesVecB", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp==SUNFALSE) { retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsJacTimesVecB", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint jtimesB routine */ return(idalsB_mem->jtimesB(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, rrB, vB, JvB, c_jB, IDAB_mem->ida_user_data, tmp1B, tmp2B)); } /* idaLsJacTimesVecBS interfaces to the IDALsJacTimesVecFnBS routine provided by the user */ static int idaLsJacTimesVecBS(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *ida_mem, N_Vector tmp1B, N_Vector tmp2B) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDALsMemB idalsB_mem; IDABMem IDAB_mem; int retval; /* access relevant memory structures */ retval = idaLs_AccessLMemBCur(ida_mem, "idaLsJacTimesVecBS", &IDA_mem, &IDAADJ_mem, &IDAB_mem, &idalsB_mem); /* Get forward solution from interpolation. */ if(IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); else retval = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDAB_mem->IDA_mem, -1, "IDASLS", "idaLsJacTimesVecBS", MSG_LS_BAD_T); return(-1); } } /* Call user's adjoint jtimesBS routine */ return(idalsB_mem->jtimesBS(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, rrB, vB, JvB, c_jB, IDAB_mem->ida_user_data, tmp1B, tmp2B)); } /* idaLsFreeB frees memory associated with the IDASLS wrapper */ int idaLsFreeB(IDABMem IDAB_mem) { IDALsMemB idalsB_mem; /* Return immediately if IDAB_mem or IDAB_mem->ida_lmem are NULL */ if (IDAB_mem == NULL) return(IDALS_SUCCESS); if (IDAB_mem->ida_lmem == NULL) return(IDALS_SUCCESS); idalsB_mem = (IDALsMemB) IDAB_mem->ida_lmem; /* free IDALsMemB interface structure */ free(idalsB_mem); return(IDALS_SUCCESS); } /* idaLs_AccessLMemB unpacks the IDA_mem, IDAADJ_mem, IDAB_mem and idalsB_mem structures from the void* ida_mem pointer. If any are missing it returns IDALS_MEM_NULL, IDALS_NO_ADJ, IDAS_ILL_INPUT, or IDALS_LMEMB_NULL. */ int idaLs_AccessLMemB(void *ida_mem, int which, const char *fname, IDAMem *IDA_mem, IDAadjMem *IDAADJ_mem, IDABMem *IDAB_mem, IDALsMemB *idalsB_mem) { /* access IDAMem structure */ if (ida_mem==NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASLS", fname, MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } *IDA_mem = (IDAMem) ida_mem; /* access IDAadjMem structure */ if ((*IDA_mem)->ida_adjMallocDone == SUNFALSE) { IDAProcessError(*IDA_mem, IDALS_NO_ADJ, "IDASLS", fname, MSG_LS_NO_ADJ); return(IDALS_NO_ADJ); } *IDAADJ_mem = (*IDA_mem)->ida_adj_mem; /* Check the value of which */ if ( which >= (*IDAADJ_mem)->ia_nbckpbs ) { IDAProcessError(*IDA_mem, IDALS_ILL_INPUT, "IDASLS", fname, MSG_LS_BAD_WHICH); return(IDALS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to which */ *IDAB_mem = (*IDAADJ_mem)->IDAB_mem; while ((*IDAB_mem) != NULL) { if ( which == (*IDAB_mem)->ida_index ) break; *IDAB_mem = (*IDAB_mem)->ida_next; } /* access IDALsMemB structure */ if ((*IDAB_mem)->ida_lmem == NULL) { IDAProcessError(*IDA_mem, IDALS_LMEMB_NULL, "IDASLS", fname, MSG_LS_LMEMB_NULL); return(IDALS_LMEMB_NULL); } *idalsB_mem = (IDALsMemB) ((*IDAB_mem)->ida_lmem); return(IDALS_SUCCESS); } /* idaLs_AccessLMemBCur unpacks the ida_mem, ca_mem, idaB_mem and idalsB_mem structures from the void* idaode_mem pointer. If any are missing it returns IDALS_MEM_NULL, IDALS_NO_ADJ, or IDALS_LMEMB_NULL. */ int idaLs_AccessLMemBCur(void *ida_mem, const char *fname, IDAMem *IDA_mem, IDAadjMem *IDAADJ_mem, IDABMem *IDAB_mem, IDALsMemB *idalsB_mem) { /* access IDAMem structure */ if (ida_mem==NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASLS", fname, MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } *IDA_mem = (IDAMem) ida_mem; /* access IDAadjMem structure */ if ((*IDA_mem)->ida_adjMallocDone == SUNFALSE) { IDAProcessError(*IDA_mem, IDALS_NO_ADJ, "IDASLS", fname, MSG_LS_NO_ADJ); return(IDALS_NO_ADJ); } *IDAADJ_mem = (*IDA_mem)->ida_adj_mem; /* get current backward problem */ if ((*IDAADJ_mem)->ia_bckpbCrt == NULL) { IDAProcessError(*IDA_mem, IDALS_LMEMB_NULL, "IDASLS", fname, MSG_LS_LMEMB_NULL); return(IDALS_LMEMB_NULL); } *IDAB_mem = (*IDAADJ_mem)->ia_bckpbCrt; /* access IDALsMemB structure */ if ((*IDAB_mem)->ida_lmem == NULL) { IDAProcessError(*IDA_mem, IDALS_LMEMB_NULL, "IDASLS", fname, MSG_LS_LMEMB_NULL); return(IDALS_LMEMB_NULL); } *idalsB_mem = (IDALsMemB) ((*IDAB_mem)->ida_lmem); return(IDALS_SUCCESS); } /*--------------------------------------------------------------- EOF ---------------------------------------------------------------*/ StanHeaders/src/idas/idas_nls_sim.c0000644000176200001440000003306113766554457017023 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the IDA nonlinear solver interface. * ---------------------------------------------------------------------------*/ #include "idas_impl.h" #include "sundials/sundials_math.h" #include "sundials/sundials_nvector_senswrapper.h" /* constant macros */ #define PT0001 RCONST(0.0001) /* real 0.0001 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWENTY RCONST(20.0) /* real 20.0 */ /* nonlinear solver parameters */ #define MAXIT 4 /* default max number of nonlinear iterations */ #define RATEMAX RCONST(0.9) /* max convergence rate used in divergence check */ /* private functions passed to nonlinear solver */ static int idaNlsResidualSensSim(N_Vector ycor, N_Vector res, void* ida_mem); static int idaNlsLSetupSensSim(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* ida_mem); static int idaNlsLSolveSensSim(N_Vector ycor, N_Vector delta, void* ida_mem); static int idaNlsConvTestSensSim(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int IDASetNonlinearSolverSensSim(void *ida_mem, SUNNonlinearSolver NLS) { IDAMem IDA_mem; int retval, is; /* return immediately if IDA memory is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinearSolverSensSim", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* return immediately if NLS memory is NULL */ if (NLS == NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "NLS must be non-NULL"); return(IDA_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "NLS does not support required operations"); return(IDA_ILL_INPUT); } /* check for allowed nonlinear solver types */ if (SUNNonlinSolGetType(NLS) != SUNNONLINEARSOLVER_ROOTFIND) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "NLS type must be SUNNONLINEARSOLVER_ROOTFIND"); return(IDA_ILL_INPUT); } /* check that sensitivities were initialized */ if (!(IDA_mem->ida_sensi)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", MSG_NO_SENSI); return(IDA_ILL_INPUT); } /* check that the simultaneous corrector was selected */ if (IDA_mem->ida_ism != IDA_SIMULTANEOUS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "Sensitivity solution method is not IDA_SIMULTANEOUS"); return(IDA_ILL_INPUT); } /* free any existing nonlinear solver */ if ((IDA_mem->NLSsim != NULL) && (IDA_mem->ownNLSsim)) retval = SUNNonlinSolFree(IDA_mem->NLSsim); /* set SUNNonlinearSolver pointer */ IDA_mem->NLSsim = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, IDA will set the flag to SUNTRUE after this function returns. */ IDA_mem->ownNLSsim = SUNFALSE; /* set the nonlinear residual function */ retval = SUNNonlinSolSetSysFn(IDA_mem->NLSsim, idaNlsResidualSensSim); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "Setting nonlinear system function failed"); return(IDA_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(IDA_mem->NLSsim, idaNlsConvTestSensSim); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "Setting convergence test function failed"); return(IDA_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(IDA_mem->NLSsim, MAXIT); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensSim", "Setting maximum number of nonlinear iterations failed"); return(IDA_ILL_INPUT); } /* create vector wrappers if necessary */ if (IDA_mem->simMallocDone == SUNFALSE) { IDA_mem->ycor0Sim = N_VNewEmpty_SensWrapper(IDA_mem->ida_Ns+1); if (IDA_mem->ycor0Sim == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASetNonlinearSolverSensSim", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ycorSim = N_VNewEmpty_SensWrapper(IDA_mem->ida_Ns+1); if (IDA_mem->ycorSim == NULL) { N_VDestroy(IDA_mem->ycor0Sim); IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASetNonlinearSolverSensSim", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ewtSim = N_VNewEmpty_SensWrapper(IDA_mem->ida_Ns+1); if (IDA_mem->ewtSim == NULL) { N_VDestroy(IDA_mem->ycor0Sim); N_VDestroy(IDA_mem->ycorSim); IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASetNonlinearSolverSensSim", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->simMallocDone = SUNTRUE; } /* attach vectors to vector wrappers */ NV_VEC_SW(IDA_mem->ycor0Sim, 0) = IDA_mem->ida_delta; NV_VEC_SW(IDA_mem->ycorSim, 0) = IDA_mem->ida_ee; NV_VEC_SW(IDA_mem->ewtSim, 0) = IDA_mem->ida_ewt; for (is=0; is < IDA_mem->ida_Ns; is++) { NV_VEC_SW(IDA_mem->ycor0Sim, is+1) = IDA_mem->ida_deltaS[is]; NV_VEC_SW(IDA_mem->ycorSim, is+1) = IDA_mem->ida_eeS[is]; NV_VEC_SW(IDA_mem->ewtSim, is+1) = IDA_mem->ida_ewtS[is]; } return(IDA_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int idaNlsInitSensSim(IDAMem IDA_mem) { int retval; /* set the linear solver setup wrapper function */ if (IDA_mem->ida_lsetup) retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLSsim, idaNlsLSetupSensSim); else retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLSsim, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInitSnesSim", "Setting the linear solver setup function failed"); return(IDA_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (IDA_mem->ida_lsolve) retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLSsim, idaNlsLSolveSensSim); else retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLSsim, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInitSnesSim", "Setting linear solver solve function failed"); return(IDA_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(IDA_mem->NLSsim); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInitSnesSim", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } return(IDA_SUCCESS); } static int idaNlsLSetupSensSim(N_Vector ycorSim, N_Vector resSim, booleantype jbad, booleantype* jcur, void* ida_mem) { IDAMem IDA_mem; int retval; N_Vector res; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsLSetupSensSim", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* extract residual vector from the vector wrapper */ res = NV_VEC_SW(resSim,0); IDA_mem->ida_nsetups++; IDA_mem->ida_forceSetup = SUNFALSE; retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy, IDA_mem->ida_yp, res, IDA_mem->ida_tempv1, IDA_mem->ida_tempv2, IDA_mem->ida_tempv3); /* update Jacobian status */ *jcur = SUNTRUE; /* update convergence test constants */ IDA_mem->ida_cjold = IDA_mem->ida_cj; IDA_mem->ida_cjratio = ONE; IDA_mem->ida_ss = TWENTY; IDA_mem->ida_ssS = TWENTY; if (retval < 0) return(IDA_LSETUP_FAIL); if (retval > 0) return(IDA_LSETUP_RECVR); return(IDA_SUCCESS); } static int idaNlsLSolveSensSim(N_Vector ycorSim, N_Vector deltaSim, void* ida_mem) { IDAMem IDA_mem; int retval, is; N_Vector delta; N_Vector *deltaS; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsLSolveSensSim", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* extract state update vector from the vector wrapper */ delta = NV_VEC_SW(deltaSim,0); /* solve the state linear system */ retval = IDA_mem->ida_lsolve(IDA_mem, delta, IDA_mem->ida_ewt, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_savres); if (retval < 0) return(IDA_LSOLVE_FAIL); if (retval > 0) return(IDA_LSOLVE_RECVR); /* extract sensitivity deltas from the vector wrapper */ deltaS = NV_VECS_SW(deltaSim)+1; /* solve the sensitivity linear systems */ for(is=0; isida_Ns; is++) { retval = IDA_mem->ida_lsolve(IDA_mem, deltaS[is], IDA_mem->ida_ewtS[is], IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_savres); if (retval < 0) return(IDA_LSOLVE_FAIL); if (retval > 0) return(IDA_LSOLVE_RECVR); } return(IDA_SUCCESS); } static int idaNlsResidualSensSim(N_Vector ycorSim, N_Vector resSim, void* ida_mem) { IDAMem IDA_mem; int retval; N_Vector ycor, res; N_Vector *ycorS, *resS; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsResidualSensSim", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* extract state and residual vectors from the vector wrapper */ ycor = NV_VEC_SW(ycorSim,0); res = NV_VEC_SW(resSim,0); /* update yy and yp based on the current correction */ N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, ycor, IDA_mem->ida_yy); N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, ycor, IDA_mem->ida_yp); /* evaluate residual */ retval = IDA_mem->ida_res(IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, res, IDA_mem->ida_user_data); /* increment the number of residual evaluations */ IDA_mem->ida_nre++; /* save a copy of the residual vector in savres */ N_VScale(ONE, res, IDA_mem->ida_savres); if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) return(IDA_RES_RECVR); /* extract sensitivity and residual vectors from the vector wrapper */ ycorS = NV_VECS_SW(ycorSim)+1; resS = NV_VECS_SW(resSim)+1; /* update yS and ypS based on the current correction */ N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_yySpredict, ONE, ycorS, IDA_mem->ida_yyS); N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_ypSpredict, IDA_mem->ida_cj, ycorS, IDA_mem->ida_ypS); /* evaluate sens residual */ retval = IDA_mem->ida_resS(IDA_mem->ida_Ns, IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, res, IDA_mem->ida_yyS, IDA_mem->ida_ypS, resS, IDA_mem->ida_user_dataS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); /* increment the number of sens residual evaluations */ IDA_mem->ida_nrSe++; if (retval < 0) return(IDA_SRES_FAIL); if (retval > 0) return(IDA_SRES_RECVR); return(IDA_SUCCESS); } static int idaNlsConvTestSensSim(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem) { IDAMem IDA_mem; int m, retval; realtype delnrm; realtype rate; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsConvTestSensSim", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* compute the norm of the correction */ delnrm = N_VWrmsNorm(del, ewt); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != IDA_SUCCESS) return(IDA_MEM_NULL); /* test for convergence, first directly, then with rate estimate. */ if (m == 0){ IDA_mem->ida_oldnrm = delnrm; if (delnrm <= PT0001 * IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS); } else { rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m ); if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR); IDA_mem->ida_ss = rate/(ONE - rate); } if (IDA_mem->ida_ss*delnrm <= tol) return(SUN_NLS_SUCCESS); /* not yet converged */ return(SUN_NLS_CONTINUE); } StanHeaders/src/idas/idas_ic.c0000644000176200001440000013706413766554457015762 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmers: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the IC calculation for IDAS. * It is independent of the linear solver in use. * ----------------------------------------------------------------- */ #include #include #include "idas_impl.h" #include /* * ================================================================= * IDA Constants * ================================================================= */ /* Private Constants */ #define ZERO RCONST(0.0) /* real 0.0 */ #define HALF RCONST(0.5) /* real 0.5 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define PT99 RCONST(0.99) /* real 0.99 */ #define PT1 RCONST(0.1) /* real 0.1 */ #define PT001 RCONST(0.001) /* real 0.001 */ /* IDACalcIC control constants */ #define ICRATEMAX RCONST(0.9) /* max. Newton conv. rate */ #define ALPHALS RCONST(0.0001) /* alpha in linesearch conv. test */ /* Return values for lower level routines used by IDACalcIC */ #define IC_FAIL_RECOV 1 #define IC_CONSTR_FAILED 2 #define IC_LINESRCH_FAILED 3 #define IC_CONV_FAIL 4 #define IC_SLOW_CONVRG 5 /* * ================================================================= * Private Helper Functions Prototypes * ================================================================= */ extern int IDAInitialSetup(IDAMem IDA_mem); extern realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); extern realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS, booleantype mask); extern realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS, booleantype mask); extern int IDASensEwtSet(IDAMem IDA_mem, N_Vector *yScur, N_Vector *weightS); static int IDANlsIC(IDAMem IDA_mem); static int IDANewtonIC(IDAMem IDA_mem); static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm); static int IDANewyyp(IDAMem IDA_mem, realtype lambda); static int IDANewy(IDAMem IDA_mem); static int IDASensNewtonIC(IDAMem IDA_mem); static int IDASensLineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm); static int IDASensNewyyp(IDAMem IDA_mem, realtype lambda); static int IDASensfnorm(IDAMem IDA_mem, realtype *fnorm); static int IDASensNlsIC(IDAMem IDA_mem); static int IDAICFailFlag(IDAMem IDA_mem, int retval); /* * ================================================================= * EXPORTED FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * IDACalcIC * ----------------------------------------------------------------- * IDACalcIC computes consistent initial conditions, given the * user's initial guess for unknown components of yy0 and/or yp0. * * The return value is IDA_SUCCESS = 0 if no error occurred. * * The error return values (fully described in ida.h) are: * IDA_MEM_NULL ida_mem is NULL * IDA_NO_MALLOC ida_mem was not allocated * IDA_ILL_INPUT bad value for icopt, tout1, or id * IDA_LINIT_FAIL the linear solver linit routine failed * IDA_BAD_EWT zero value of some component of ewt * IDA_RES_FAIL res had a non-recoverable error * IDA_FIRST_RES_FAIL res failed recoverably on the first call * IDA_LSETUP_FAIL lsetup had a non-recoverable error * IDA_LSOLVE_FAIL lsolve had a non-recoverable error * IDA_NO_RECOVERY res, lsetup, or lsolve had a recoverable * error, but IDACalcIC could not recover * IDA_CONSTR_FAIL the inequality constraints could not be met * IDA_LINESEARCH_FAIL if the linesearch failed (either on steptol test * or on the maxbacks test) * IDA_CONV_FAIL the Newton iterations failed to converge * ----------------------------------------------------------------- */ int IDACalcIC(void *ida_mem, int icopt, realtype tout1) { int ewtsetOK; int ier, nwt, nh, mxnh, icret, retval=0; int is; realtype tdist, troundoff, minid, hic, ypnorm; IDAMem IDA_mem; booleantype sensi_stg, sensi_sim; /* Check if IDA memory exists */ if(ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDACalcIC", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Check if problem was malloc'ed */ if(IDA_mem->ida_MallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_MALLOC, "IDAS", "IDACalcIC", MSG_NO_MALLOC); return(IDA_NO_MALLOC); } /* Check inputs to IDA for correctness and consistency */ ier = IDAInitialSetup(IDA_mem); if(ier != IDA_SUCCESS) return(IDA_ILL_INPUT); IDA_mem->ida_SetupDone = SUNTRUE; /* Check legality of input arguments, and set IDA memory copies. */ if(icopt != IDA_YA_YDP_INIT && icopt != IDA_Y_INIT) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ICOPT); return(IDA_ILL_INPUT); } IDA_mem->ida_icopt = icopt; if(icopt == IDA_YA_YDP_INIT && (IDA_mem->ida_id == NULL)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_MISSING_ID); return(IDA_ILL_INPUT); } tdist = SUNRabs(tout1 - IDA_mem->ida_tn); troundoff = TWO * IDA_mem->ida_uround * (SUNRabs(IDA_mem->ida_tn) + SUNRabs(tout1)); if(tdist < troundoff) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_TOO_CLOSE); return(IDA_ILL_INPUT); } /* Are we computing sensitivities? */ sensi_stg = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_STAGGERED)); sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); /* Allocate space and initialize temporary vectors */ IDA_mem->ida_yy0 = N_VClone(IDA_mem->ida_ee); IDA_mem->ida_yp0 = N_VClone(IDA_mem->ida_ee); IDA_mem->ida_t0 = IDA_mem->ida_tn; N_VScale(ONE, IDA_mem->ida_phi[0], IDA_mem->ida_yy0); N_VScale(ONE, IDA_mem->ida_phi[1], IDA_mem->ida_yp0); if (IDA_mem->ida_sensi) { /* Allocate temporary space required for sensitivity IC: yyS0 and ypS0. */ IDA_mem->ida_yyS0 = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_ee); IDA_mem->ida_ypS0 = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_ee); /* Initialize sensitivity vector. */ for (is=0; isida_Ns; is++) { N_VScale(ONE, IDA_mem->ida_phiS[0][is], IDA_mem->ida_yyS0[is]); N_VScale(ONE, IDA_mem->ida_phiS[1][is], IDA_mem->ida_ypS0[is]); } /* Initialize work space vectors needed for sensitivities. */ IDA_mem->ida_savresS = IDA_mem->ida_phiS[2]; IDA_mem->ida_delnewS = IDA_mem->ida_phiS[3]; IDA_mem->ida_yyS0new = IDA_mem->ida_phiS[4]; IDA_mem->ida_ypS0new = IDA_mem->ida_eeS; } /* For use in the IDA_YA_YP_INIT case, set sysindex and tscale. */ IDA_mem->ida_sysindex = 1; IDA_mem->ida_tscale = tdist; if(icopt == IDA_YA_YDP_INIT) { minid = N_VMin(IDA_mem->ida_id); if(minid < ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDACalcIC", MSG_IC_BAD_ID); return(IDA_ILL_INPUT); } if(minid > HALF) IDA_mem->ida_sysindex = 0; } /* Set the test constant in the Newton convergence test */ IDA_mem->ida_epsNewt = IDA_mem->ida_epiccon; /* Initializations: cjratio = 1 (for use in direct linear solvers); set nbacktr = 0; */ IDA_mem->ida_cjratio = ONE; IDA_mem->ida_nbacktr = 0; /* Set hic, hh, cj, and mxnh. */ hic = PT001*tdist; ypnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_yp0, IDA_mem->ida_ewt, IDA_mem->ida_suppressalg); if (sensi_sim) ypnorm = IDASensWrmsNormUpdate(IDA_mem, ypnorm, IDA_mem->ida_ypS0, IDA_mem->ida_ewtS, SUNFALSE); if(ypnorm > HALF/hic) hic = HALF/ypnorm; if(tout1 < IDA_mem->ida_tn) hic = -hic; IDA_mem->ida_hh = hic; if(icopt == IDA_YA_YDP_INIT) { IDA_mem->ida_cj = ONE/hic; mxnh = IDA_mem->ida_maxnh; } else { IDA_mem->ida_cj = ZERO; mxnh = 1; } /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { /* Call the IC nonlinear solver function. */ retval = IDANlsIC(IDA_mem); /* Cut h and loop on recoverable IDA_YA_YDP_INIT failure; else break. */ if(retval == IDA_SUCCESS) break; IDA_mem->ida_ncfn++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yy0 and yp0 if not converging. */ if(retval != IC_SLOW_CONVRG) { N_VScale(ONE, IDA_mem->ida_phi[0], IDA_mem->ida_yy0); N_VScale(ONE, IDA_mem->ida_phi[1], IDA_mem->ida_yp0); if (sensi_sim) { /* Reset yyS0 and ypS0. */ /* Copy phiS[0] and phiS[1] into yyS0 and ypS0. */ for (is=0; isida_Ns; is++) { N_VScale(ONE, IDA_mem->ida_phiS[0][is], IDA_mem->ida_yyS0[is]); N_VScale(ONE, IDA_mem->ida_phiS[1][is], IDA_mem->ida_ypS0[is]); } } } hic *= PT1; IDA_mem->ida_cj = ONE/hic; IDA_mem->ida_hh = hic; } /* End of nh loop */ /* Break on failure */ if(retval != IDA_SUCCESS) break; /* Reset ewt, save yy0, yp0 in phi, and loop. */ ewtsetOK = IDA_mem->ida_efun(IDA_mem->ida_yy0, IDA_mem->ida_ewt, IDA_mem->ida_edata); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } N_VScale(ONE, IDA_mem->ida_yy0, IDA_mem->ida_phi[0]); N_VScale(ONE, IDA_mem->ida_yp0, IDA_mem->ida_phi[1]); if (sensi_sim) { /* Reevaluate ewtS. */ ewtsetOK = IDASensEwtSet(IDA_mem, IDA_mem->ida_yyS0, IDA_mem->ida_ewtS); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } /* Save yyS0 and ypS0. */ for (is=0; isida_Ns; is++) { N_VScale(ONE, IDA_mem->ida_yyS0[is], IDA_mem->ida_phiS[0][is]); N_VScale(ONE, IDA_mem->ida_ypS0[is], IDA_mem->ida_phiS[1][is]); } } } /* End of nwt loop */ /* Load the optional outputs. */ if(icopt == IDA_YA_YDP_INIT) IDA_mem->ida_hused = hic; /* On any failure, free memory, print error message and return */ if(retval != IDA_SUCCESS) { N_VDestroy(IDA_mem->ida_yy0); N_VDestroy(IDA_mem->ida_yp0); if(IDA_mem->ida_sensi) { N_VDestroyVectorArray(IDA_mem->ida_yyS0, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS0, IDA_mem->ida_Ns); } icret = IDAICFailFlag(IDA_mem, retval); return(icret); } /* Unless using the STAGGERED approach for sensitivities, return now */ if (!sensi_stg) { N_VDestroy(IDA_mem->ida_yy0); N_VDestroy(IDA_mem->ida_yp0); if(IDA_mem->ida_sensi) { N_VDestroyVectorArray(IDA_mem->ida_yyS0, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS0, IDA_mem->ida_Ns); } return(IDA_SUCCESS); } /* Find consistent I.C. for sensitivities using a staggered approach */ /* Evaluate res at converged y, needed for future evaluations of sens. RHS If res() fails recoverably, treat it as a convergence failure and attempt the step again */ retval = IDA_mem->ida_res(IDA_mem->ida_t0, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, IDA_mem->ida_user_data); IDA_mem->ida_nre++; if(retval < 0) /* res function failed unrecoverably. */ return(IDA_RES_FAIL); if(retval > 0) /* res function failed recoverably but no recovery possible. */ return(IDA_FIRST_RES_FAIL); /* Loop over nwt = number of evaluations of ewt vector. */ for(nwt = 1; nwt <= 2; nwt++) { /* Loop over nh = number of h values. */ for(nh = 1; nh <= mxnh; nh++) { retval = IDASensNlsIC(IDA_mem); if(retval == IDA_SUCCESS) break; /* Increment the number of the sensitivity related corrector convergence failures. */ IDA_mem->ida_ncfnS++; if(retval < 0) break; if(nh == mxnh) break; /* If looping to try again, reset yyS0 and ypS0 if not converging. */ if(retval != IC_SLOW_CONVRG) { for (is=0; isida_Ns; is++) { N_VScale(ONE, IDA_mem->ida_phiS[0][is], IDA_mem->ida_yyS0[is]); N_VScale(ONE, IDA_mem->ida_phiS[1][is], IDA_mem->ida_ypS0[is]); } } hic *= PT1; IDA_mem->ida_cj = ONE/hic; IDA_mem->ida_hh = hic; } /* End of nh loop */ /* Break on failure */ if(retval != IDA_SUCCESS) break; /* Since it was successful, reevaluate ewtS with the new values of yyS0, save yyS0 and ypS0 in phiS[0] and phiS[1] and loop one more time to check and maybe correct the new sensitivities IC with respect to the new weights. */ /* Reevaluate ewtS. */ ewtsetOK = IDASensEwtSet(IDA_mem, IDA_mem->ida_yyS0, IDA_mem->ida_ewtS); if(ewtsetOK != 0) { retval = IDA_BAD_EWT; break; } /* Save yyS0 and ypS0. */ for (is=0; isida_Ns; is++) { N_VScale(ONE, IDA_mem->ida_yyS0[is], IDA_mem->ida_phiS[0][is]); N_VScale(ONE, IDA_mem->ida_ypS0[is], IDA_mem->ida_phiS[1][is]); } } /* End of nwt loop */ /* Load the optional outputs. */ if(icopt == IDA_YA_YDP_INIT) IDA_mem->ida_hused = hic; /* Free temporary space */ N_VDestroy(IDA_mem->ida_yy0); N_VDestroy(IDA_mem->ida_yp0); /* Here sensi is SUNTRUE, so deallocate sensitivity temporary vectors. */ N_VDestroyVectorArray(IDA_mem->ida_yyS0, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDA_mem->ida_ypS0, IDA_mem->ida_Ns); /* On any failure, print message and return proper flag. */ if(retval != IDA_SUCCESS) { icret = IDAICFailFlag(IDA_mem, retval); return(icret); } /* Otherwise return success flag. */ return(IDA_SUCCESS); } /* * ================================================================= * PRIVATE FUNCTIONS IMPLEMENTATION * ================================================================= */ /* * ----------------------------------------------------------------- * IDANlsIC * ----------------------------------------------------------------- * IDANlsIC solves a nonlinear system for consistent initial * conditions. It calls IDANewtonIC to do most of the work. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (either on steptol test * or on maxbacks test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations are converging slowly * (failed the convergence test, but showed * norm reduction or convergence rate < 1) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_FIRST_RES_FAIL if res failed recoverably on the first call * IDA_LSETUP_FAIL if lsetup had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDANlsIC(IDAMem IDA_mem) { int retval, nj, is; N_Vector tv1, tv2, tv3; booleantype sensi_sim; /* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); tv1 = IDA_mem->ida_ee; tv2 = IDA_mem->ida_tempv2; tv3 = IDA_mem->ida_phi[2]; /* Evaluate RHS. */ retval = IDA_mem->ida_res(IDA_mem->ida_t0, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, IDA_mem->ida_user_data); IDA_mem->ida_nre++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); /* Save the residual. */ N_VScale(ONE, IDA_mem->ida_delta, IDA_mem->ida_savres); if(sensi_sim) { /*Evaluate sensitivity RHS and save it in savresS. */ retval = IDA_mem->ida_resS(IDA_mem->ida_Ns, IDA_mem->ida_t0, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, IDA_mem->ida_yyS0, IDA_mem->ida_ypS0, IDA_mem->ida_deltaS, IDA_mem->ida_user_dataS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); IDA_mem->ida_nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_deltaS[is], IDA_mem->ida_savresS[is]); } /* Loop over nj = number of linear solve Jacobian setups. */ for(nj = 1; nj <= IDA_mem->ida_maxnj; nj++) { /* If there is a setup routine, call it. */ if(IDA_mem->ida_lsetup) { IDA_mem->ida_nsetups++; retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, tv1, tv2, tv3); if(retval < 0) return(IDA_LSETUP_FAIL); if(retval > 0) return(IC_FAIL_RECOV); } /* Call the Newton iteration routine, and return if successful. */ retval = IDANewtonIC(IDA_mem); if(retval == IDA_SUCCESS) return(IDA_SUCCESS); /* If converging slowly and lsetup is nontrivial, retry. */ if(retval == IC_SLOW_CONVRG && IDA_mem->ida_lsetup) { N_VScale(ONE, IDA_mem->ida_savres, IDA_mem->ida_delta); if(sensi_sim) for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_savresS[is], IDA_mem->ida_deltaS[is]); continue; } else { return(retval); } } /* End of nj loop */ /* No convergence after maxnj tries; return with retval=IC_SLOW_CONVRG */ return(retval); } /* * ----------------------------------------------------------------- * IDANewtonIC * ----------------------------------------------------------------- * IDANewtonIC performs the Newton iteration to solve for consistent * initial conditions. It calls IDALineSrch within each iteration. * On return, savres contains the current residual vector. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (either on steptol test * or on maxbacks test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations appear to be converging slowly. * They failed the convergence test, but showed * an overall norm reduction (by a factor of < 0.1) * or a convergence rate <= ICRATEMAX). * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDANewtonIC(IDAMem IDA_mem) { int retval, mnewt, is; realtype delnorm, fnorm, fnorm0, oldfnrm, rate; booleantype sensi_sim; /* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); /* Set pointer for vector delnew */ IDA_mem->ida_delnew = IDA_mem->ida_phi[2]; /* Call the linear solve function to get the Newton step, delta. */ retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_delta, IDA_mem->ida_ewt, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Compute the norm of the step. */ fnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delta, IDA_mem->ida_ewt, SUNFALSE); /* Call the lsolve function to get correction vectors deltaS. */ if (sensi_sim) { for(is=0;isida_Ns;is++) { retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_deltaS[is], IDA_mem->ida_ewtS[is], IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); } /* Update the norm of delta. */ fnorm = IDASensWrmsNormUpdate(IDA_mem, fnorm, IDA_mem->ida_deltaS, IDA_mem->ida_ewtS, SUNFALSE); } /* Test for convergence. Return now if the norm is small. */ if(IDA_mem->ida_sysindex == 0) fnorm *= IDA_mem->ida_tscale * SUNRabs(IDA_mem->ida_cj); if(fnorm <= IDA_mem->ida_epsNewt) return(IDA_SUCCESS); fnorm0 = fnorm; /* Initialize rate to avoid compiler warning message */ rate = ZERO; /* Newton iteration loop */ for(mnewt = 0; mnewt < IDA_mem->ida_maxnit; mnewt++) { IDA_mem->ida_nni++; delnorm = fnorm; oldfnrm = fnorm; /* Call the Linesearch function and return if it failed. */ retval = IDALineSrch(IDA_mem, &delnorm, &fnorm); if(retval != IDA_SUCCESS) return(retval); /* Set the observed convergence rate and test for convergence. */ rate = fnorm/oldfnrm; if(fnorm <= IDA_mem->ida_epsNewt) return(IDA_SUCCESS); /* If not converged, copy new step vector, and loop. */ N_VScale(ONE, IDA_mem->ida_delnew, IDA_mem->ida_delta); if(sensi_sim) { /* Update the iteration's step for sensitivities. */ for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_delnewS[is], IDA_mem->ida_deltaS[is]); } } /* End of Newton iteration loop */ /* Return either IC_SLOW_CONVRG or recoverable fail flag. */ if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG); return(IC_CONV_FAIL); } /* * ----------------------------------------------------------------- * IDALineSrch * ----------------------------------------------------------------- * IDALineSrch performs the Linesearch algorithm with the * calculation of consistent initial conditions. * * On entry, yy0 and yp0 are the current values of y and y', the * Newton step is delta, the current residual vector F is savres, * delnorm is WRMS-norm(delta), and fnorm is the norm of the vector * J-inverse F. * * On a successful return, yy0, yp0, and savres have been updated, * delnew contains the current value of J-inverse F, and fnorm is * WRMS-norm(delnew). * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (either on steptol test * or on maxbacks test) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDALineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm) { booleantype conOK; int retval, is, nbacks; realtype f1norm, fnormp, f1normp, ratio, lambda, minlam, slpi; N_Vector mc; booleantype sensi_sim; /* Initialize work space pointers, f1norm, ratio. (Use of mc in constraint check does not conflict with ypnew.) */ mc = IDA_mem->ida_ee; IDA_mem->ida_dtemp = IDA_mem->ida_phi[3]; IDA_mem->ida_ynew = IDA_mem->ida_tempv2; IDA_mem->ida_ypnew = IDA_mem->ida_ee; f1norm = (*fnorm)*(*fnorm)*HALF; ratio = ONE; /* If there are constraints, check and reduce step if necessary. */ if(IDA_mem->ida_constraintsSet) { /* Update y and check constraints. */ IDANewy(IDA_mem); conOK = N_VConstrMask(IDA_mem->ida_constraints, IDA_mem->ida_ynew, mc); if(!conOK) { /* Not satisfied. Compute scaled step to satisfy constraints. */ N_VProd(mc, IDA_mem->ida_delta, IDA_mem->ida_dtemp); ratio = PT99*N_VMinQuotient(IDA_mem->ida_yy0, IDA_mem->ida_dtemp); (*delnorm) *= ratio; if((*delnorm) <= IDA_mem->ida_steptol) return(IC_CONSTR_FAILED); N_VScale(ratio, IDA_mem->ida_delta, IDA_mem->ida_delta); } } /* End of constraints check */ slpi = -TWO*f1norm*ratio; minlam = IDA_mem->ida_steptol / (*delnorm); lambda = ONE; nbacks = 0; /* Are we computing sensitivities with the IDA_SIMULTANEOUS approach? */ sensi_sim = (IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)); /* In IDA_Y_INIT case, set ypnew = yp0 (fixed) for linesearch. */ if(IDA_mem->ida_icopt == IDA_Y_INIT) { N_VScale(ONE, IDA_mem->ida_yp0, IDA_mem->ida_ypnew); /* do the same for sensitivities. */ if(sensi_sim) { for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_ypS0[is], IDA_mem->ida_ypS0new[is]); } } /* Loop on linesearch variable lambda. */ for(;;) { if (nbacks == IDA_mem->ida_maxbacks) return(IC_LINESRCH_FAILED); /* Get new (y,y') = (ynew,ypnew) and norm of new function value. */ IDANewyyp(IDA_mem, lambda); retval = IDAfnorm(IDA_mem, &fnormp); if(retval != IDA_SUCCESS) return(retval); /* If lsoff option is on, break out. */ if(IDA_mem->ida_lsoff) break; /* Do alpha-condition test. */ f1normp = fnormp*fnormp*HALF; if(f1normp <= f1norm + ALPHALS*slpi*lambda) break; if(lambda < minlam) return(IC_LINESRCH_FAILED); lambda /= TWO; IDA_mem->ida_nbacktr++; nbacks++; } /* End of breakout linesearch loop */ /* Update yy0, yp0. */ N_VScale(ONE, IDA_mem->ida_ynew, IDA_mem->ida_yy0); if(sensi_sim) { /* Update yyS0 and ypS0. */ for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_yyS0new[is], IDA_mem->ida_yyS0[is]); } if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) { N_VScale(ONE, IDA_mem->ida_ypnew, IDA_mem->ida_yp0); if(sensi_sim) for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_ypS0new[is], IDA_mem->ida_ypS0[is]); } /* Update fnorm, then return. */ *fnorm = fnormp; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDAfnorm * ----------------------------------------------------------------- * IDAfnorm computes the norm of the current function value, by * evaluating the DAE residual function, calling the linear * system solver, and computing a WRMS-norm. * * On return, savres contains the current residual vector F, and * delnew contains J-inverse F. * * The return value is IDA_SUCCESS = 0 if no error occurred, or * IC_FAIL_RECOV if res or lsolve failed recoverably, or * IDA_RES_FAIL if res had a non-recoverable error, or * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error. * ----------------------------------------------------------------- */ static int IDAfnorm(IDAMem IDA_mem, realtype *fnorm) { int retval, is; /* Get residual vector F, return if failed, and save F in savres. */ retval = IDA_mem->ida_res(IDA_mem->ida_t0, IDA_mem->ida_ynew, IDA_mem->ida_ypnew, IDA_mem->ida_delnew, IDA_mem->ida_user_data); IDA_mem->ida_nre++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IC_FAIL_RECOV); N_VScale(ONE, IDA_mem->ida_delnew, IDA_mem->ida_savres); /* Call the linear solve function to get J-inverse F; return if failed. */ retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_delnew, IDA_mem->ida_ewt, IDA_mem->ida_ynew, IDA_mem->ida_ypnew, IDA_mem->ida_savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Compute the WRMS-norm. */ *fnorm = IDAWrmsNorm(IDA_mem, IDA_mem->ida_delnew, IDA_mem->ida_ewt, SUNFALSE); /* Are we computing SENSITIVITIES with the IDA_SIMULTANEOUS approach? */ if(IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)) { /* Evaluate the residual for sensitivities. */ retval = IDA_mem->ida_resS(IDA_mem->ida_Ns, IDA_mem->ida_t0, IDA_mem->ida_ynew, IDA_mem->ida_ypnew, IDA_mem->ida_savres, IDA_mem->ida_yyS0new, IDA_mem->ida_ypS0new, IDA_mem->ida_delnewS, IDA_mem->ida_user_dataS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); IDA_mem->ida_nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IC_FAIL_RECOV); /* Save delnewS in savresS. */ for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_delnewS[is], IDA_mem->ida_savresS[is]); /* Call the linear solve function to get J-inverse deltaS. */ for(is=0; isida_Ns; is++) { retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_delnewS[is], IDA_mem->ida_ewtS[is], IDA_mem->ida_ynew, IDA_mem->ida_ypnew, IDA_mem->ida_savres); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); } /* Include sensitivities in norm. */ *fnorm = IDASensWrmsNormUpdate(IDA_mem, *fnorm, IDA_mem->ida_delnewS, IDA_mem->ida_ewtS, SUNFALSE); } /* Rescale norm if index = 0. */ if(IDA_mem->ida_sysindex == 0) (*fnorm) *= IDA_mem->ida_tscale * SUNRabs(IDA_mem->ida_cj); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDANewyyp * ----------------------------------------------------------------- * IDANewyyp updates the vectors ynew and ypnew from yy0 and yp0, * using the current step vector lambda*delta, in a manner * depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDANewyyp(IDAMem IDA_mem, realtype lambda) { int retval; retval = IDA_SUCCESS; /* IDA_YA_YDP_INIT case: ynew = yy0 - lambda*delta where id_i = 0 ypnew = yp0 - cj*lambda*delta where id_i = 1. */ if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) { N_VProd(IDA_mem->ida_id, IDA_mem->ida_delta, IDA_mem->ida_dtemp); N_VLinearSum(ONE, IDA_mem->ida_yp0, -IDA_mem->ida_cj*lambda, IDA_mem->ida_dtemp, IDA_mem->ida_ypnew); N_VLinearSum(ONE, IDA_mem->ida_delta, -ONE, IDA_mem->ida_dtemp, IDA_mem->ida_dtemp); N_VLinearSum(ONE, IDA_mem->ida_yy0, -lambda, IDA_mem->ida_dtemp, IDA_mem->ida_ynew); }else if(IDA_mem->ida_icopt == IDA_Y_INIT) { /* IDA_Y_INIT case: ynew = yy0 - lambda*delta. (ypnew = yp0 preset.) */ N_VLinearSum(ONE, IDA_mem->ida_yy0, -lambda, IDA_mem->ida_delta, IDA_mem->ida_ynew); } if(IDA_mem->ida_sensi && (IDA_mem->ida_ism==IDA_SIMULTANEOUS)) retval = IDASensNewyyp(IDA_mem, lambda); return(retval); } /* * ----------------------------------------------------------------- * IDANewy * ----------------------------------------------------------------- * IDANewy updates the vector ynew from yy0, * using the current step vector delta, in a manner * depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDANewy(IDAMem IDA_mem) { /* IDA_YA_YDP_INIT case: ynew = yy0 - delta where id_i = 0. */ if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) { N_VProd(IDA_mem->ida_id, IDA_mem->ida_delta, IDA_mem->ida_dtemp); N_VLinearSum(ONE, IDA_mem->ida_delta, -ONE, IDA_mem->ida_dtemp, IDA_mem->ida_dtemp); N_VLinearSum(ONE, IDA_mem->ida_yy0, -ONE, IDA_mem->ida_dtemp, IDA_mem->ida_ynew); return(IDA_SUCCESS); } /* IDA_Y_INIT case: ynew = yy0 - delta. */ N_VLinearSum(ONE, IDA_mem->ida_yy0, -ONE, IDA_mem->ida_delta, IDA_mem->ida_ynew); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Sensitivity I.C. functions * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * IDASensNlsIC * ----------------------------------------------------------------- * IDASensNlsIC solves nonlinear systems for sensitivities consistent * initial conditions. It mainly relies on IDASensNewtonIC. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res, lsetup, or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (either on steptol test * or on maxbacks test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations are converging slowly * (failed the convergence test, but showed * norm reduction or convergence rate < 1) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_FIRST_RES_FAIL if res failed recoverably on the first call * IDA_LSETUP_FAIL if lsetup had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDASensNlsIC(IDAMem IDA_mem) { int retval; int is, nj; retval = IDA_mem->ida_resS(IDA_mem->ida_Ns, IDA_mem->ida_t0, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, IDA_mem->ida_yyS0, IDA_mem->ida_ypS0, IDA_mem->ida_deltaS, IDA_mem->ida_user_dataS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); IDA_mem->ida_nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IDA_FIRST_RES_FAIL); /* Save deltaS */ for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_deltaS[is], IDA_mem->ida_savresS[is]); /* Loop over nj = number of linear solve Jacobian setups. */ for(nj = 1; nj <= 2; nj++) { /* Call the Newton iteration routine */ retval = IDASensNewtonIC(IDA_mem); if(retval == IDA_SUCCESS) return(IDA_SUCCESS); /* If converging slowly and lsetup is nontrivial and this is the first pass, update Jacobian and retry. */ if(retval == IC_SLOW_CONVRG && IDA_mem->ida_lsetup && nj==1) { /* Restore deltaS. */ for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_savresS[is], IDA_mem->ida_deltaS[is]); IDA_mem->ida_nsetupsS++; retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); if(retval < 0) return(IDA_LSETUP_FAIL); if(retval > 0) return(IC_FAIL_RECOV); continue; } else { return(retval); } } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDASensNewtonIC * ----------------------------------------------------------------- * IDANewtonIC performs the Newton iteration to solve for * sensitivities consistent initial conditions. It calls * IDASensLineSrch within each iteration. * On return, savresS contains the current residual vectors. * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (either on steptol test * or on maxbacks test) * IC_CONV_FAIL if the Newton iterations failed to converge * IC_SLOW_CONVRG if the iterations appear to be converging slowly. * They failed the convergence test, but showed * an overall norm reduction (by a factor of < 0.1) * or a convergence rate <= ICRATEMAX). * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDASensNewtonIC(IDAMem IDA_mem) { int retval, is, mnewt; realtype delnorm, fnorm, fnorm0, oldfnrm, rate; for(is=0;isida_Ns;is++) { /* Call the linear solve function to get the Newton step, delta. */ retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_deltaS[is], IDA_mem->ida_ewtS[is], IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); } /* Compute the norm of the step and return if it is small enough */ fnorm = IDASensWrmsNorm(IDA_mem, IDA_mem->ida_deltaS, IDA_mem->ida_ewtS, SUNFALSE); if(IDA_mem->ida_sysindex == 0) fnorm *= IDA_mem->ida_tscale * SUNRabs(IDA_mem->ida_cj); if(fnorm <= IDA_mem->ida_epsNewt) return(IDA_SUCCESS); fnorm0 = fnorm; rate = ZERO; /* Newton iteration loop */ for(mnewt = 0; mnewt < IDA_mem->ida_maxnit; mnewt++) { IDA_mem->ida_nniS++; delnorm = fnorm; oldfnrm = fnorm; /* Call the Linesearch function and return if it failed. */ retval = IDASensLineSrch(IDA_mem, &delnorm, &fnorm); if(retval != IDA_SUCCESS) return(retval); /* Set the observed convergence rate and test for convergence. */ rate = fnorm/oldfnrm; if(fnorm <= IDA_mem->ida_epsNewt) return(IDA_SUCCESS); /* If not converged, copy new step vectors, and loop. */ for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_delnewS[is], IDA_mem->ida_deltaS[is]); } /* End of Newton iteration loop */ /* Return either IC_SLOW_CONVRG or recoverable fail flag. */ if(rate <= ICRATEMAX || fnorm < PT1*fnorm0) return(IC_SLOW_CONVRG); return(IC_CONV_FAIL); } /* * ----------------------------------------------------------------- * IDASensLineSrch * ----------------------------------------------------------------- * IDASensLineSrch performs the Linesearch algorithm with the * calculation of consistent initial conditions for sensitivities * systems. * * On entry, yyS0 and ypS0 contain the current values, the Newton * steps are contained in deltaS, the current residual vectors FS are * savresS, delnorm is sens-WRMS-norm(deltaS), and fnorm is * max { WRMS-norm( J-inverse FS[is] ) : is=1,2,...,Ns } * * On a successful return, yy0, yp0, and savres have been updated, * delnew contains the current values of J-inverse FS, and fnorm is * max { WRMS-norm(delnewS[is]) : is = 1,2,...Ns } * * The return value is IDA_SUCCESS = 0 if no error occurred. * The error return values (positive) considered recoverable are: * IC_FAIL_RECOV if res or lsolve failed recoverably * IC_CONSTR_FAILED if the constraints could not be met * IC_LINESRCH_FAILED if the linesearch failed (either on steptol test * or on maxbacks test) * The error return values (negative) considered non-recoverable are: * IDA_RES_FAIL if res had a non-recoverable error * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error * ----------------------------------------------------------------- */ static int IDASensLineSrch(IDAMem IDA_mem, realtype *delnorm, realtype *fnorm) { int is, retval, nbacks; realtype f1norm, fnormp, f1normp, slpi, minlam; realtype lambda, ratio; /* Set work space pointer. */ IDA_mem->ida_dtemp = IDA_mem->ida_phi[3]; f1norm = (*fnorm)*(*fnorm)*HALF; /* Initialize local variables. */ ratio = ONE; slpi = -TWO*f1norm*ratio; minlam = IDA_mem->ida_steptol / (*delnorm); lambda = ONE; nbacks = 0; for(;;) { if (nbacks == IDA_mem->ida_maxbacks) return(IC_LINESRCH_FAILED); /* Get new iteration in (ySnew, ypSnew). */ IDASensNewyyp(IDA_mem, lambda); /* Get the norm of new function value. */ retval = IDASensfnorm(IDA_mem, &fnormp); if (retval!=IDA_SUCCESS) return retval; /* If lsoff option is on, break out. */ if(IDA_mem->ida_lsoff) break; /* Do alpha-condition test. */ f1normp = fnormp*fnormp*HALF; if(f1normp <= f1norm + ALPHALS*slpi*lambda) break; if(lambda < minlam) return(IC_LINESRCH_FAILED); lambda /= TWO; IDA_mem->ida_nbacktr++; nbacks++; } /* Update yyS0, ypS0 and fnorm and return. */ for(is=0; isida_Ns; is++) { N_VScale(ONE, IDA_mem->ida_yyS0new[is], IDA_mem->ida_yyS0[is]); } if (IDA_mem->ida_icopt == IDA_YA_YDP_INIT) for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_ypS0new[is], IDA_mem->ida_ypS0[is]); *fnorm = fnormp; return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDASensfnorm * ----------------------------------------------------------------- * IDASensfnorm computes the norm of the current function value, by * evaluating the sensitivity residual function, calling the linear * system solver, and computing a WRMS-norm. * * On return, savresS contains the current residual vectors FS, and * delnewS contains J-inverse FS. * * The return value is IDA_SUCCESS = 0 if no error occurred, or * IC_FAIL_RECOV if res or lsolve failed recoverably, or * IDA_RES_FAIL if res had a non-recoverable error, or * IDA_LSOLVE_FAIL if lsolve had a non-recoverable error. * ----------------------------------------------------------------- */ static int IDASensfnorm(IDAMem IDA_mem, realtype *fnorm) { int is, retval; /* Get sensitivity residual */ retval = IDA_mem->ida_resS(IDA_mem->ida_Ns, IDA_mem->ida_t0, IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta, IDA_mem->ida_yyS0new, IDA_mem->ida_ypS0new, IDA_mem->ida_delnewS, IDA_mem->ida_user_dataS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); IDA_mem->ida_nrSe++; if(retval < 0) return(IDA_RES_FAIL); if(retval > 0) return(IC_FAIL_RECOV); for(is=0; isida_Ns; is++) N_VScale(ONE, IDA_mem->ida_delnewS[is], IDA_mem->ida_savresS[is]); /* Call linear solve function */ for(is=0; isida_Ns; is++) { retval = IDA_mem->ida_lsolve(IDA_mem, IDA_mem->ida_delnewS[is], IDA_mem->ida_ewtS[is], IDA_mem->ida_yy0, IDA_mem->ida_yp0, IDA_mem->ida_delta); if(retval < 0) return(IDA_LSOLVE_FAIL); if(retval > 0) return(IC_FAIL_RECOV); } /* Compute the WRMS-norm; rescale if index = 0. */ *fnorm = IDASensWrmsNorm(IDA_mem, IDA_mem->ida_delnewS, IDA_mem->ida_ewtS, SUNFALSE); if(IDA_mem->ida_sysindex == 0) (*fnorm) *= IDA_mem->ida_tscale * SUNRabs(IDA_mem->ida_cj); return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDASensNewyyp * ----------------------------------------------------------------- * IDASensNewyyp computes the Newton updates for each of the * sensitivities systems using the current step vector lambda*delta, * in a manner depending on icopt and the input id vector. * * The return value is always IDA_SUCCESS = 0. * ----------------------------------------------------------------- */ static int IDASensNewyyp(IDAMem IDA_mem, realtype lambda) { int is; if(IDA_mem->ida_icopt == IDA_YA_YDP_INIT) { /* IDA_YA_YDP_INIT case: - ySnew = yS0 - lambda*deltaS where id_i = 0 - ypSnew = ypS0 - cj*lambda*delta where id_i = 1. */ for(is=0; isida_Ns; is++) { /* It is ok to use dtemp as temporary vector here. */ N_VProd(IDA_mem->ida_id, IDA_mem->ida_deltaS[is], IDA_mem->ida_dtemp); N_VLinearSum(ONE, IDA_mem->ida_ypS0[is], -IDA_mem->ida_cj*lambda, IDA_mem->ida_dtemp, IDA_mem->ida_ypS0new[is]); N_VLinearSum(ONE, IDA_mem->ida_deltaS[is], -ONE, IDA_mem->ida_dtemp, IDA_mem->ida_dtemp); N_VLinearSum(ONE, IDA_mem->ida_yyS0[is], -lambda, IDA_mem->ida_dtemp, IDA_mem->ida_yyS0new[is]); } /* end loop is */ }else { /* IDA_Y_INIT case: - ySnew = yS0 - lambda*deltaS. (ypnew = yp0 preset.) */ for(is=0; isida_Ns; is++) N_VLinearSum(ONE, IDA_mem->ida_yyS0[is], -lambda, IDA_mem->ida_deltaS[is], IDA_mem->ida_yyS0new[is]); } /* end loop is */ return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * IDAICFailFlag * ----------------------------------------------------------------- * IDAICFailFlag prints a message and sets the IDACalcIC return * value appropriate to the flag retval returned by IDANlsIC. * ----------------------------------------------------------------- */ static int IDAICFailFlag(IDAMem IDA_mem, int retval) { /* Depending on retval, print error message and return error flag. */ switch(retval) { case IDA_RES_FAIL: IDAProcessError(IDA_mem, IDA_RES_FAIL, "IDAS", "IDACalcIC", MSG_IC_RES_NONREC); return(IDA_RES_FAIL); case IDA_FIRST_RES_FAIL: IDAProcessError(IDA_mem, IDA_FIRST_RES_FAIL, "IDAS", "IDACalcIC", MSG_IC_RES_FAIL); return(IDA_FIRST_RES_FAIL); case IDA_LSETUP_FAIL: IDAProcessError(IDA_mem, IDA_LSETUP_FAIL, "IDAS", "IDACalcIC", MSG_IC_SETUP_FAIL); return(IDA_LSETUP_FAIL); case IDA_LSOLVE_FAIL: IDAProcessError(IDA_mem, IDA_LSOLVE_FAIL, "IDAS", "IDACalcIC", MSG_IC_SOLVE_FAIL); return(IDA_LSOLVE_FAIL); case IC_FAIL_RECOV: IDAProcessError(IDA_mem, IDA_NO_RECOVERY, "IDAS", "IDACalcIC", MSG_IC_NO_RECOVERY); return(IDA_NO_RECOVERY); case IC_CONSTR_FAILED: IDAProcessError(IDA_mem, IDA_CONSTR_FAIL, "IDAS", "IDACalcIC", MSG_IC_FAIL_CONSTR); return(IDA_CONSTR_FAIL); case IC_LINESRCH_FAILED: IDAProcessError(IDA_mem, IDA_LINESEARCH_FAIL, "IDAS", "IDACalcIC", MSG_IC_FAILED_LINS); return(IDA_LINESEARCH_FAIL); case IC_CONV_FAIL: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDAS", "IDACalcIC", MSG_IC_CONV_FAILED); return(IDA_CONV_FAIL); case IC_SLOW_CONVRG: IDAProcessError(IDA_mem, IDA_CONV_FAIL, "IDAS", "IDACalcIC", MSG_IC_CONV_FAILED); return(IDA_CONV_FAIL); case IDA_BAD_EWT: IDAProcessError(IDA_mem, IDA_BAD_EWT, "IDAS", "IDACalcIC", MSG_IC_BAD_EWT); return(IDA_BAD_EWT); } return -99; } StanHeaders/src/idas/idas_ls_impl.h0000644000176200001440000002364713766554457017034 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Alan C. Hindmarsh and Radu Serban @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation header file for IDAS's linear solver interface. *-----------------------------------------------------------------*/ #ifndef _IDASLS_IMPL_H #define _IDASLS_IMPL_H #include #include "idas_impl.h" #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------------------------------------------------------- Types : struct IDALsMemRec, struct *IDALsMem The type IDALsMem is a pointer to a IDALsMemRec, which is a structure containing fields that must be accessible by LS module routines. -----------------------------------------------------------------*/ typedef struct IDALsMemRec { /* Jacobian construction & storage */ booleantype jacDQ; /* SUNTRUE if using internal DQ Jacobian approx. */ IDALsJacFn jac; /* Jacobian routine to be called */ void *J_data; /* J_data is passed to jac */ /* Linear solver, matrix and vector objects/pointers */ SUNLinearSolver LS; /* generic linear solver object */ SUNMatrix J; /* J = dF/dy + cj*dF/dy' */ N_Vector ytemp; /* temp vector used by IDAAtimesDQ */ N_Vector yptemp; /* temp vector used by IDAAtimesDQ */ N_Vector x; /* temp vector used by the solve function */ N_Vector ycur; /* current y vector in Newton iteration */ N_Vector ypcur; /* current yp vector in Newton iteration */ N_Vector rcur; /* rcur = F(tn, ycur, ypcur) */ /* Iterative solver tolerance */ realtype sqrtN; /* sqrt(N) */ realtype eplifac; /* eplifac = linear convergence factor */ /* Statistics and associated parameters */ realtype dqincfac; /* dqincfac = optional increment factor in Jv */ long int nje; /* nje = no. of calls to jac */ long int npe; /* npe = total number of precond calls */ long int nli; /* nli = total number of linear iterations */ long int nps; /* nps = total number of psolve calls */ long int ncfl; /* ncfl = total number of convergence failures */ long int nreDQ; /* nreDQ = total number of calls to res */ long int njtsetup; /* njtsetup = total number of calls to jtsetup */ long int njtimes; /* njtimes = total number of calls to jtimes */ long int nst0; /* nst0 = saved nst (for performance monitor) */ long int nni0; /* nni0 = saved nni (for performance monitor) */ long int ncfn0; /* ncfn0 = saved ncfn (for performance monitor) */ long int ncfl0; /* ncfl0 = saved ncfl (for performance monitor) */ long int nwarn; /* nwarn = no. of warnings (for perf. monitor) */ long int last_flag; /* last error return flag */ /* Preconditioner computation (a) user-provided: - pdata == user_data - pfree == NULL (the user dealocates memory) (b) internal preconditioner module - pdata == ida_mem - pfree == set by the prec. module and called in idaLsFree */ IDALsPrecSetupFn pset; IDALsPrecSolveFn psolve; int (*pfree)(IDAMem IDA_mem); void *pdata; /* Jacobian times vector compuation (a) jtimes function provided by the user: - jt_data == user_data - jtimesDQ == SUNFALSE (b) internal jtimes - jt_data == ida_mem - jtimesDQ == SUNTRUE */ booleantype jtimesDQ; IDALsJacTimesSetupFn jtsetup; IDALsJacTimesVecFn jtimes; void *jt_data; } *IDALsMem; /*----------------------------------------------------------------- Prototypes of internal functions -----------------------------------------------------------------*/ /* Interface routines called by system SUNLinearSolver */ int idaLsATimes(void *ida_mem, N_Vector v, N_Vector z); int idaLsPSetup(void *ida_mem); int idaLsPSolve(void *ida_mem, N_Vector r, N_Vector z, realtype tol, int lr); /* Difference quotient approximation for Jac times vector */ int idaLsDQJtimes(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *data, N_Vector work1, N_Vector work2); /* Difference-quotient Jacobian approximation routines */ int idaLsDQJac(realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, SUNMatrix Jac, void *data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); int idaLsDenseDQJac(realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, SUNMatrix Jac, IDAMem IDA_mem, N_Vector tmp1); int idaLsBandDQJac(realtype tt, realtype c_j, N_Vector yy, N_Vector yp, N_Vector rr, SUNMatrix Jac, IDAMem IDA_mem, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); /* Generic linit/lsetup/lsolve/lperf/lfree interface routines for IDA to call */ int idaLsInitialize(IDAMem IDA_mem); int idaLsSetup(IDAMem IDA_mem, N_Vector y, N_Vector yp, N_Vector r, N_Vector vt1, N_Vector vt2, N_Vector vt3); int idaLsSolve(IDAMem IDA_mem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rescur); int idaLsPerf(IDAMem IDA_mem, int perftask); int idaLsFree(IDAMem IDA_mem); /* Auxilliary functions */ int idaLsInitializeCounters(IDALsMem idals_mem); int idaLs_AccessLMem(void* ida_mem, const char* fname, IDAMem* IDA_mem, IDALsMem* idals_mem); /*--------------------------------------------------------------- Error and Warning Messages ---------------------------------------------------------------*/ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_LS_TIME "at t = %Lg, " #define MSG_LS_FRMT "%Le." #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_LS_TIME "at t = %lg, " #define MSG_LS_FRMT "%le." #else #define MSG_LS_TIME "at t = %g, " #define MSG_LS_FRMT "%e." #endif /* Error Messages */ #define MSG_LS_IDAMEM_NULL "Integrator memory is NULL." #define MSG_LS_MEM_FAIL "A memory request failed." #define MSG_LS_BAD_NVECTOR "A required vector operation is not implemented." #define MSG_LS_BAD_SIZES "Illegal bandwidth parameter(s). Must have 0 <= ml, mu <= N-1." #define MSG_LS_BAD_LSTYPE "Incompatible linear solver type." #define MSG_LS_LMEM_NULL "Linear solver memory is NULL." #define MSG_LS_BAD_GSTYPE "gstype has an illegal value." #define MSG_LS_NEG_MAXRS "maxrs < 0 illegal." #define MSG_LS_NEG_EPLIFAC "eplifac < 0.0 illegal." #define MSG_LS_NEG_DQINCFAC "dqincfac < 0.0 illegal." #define MSG_LS_PSET_FAILED "The preconditioner setup routine failed in an unrecoverable manner." #define MSG_LS_PSOLVE_FAILED "The preconditioner solve routine failed in an unrecoverable manner." #define MSG_LS_JTSETUP_FAILED "The Jacobian x vector setup routine failed in an unrecoverable manner." #define MSG_LS_JTIMES_FAILED "The Jacobian x vector routine failed in an unrecoverable manner." #define MSG_LS_JACFUNC_FAILED "The Jacobian routine failed in an unrecoverable manner." #define MSG_LS_MATZERO_FAILED "The SUNMatZero routine failed in an unrecoverable manner." /* Warning Messages */ #define MSG_LS_WARN "Warning: " MSG_LS_TIME "poor iterative algorithm performance. " #define MSG_LS_CFN_WARN MSG_LS_WARN "Nonlinear convergence failure rate is " MSG_LS_FRMT #define MSG_LS_CFL_WARN MSG_LS_WARN "Linear convergence failure rate is " MSG_LS_FRMT /*----------------------------------------------------------------- PART II - backward problems -----------------------------------------------------------------*/ /*----------------------------------------------------------------- Types : IDALsMemRecB, IDALsMemB IDASetLinearSolverB attaches such a structure to the lmemB field of IDAadjMem -----------------------------------------------------------------*/ typedef struct IDALsMemRecB { IDALsJacFnB jacB; IDALsJacFnBS jacBS; IDALsJacTimesSetupFnB jtsetupB; IDALsJacTimesSetupFnBS jtsetupBS; IDALsJacTimesVecFnB jtimesB; IDALsJacTimesVecFnBS jtimesBS; IDALsPrecSetupFnB psetB; IDALsPrecSetupFnBS psetBS; IDALsPrecSolveFnB psolveB; IDALsPrecSolveFnBS psolveBS; void *P_dataB; } *IDALsMemB; /*----------------------------------------------------------------- Prototypes of internal functions -----------------------------------------------------------------*/ int idaLsFreeB(IDABMem IDAB_mem); int idaLs_AccessLMemB(void *ida_mem, int which, const char *fname, IDAMem *IDA_mem, IDAadjMem *IDAADJ_mem, IDABMem *IDAB_mem, IDALsMemB *idalsB_mem); int idaLs_AccessLMemBCur(void *ida_mem, const char *fname, IDAMem *IDA_mem, IDAadjMem *IDAADJ_mem, IDABMem *IDAB_mem, IDALsMemB *idalsB_mem); /*----------------------------------------------------------------- Error Messages -----------------------------------------------------------------*/ #define MSG_LS_CAMEM_NULL "idaadj_mem = NULL illegal." #define MSG_LS_LMEMB_NULL "Linear solver memory is NULL for the backward integration." #define MSG_LS_BAD_T "Bad t for interpolation." #define MSG_LS_BAD_WHICH "Illegal value for which." #define MSG_LS_NO_ADJ "Illegal attempt to call before calling IDAAdjInit." #ifdef __cplusplus } #endif #endif StanHeaders/src/idas/idas_bbdpre_impl.h0000644000176200001440000000643713766554457017652 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Alan C. Hindmarsh and Radu Serban @ LLNL *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * This is the header file (private version) for the IDABBDPRE * module, for a band-block-diagonal preconditioner, i.e. a * block-diagonal matrix with banded blocks, for use with IDA * and an IDASPILS linear solver. *-----------------------------------------------------------------*/ #ifndef _IDASBBDPRE_IMPL_H #define _IDASBBDPRE_IMPL_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * Definition of IBBDPrecData * ----------------------------------------------------------------- */ typedef struct IBBDPrecDataRec { /* passed by user to IDABBDPrecAlloc and used by IDABBDPrecSetup/IDABBDPrecSolve functions */ sunindextype mudq, mldq, mukeep, mlkeep; realtype rel_yy; IDABBDLocalFn glocal; IDABBDCommFn gcomm; /* set by IDABBDPrecSetup and used by IDABBDPrecSetup and IDABBDPrecSolve functions */ sunindextype n_local; SUNMatrix PP; SUNLinearSolver LS; N_Vector zlocal; N_Vector rlocal; N_Vector tempv1; N_Vector tempv2; N_Vector tempv3; N_Vector tempv4; /* available for optional output */ long int rpwsize; long int ipwsize; long int nge; /* pointer to ida_mem */ void *ida_mem; } *IBBDPrecData; /* * ----------------------------------------------------------------- * Type: IDABBDPrecDataB * ----------------------------------------------------------------- */ typedef struct IDABBDPrecDataRecB { /* BBD user functions (glocB and cfnB) for backward run */ IDABBDLocalFnB glocalB; IDABBDCommFnB gcommB; } *IDABBDPrecDataB; /* * ----------------------------------------------------------------- * IDABBDPRE error messages * ----------------------------------------------------------------- */ #define MSGBBD_MEM_NULL "Integrator memory is NULL." #define MSGBBD_LMEM_NULL "Linear solver memory is NULL. One of the SPILS linear solvers must be attached." #define MSGBBD_MEM_FAIL "A memory request failed." #define MSGBBD_BAD_NVECTOR "A required vector operation is not implemented." #define MSGBBD_SUNMAT_FAIL "An error arose from a SUNBandMatrix routine." #define MSGBBD_SUNLS_FAIL "An error arose from a SUNBandLinearSolver routine." #define MSGBBD_PMEM_NULL "BBD peconditioner memory is NULL. IDABBDPrecInit must be called." #define MSGBBD_FUNC_FAILED "The Glocal or Gcomm routine failed in an unrecoverable manner." #define MSGBBD_AMEM_NULL "idaadj_mem = NULL illegal." #define MSGBBD_PDATAB_NULL "IDABBDPRE memory is NULL for the backward integration." #define MSGBBD_BAD_T "Bad t for interpolation." #ifdef __cplusplus } #endif #endif StanHeaders/src/idas/idas_direct.c0000644000176200001440000000452313766554457016632 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation file for the deprecated direct linear solver interface in * IDA; these routines now just wrap the updated IDA generic * linear solver interface in idas_ls.h. *-----------------------------------------------------------------*/ #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Exported Functions (wrappers for equivalent routines in idas_ls.h) =================================================================*/ int IDADlsSetLinearSolver(void *ida_mem, SUNLinearSolver LS, SUNMatrix A) { return(IDASetLinearSolver(ida_mem, LS, A)); } int IDADlsSetJacFn(void *ida_mem, IDADlsJacFn jac) { return(IDASetJacFn(ida_mem, jac)); } int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { return(IDAGetLinWorkSpace(ida_mem, lenrwLS, leniwLS)); } int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals) { return(IDAGetNumJacEvals(ida_mem, njevals)); } int IDADlsGetNumResEvals(void *ida_mem, long int *nrevalsLS) { return(IDAGetNumLinResEvals(ida_mem, nrevalsLS)); } int IDADlsGetLastFlag(void *ida_mem, long int *flag) { return(IDAGetLastLinFlag(ida_mem, flag)); } char *IDADlsGetReturnFlagName(long int flag) { return(IDAGetLinReturnFlagName(flag)); } int IDADlsSetLinearSolverB(void *ida_mem, int which, SUNLinearSolver LS, SUNMatrix A) { return(IDASetLinearSolverB(ida_mem, which, LS, A)); } int IDADlsSetJacFnB(void *ida_mem, int which, IDADlsJacFnB jacB) { return(IDASetJacFnB(ida_mem, which, jacB)); } int IDADlsSetJacFnBS(void *ida_mem, int which, IDADlsJacFnBS jacBS) { return(IDASetJacFnBS(ida_mem, which, jacBS)); } #ifdef __cplusplus } #endif StanHeaders/src/idas/idas_nls.c0000644000176200001440000002224613766554457016156 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the IDA nonlinear solver interface. * ---------------------------------------------------------------------------*/ #include "idas_impl.h" #include "sundials/sundials_math.h" /* constant macros */ #define PT0001 RCONST(0.0001) /* real 0.0001 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWENTY RCONST(20.0) /* real 20.0 */ /* nonlinear solver parameters */ #define MAXIT 4 /* default max number of nonlinear iterations */ #define RATEMAX RCONST(0.9) /* max convergence rate used in divergence check */ /* private functions passed to nonlinear solver */ static int idaNlsResidual(N_Vector ycor, N_Vector res, void* ida_mem); static int idaNlsLSetup(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* ida_mem); static int idaNlsLSolve(N_Vector ycor, N_Vector delta, void* ida_mem); static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int IDASetNonlinearSolver(void *ida_mem, SUNNonlinearSolver NLS) { IDAMem IDA_mem; int retval; /* return immediately if IDA memory is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinearSolver", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* return immediately if NLS memory is NULL */ if (NLS == NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolver", "NLS must be non-NULL"); return(IDA_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolver", "NLS does not support required operations"); return(IDA_ILL_INPUT); } /* check for allowed nonlinear solver types */ if (SUNNonlinSolGetType(NLS) != SUNNONLINEARSOLVER_ROOTFIND) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolver", "NLS type must be SUNNONLINEARSOLVER_ROOTFIND"); return(IDA_ILL_INPUT); } /* free any existing nonlinear solver */ if ((IDA_mem->NLS != NULL) && (IDA_mem->ownNLS)) retval = SUNNonlinSolFree(IDA_mem->NLS); /* set SUNNonlinearSolver pointer */ IDA_mem->NLS = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, IDA will set the flag to SUNTRUE after this function returns. */ IDA_mem->ownNLS = SUNFALSE; /* set the nonlinear residual function */ retval = SUNNonlinSolSetSysFn(IDA_mem->NLS, idaNlsResidual); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolver", "Setting nonlinear system function failed"); return(IDA_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(IDA_mem->NLS, idaNlsConvTest); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolver", "Setting convergence test function failed"); return(IDA_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(IDA_mem->NLS, MAXIT); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolver", "Setting maximum number of nonlinear iterations failed"); return(IDA_ILL_INPUT); } return(IDA_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int idaNlsInit(IDAMem IDA_mem) { int retval; /* set the linear solver setup wrapper function */ if (IDA_mem->ida_lsetup) retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLS, idaNlsLSetup); else retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLS, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInit", "Setting the linear solver setup function failed"); return(IDA_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (IDA_mem->ida_lsolve) retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLS, idaNlsLSolve); else retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLS, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInit", "Setting linear solver solve function failed"); return(IDA_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(IDA_mem->NLS); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInit", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } return(IDA_SUCCESS); } static int idaNlsLSetup(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* ida_mem) { IDAMem IDA_mem; int retval; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsLSetup", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_nsetups++; IDA_mem->ida_forceSetup = SUNFALSE; retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy, IDA_mem->ida_yp, res, IDA_mem->ida_tempv1, IDA_mem->ida_tempv2, IDA_mem->ida_tempv3); /* update Jacobian status */ *jcur = SUNTRUE; /* update convergence test constants */ IDA_mem->ida_cjold = IDA_mem->ida_cj; IDA_mem->ida_cjratio = ONE; IDA_mem->ida_ss = TWENTY; IDA_mem->ida_ssS = TWENTY; if (retval < 0) return(IDA_LSETUP_FAIL); if (retval > 0) return(IDA_LSETUP_RECVR); return(IDA_SUCCESS); } static int idaNlsLSolve(N_Vector ycor, N_Vector delta, void* ida_mem) { IDAMem IDA_mem; int retval; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsLSolve", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; retval = IDA_mem->ida_lsolve(IDA_mem, delta, IDA_mem->ida_ewt, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_savres); if (retval < 0) return(IDA_LSOLVE_FAIL); if (retval > 0) return(IDA_LSOLVE_RECVR); return(IDA_SUCCESS); } static int idaNlsResidual(N_Vector ycor, N_Vector res, void* ida_mem) { IDAMem IDA_mem; int retval; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsResidual", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* update yy and yp based on the current correction */ N_VLinearSum(ONE, IDA_mem->ida_yypredict, ONE, ycor, IDA_mem->ida_yy); N_VLinearSum(ONE, IDA_mem->ida_yppredict, IDA_mem->ida_cj, ycor, IDA_mem->ida_yp); /* evaluate residual */ retval = IDA_mem->ida_res(IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, res, IDA_mem->ida_user_data); /* increment the number of residual evaluations */ IDA_mem->ida_nre++; /* save a copy of the residual vector in savres */ N_VScale(ONE, res, IDA_mem->ida_savres); if (retval < 0) return(IDA_RES_FAIL); if (retval > 0) return(IDA_RES_RECVR); return(IDA_SUCCESS); } static int idaNlsConvTest(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem) { IDAMem IDA_mem; int m, retval; realtype delnrm; realtype rate; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsConvTest", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* compute the norm of the correction */ delnrm = N_VWrmsNorm(del, ewt); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != IDA_SUCCESS) return(IDA_MEM_NULL); /* test for convergence, first directly, then with rate estimate. */ if (m == 0){ IDA_mem->ida_oldnrm = delnrm; if (delnrm <= PT0001 * IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS); } else { rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m ); if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR); IDA_mem->ida_ss = rate/(ONE - rate); } if (IDA_mem->ida_ss*delnrm <= tol) return(SUN_NLS_SUCCESS); /* not yet converged */ return(SUN_NLS_CONTINUE); } StanHeaders/src/idas/NOTICE0000644000176200001440000000221613766554457015115 0ustar liggesusersThis work was produced under the auspices of the U.S. Department of Energy by Lawrence Livermore National Laboratory under Contract DE-AC52-07NA27344. This work was prepared as an account of work sponsored by an agency of the United States Government. Neither the United States Government nor Lawrence Livermore National Security, LLC, nor any of their employees makes any warranty, expressed or implied, or assumes any legal liability or responsibility for the accuracy, completeness, or usefulness of any information, apparatus, product, or process disclosed, or represents that its use would not infringe privately owned rights. Reference herein to any specific commercial product, process, or service by trade name, trademark, manufacturer, or otherwise does not necessarily constitute or imply its endorsement, recommendation, or favoring by the United States Government or Lawrence Livermore National Security, LLC. The views and opinions of authors expressed herein do not necessarily state or reflect those of the United States Government or Lawrence Livermore National Security, LLC, and shall not be used for advertising or product endorsement purposes.StanHeaders/src/idas/idaa.c0000644000176200001440000027436513766554457015273 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the IDAA adjoint integrator. * ----------------------------------------------------------------- */ /*=================================================================*/ /* Import Header Files */ /*=================================================================*/ #include #include #include "idas_impl.h" #include /*=================================================================*/ /* IDAA Private Constants */ /*=================================================================*/ #define ZERO RCONST(0.0) /* real 0.0 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWO RCONST(2.0) /* real 2.0 */ #define HUNDRED RCONST(100.0) /* real 100.0 */ #define FUZZ_FACTOR RCONST(1000000.0) /* fuzz factor for IDAAgetY */ /*=================================================================*/ /* Private Functions Prototypes */ /*=================================================================*/ static CkpntMem IDAAckpntInit(IDAMem IDA_mem); static CkpntMem IDAAckpntNew(IDAMem IDA_mem); static void IDAAckpntCopyVectors(IDAMem IDA_mem, CkpntMem ck_mem); static booleantype IDAAckpntAllocVectors(IDAMem IDA_mem, CkpntMem ck_mem); static void IDAAckpntDelete(CkpntMem *ck_memPtr); static void IDAAbckpbDelete(IDABMem *IDAB_memPtr); static booleantype IDAAdataMalloc(IDAMem IDA_mem); static void IDAAdataFree(IDAMem IDA_mem); static int IDAAdataStore(IDAMem IDA_mem, CkpntMem ck_mem); static int IDAAckpntGet(IDAMem IDA_mem, CkpntMem ck_mem); static booleantype IDAAhermiteMalloc(IDAMem IDA_mem); static void IDAAhermiteFree(IDAMem IDA_mem); static int IDAAhermiteStorePnt(IDAMem IDA_mem, DtpntMem d); static int IDAAhermiteGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS); static booleantype IDAApolynomialMalloc(IDAMem IDA_mem); static void IDAApolynomialFree(IDAMem IDA_mem); static int IDAApolynomialStorePnt(IDAMem IDA_mem, DtpntMem d); static int IDAApolynomialGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS); static int IDAAfindIndex(IDAMem ida_mem, realtype t, long int *indx, booleantype *newpoint); static int IDAAres(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector resvalB, void *ida_mem); static int IDAArhsQ(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrQB, void *ida_mem); static int IDAAGettnSolutionYp(IDAMem IDA_mem, N_Vector yp); static int IDAAGettnSolutionYpS(IDAMem IDA_mem, N_Vector *ypS); extern int IDAGetSolution(void *ida_mem, realtype t, N_Vector yret, N_Vector ypret); /*=================================================================*/ /* Exported Functions */ /*=================================================================*/ /* * IDAAdjInit * * This routine allocates space for the global IDAA memory * structure. */ int IDAAdjInit(void *ida_mem, long int steps, int interp) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; /* Check arguments */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAAdjInit", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem)ida_mem; if (steps <= 0) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAAdjInit", MSGAM_BAD_STEPS); return(IDA_ILL_INPUT); } if ( (interp != IDA_HERMITE) && (interp != IDA_POLYNOMIAL) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAAdjInit", MSGAM_BAD_INTERP); return(IDA_ILL_INPUT); } /* Allocate memory block for IDAadjMem. */ IDAADJ_mem = (IDAadjMem) malloc(sizeof(struct IDAadjMemRec)); if (IDAADJ_mem == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDAAdjInit", MSGAM_MEM_FAIL); return(IDA_MEM_FAIL); } /* Attach IDAS memory for forward runs */ IDA_mem->ida_adj_mem = IDAADJ_mem; /* Initialization of check points. */ IDAADJ_mem->ck_mem = NULL; IDAADJ_mem->ia_nckpnts = 0; IDAADJ_mem->ia_ckpntData = NULL; /* Initialization of interpolation data. */ IDAADJ_mem->ia_interpType = interp; IDAADJ_mem->ia_nsteps = steps; /* Last index used in IDAAfindIndex, initailize to invalid value */ IDAADJ_mem->ia_ilast = -1; /* Allocate space for the array of Data Point structures. */ if (IDAAdataMalloc(IDA_mem) == SUNFALSE) { free(IDAADJ_mem); IDAADJ_mem = NULL; IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDAAdjInit", MSGAM_MEM_FAIL); return(IDA_MEM_FAIL); } /* Attach functions for the appropriate interpolation module */ switch(interp) { case IDA_HERMITE: IDAADJ_mem->ia_malloc = IDAAhermiteMalloc; IDAADJ_mem->ia_free = IDAAhermiteFree; IDAADJ_mem->ia_getY = IDAAhermiteGetY; IDAADJ_mem->ia_storePnt = IDAAhermiteStorePnt; break; case IDA_POLYNOMIAL: IDAADJ_mem->ia_malloc = IDAApolynomialMalloc; IDAADJ_mem->ia_free = IDAApolynomialFree; IDAADJ_mem->ia_getY = IDAApolynomialGetY; IDAADJ_mem->ia_storePnt = IDAApolynomialStorePnt; break; } /* The interpolation module has not been initialized yet */ IDAADJ_mem->ia_mallocDone = SUNFALSE; /* By default we will store but not interpolate sensitivities * - storeSensi will be set in IDASolveF to SUNFALSE if FSA is not enabled * or if the user forced this through IDAAdjSetNoSensi * - interpSensi will be set in IDASolveB to SUNTRUE if storeSensi is SUNTRUE * and if at least one backward problem requires sensitivities * - noInterp will be set in IDACalcICB to SUNTRUE before the call to * IDACalcIC and SUNFALSE after.*/ IDAADJ_mem->ia_storeSensi = SUNTRUE; IDAADJ_mem->ia_interpSensi = SUNFALSE; IDAADJ_mem->ia_noInterp = SUNFALSE; /* Initialize backward problems. */ IDAADJ_mem->IDAB_mem = NULL; IDAADJ_mem->ia_bckpbCrt = NULL; IDAADJ_mem->ia_nbckpbs = 0; /* Flags for tracking the first calls to IDASolveF and IDASolveF. */ IDAADJ_mem->ia_firstIDAFcall = SUNTRUE; IDAADJ_mem->ia_tstopIDAFcall = SUNFALSE; IDAADJ_mem->ia_firstIDABcall = SUNTRUE; /* Adjoint module initialized and allocated. */ IDA_mem->ida_adj = SUNTRUE; IDA_mem->ida_adjMallocDone = SUNTRUE; return(IDA_SUCCESS); } /* * IDAAdjReInit * * IDAAdjReInit reinitializes the IDAS memory structure for ASA */ int IDAAdjReInit(void *ida_mem) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; /* Check arguments */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAAdjReInit", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem)ida_mem; /* Was ASA previously initialized? */ if(IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAAdjReInit", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Free all stored checkpoints. */ while (IDAADJ_mem->ck_mem != NULL) IDAAckpntDelete(&(IDAADJ_mem->ck_mem)); IDAADJ_mem->ck_mem = NULL; IDAADJ_mem->ia_nckpnts = 0; IDAADJ_mem->ia_ckpntData = NULL; /* Flags for tracking the first calls to IDASolveF and IDASolveF. */ IDAADJ_mem->ia_firstIDAFcall = SUNTRUE; IDAADJ_mem->ia_tstopIDAFcall = SUNFALSE; IDAADJ_mem->ia_firstIDABcall = SUNTRUE; return(IDA_SUCCESS); } /* * IDAAdjFree * * IDAAdjFree routine frees the memory allocated by IDAAdjInit. */ void IDAAdjFree(void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; if (ida_mem == NULL) return; IDA_mem = (IDAMem) ida_mem; if(IDA_mem->ida_adjMallocDone) { /* Data for adjoint. */ IDAADJ_mem = IDA_mem->ida_adj_mem; /* Delete check points one by one */ while (IDAADJ_mem->ck_mem != NULL) { IDAAckpntDelete(&(IDAADJ_mem->ck_mem)); } IDAAdataFree(IDA_mem); /* Free all backward problems. */ while (IDAADJ_mem->IDAB_mem != NULL) IDAAbckpbDelete( &(IDAADJ_mem->IDAB_mem) ); /* Free IDAA memory. */ free(IDAADJ_mem); IDA_mem->ida_adj_mem = NULL; } } /* * ================================================================= * PRIVATE FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ static void IDAAbckpbDelete(IDABMem *IDAB_memPtr) { IDABMem IDAB_mem = (*IDAB_memPtr); void * ida_mem; if (IDAB_mem == NULL) return; /* Move head to the next element in list. */ *IDAB_memPtr = IDAB_mem->ida_next; /* IDAB_mem is going to be deallocated. */ /* Free IDAS memory for this backward problem. */ ida_mem = (void *)IDAB_mem->IDA_mem; IDAFree(&ida_mem); /* Free linear solver memory. */ if (IDAB_mem->ida_lfree != NULL) IDAB_mem->ida_lfree(IDAB_mem); /* Free preconditioner memory. */ if (IDAB_mem->ida_pfree != NULL) IDAB_mem->ida_pfree(IDAB_mem); /* Free any workspace vectors. */ N_VDestroy(IDAB_mem->ida_yy); N_VDestroy(IDAB_mem->ida_yp); /* Free the node itself. */ free(IDAB_mem); IDAB_mem = NULL; } /*=================================================================*/ /* Wrappers for IDAA */ /*=================================================================*/ /* * IDASolveF * * This routine integrates to tout and returns solution into yout. * In the same time, it stores check point data every 'steps' steps. * * IDASolveF can be called repeatedly by the user. The last tout * will be used as the starting time for the backward integration. * * ncheckPtr points to the number of check points stored so far. */ int IDASolveF(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask, int *ncheckPtr) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; CkpntMem tmp; DtpntMem *dt_mem; int flag, i; booleantype /* iret, */ allocOK; /* Is the mem OK? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASolveF", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASolveF", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check for yret != NULL */ if (yret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_YRET_NULL); return(IDA_ILL_INPUT); } /* Check for ypret != NULL */ if (ypret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_YPRET_NULL); return(IDA_ILL_INPUT); } /* Check for tret != NULL */ if (tret == NULL) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_TRET_NULL); return(IDA_ILL_INPUT); } /* Check for valid itask */ if ( (itask != IDA_NORMAL) && (itask != IDA_ONE_STEP) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveF", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } /* All memory checks done, proceed ... */ dt_mem = IDAADJ_mem->dt_mem; /* If tstop is enabled, store some info */ if (IDA_mem->ida_tstopset) { IDAADJ_mem->ia_tstopIDAFcall = SUNTRUE; IDAADJ_mem->ia_tstopIDAF = IDA_mem->ida_tstop; } /* We will call IDASolve in IDA_ONE_STEP mode, regardless of what itask is, so flag if we need to return */ /* if (itask == IDA_ONE_STEP) iret = SUNTRUE; * else iret = SUNFALSE; */ /* On the first step: * - set tinitial * - initialize list of check points * - if needed, initialize the interpolation module * - load dt_mem[0] * On subsequent steps, test if taking a new step is necessary. */ if ( IDAADJ_mem->ia_firstIDAFcall ) { IDAADJ_mem->ia_tinitial = IDA_mem->ida_tn; IDAADJ_mem->ck_mem = IDAAckpntInit(IDA_mem); if (IDAADJ_mem->ck_mem == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDASolveF", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } if (!IDAADJ_mem->ia_mallocDone) { /* Do we need to store sensitivities? */ if (!IDA_mem->ida_sensi) IDAADJ_mem->ia_storeSensi = SUNFALSE; /* Allocate space for interpolation data */ allocOK = IDAADJ_mem->ia_malloc(IDA_mem); if (!allocOK) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDASolveF", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Rename phi and, if needed, phiS for use in interpolation */ for (i=0;iia_Y[i] = IDA_mem->ida_phi[i]; if (IDAADJ_mem->ia_storeSensi) { for (i=0;iia_YS[i] = IDA_mem->ida_phiS[i]; } IDAADJ_mem->ia_mallocDone = SUNTRUE; } dt_mem[0]->t = IDAADJ_mem->ck_mem->ck_t0; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[0]); IDAADJ_mem->ia_firstIDAFcall = SUNFALSE; } else if ( (IDA_mem->ida_tn-tout)*IDA_mem->ida_hh >= ZERO ) { /* If tout was passed, return interpolated solution. No changes to ck_mem or dt_mem are needed. */ *tret = tout; flag = IDAGetSolution(IDA_mem, tout, yret, ypret); *ncheckPtr = IDAADJ_mem->ia_nckpnts; IDAADJ_mem->ia_newData = SUNTRUE; IDAADJ_mem->ia_ckpntData = IDAADJ_mem->ck_mem; IDAADJ_mem->ia_np = IDA_mem->ida_nst % IDAADJ_mem->ia_nsteps + 1; return(flag); } /* Integrate to tout while loading check points */ for(;;) { /* Perform one step of the integration */ flag = IDASolve(IDA_mem, tout, tret, yret, ypret, IDA_ONE_STEP); if (flag < 0) break; /* Test if a new check point is needed */ if ( IDA_mem->ida_nst % IDAADJ_mem->ia_nsteps == 0 ) { IDAADJ_mem->ck_mem->ck_t1 = *tret; /* Create a new check point, load it, and append it to the list */ tmp = IDAAckpntNew(IDA_mem); if (tmp == NULL) { flag = IDA_MEM_FAIL; break; } tmp->ck_next = IDAADJ_mem->ck_mem; IDAADJ_mem->ck_mem = tmp; IDAADJ_mem->ia_nckpnts++; IDA_mem->ida_forceSetup = SUNTRUE; /* Reset i=0 and load dt_mem[0] */ dt_mem[0]->t = IDAADJ_mem->ck_mem->ck_t0; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[0]); } else { /* Load next point in dt_mem */ dt_mem[IDA_mem->ida_nst%IDAADJ_mem->ia_nsteps]->t = *tret; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[IDA_mem->ida_nst % IDAADJ_mem->ia_nsteps]); } /* Set t1 field of the current ckeck point structure for the case in which there will be no future check points */ IDAADJ_mem->ck_mem->ck_t1 = *tret; /* tfinal is now set to *t */ IDAADJ_mem->ia_tfinal = *tret; /* In IDA_ONE_STEP mode break from loop */ if (itask == IDA_ONE_STEP) break; /* Return if tout reached */ if ( (*tret - tout)*IDA_mem->ida_hh >= ZERO ) { *tret = tout; IDAGetSolution(IDA_mem, tout, yret, ypret); /* Reset tretlast in IDA_mem so that IDAGetQuad and IDAGetSens * evaluate quadratures and/or sensitivities at the proper time */ IDA_mem->ida_tretlast = tout; break; } } /* Get ncheck from IDAADJ_mem */ *ncheckPtr = IDAADJ_mem->ia_nckpnts; /* Data is available for the last interval */ IDAADJ_mem->ia_newData = SUNTRUE; IDAADJ_mem->ia_ckpntData = IDAADJ_mem->ck_mem; IDAADJ_mem->ia_np = IDA_mem->ida_nst % IDAADJ_mem->ia_nsteps + 1; return(flag); } /* * ================================================================= * FUNCTIONS FOR BACKWARD PROBLEMS * ================================================================= */ int IDACreateB(void *ida_mem, int *which) { IDAMem IDA_mem; void* ida_memB; IDABMem new_IDAB_mem; IDAadjMem IDAADJ_mem; /* Is the mem OK? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDACreateB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDACreateB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Allocate a new IDABMem struct. */ new_IDAB_mem = (IDABMem) malloc( sizeof( struct IDABMemRec ) ); if (new_IDAB_mem == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDACreateB", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Allocate the IDAMem struct needed by this backward problem. */ ida_memB = IDACreate(); if (ida_memB == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAA", "IDACreateB", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } /* Save ida_mem in ida_memB as user data. */ IDASetUserData(ida_memB, ida_mem); /* Set same error output and handler for ida_memB. */ IDASetErrHandlerFn(ida_memB, IDA_mem->ida_ehfun, IDA_mem->ida_eh_data); IDASetErrFile(ida_memB, IDA_mem->ida_errfp); /* Initialize fields in the IDABMem struct. */ new_IDAB_mem->ida_index = IDAADJ_mem->ia_nbckpbs; new_IDAB_mem->IDA_mem = (IDAMem) ida_memB; new_IDAB_mem->ida_res = NULL; new_IDAB_mem->ida_resS = NULL; new_IDAB_mem->ida_rhsQ = NULL; new_IDAB_mem->ida_rhsQS = NULL; new_IDAB_mem->ida_user_data = NULL; new_IDAB_mem->ida_lmem = NULL; new_IDAB_mem->ida_lfree = NULL; new_IDAB_mem->ida_pmem = NULL; new_IDAB_mem->ida_pfree = NULL; new_IDAB_mem->ida_yy = NULL; new_IDAB_mem->ida_yp = NULL; new_IDAB_mem->ida_res_withSensi = SUNFALSE; new_IDAB_mem->ida_rhsQ_withSensi = SUNFALSE; /* Attach the new object to the beginning of the linked list IDAADJ_mem->IDAB_mem. */ new_IDAB_mem->ida_next = IDAADJ_mem->IDAB_mem; IDAADJ_mem->IDAB_mem = new_IDAB_mem; /* Return the assigned index. This id is used as identificator and has to be passed to IDAInitB and other ***B functions that set the optional inputs for this backward problem. */ *which = IDAADJ_mem->ia_nbckpbs; /*Increase the counter of the backward problems stored. */ IDAADJ_mem->ia_nbckpbs++; return(IDA_SUCCESS); } int IDAInitB(void *ida_mem, int which, IDAResFnB resB, realtype tB0, N_Vector yyB0, N_Vector ypB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAInitB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the initial time for this backward problem against the adjoint data. */ if ( (tB0 < IDAADJ_mem->ia_tinitial) || (tB0 > IDAADJ_mem->ia_tfinal) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDAInitB", MSGAM_BAD_TB0); return(IDA_BAD_TB0); } /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Call the IDAInit for this backward problem. */ flag = IDAInit(ida_memB, IDAAres, tB0, yyB0, ypB0); if (IDA_SUCCESS != flag) return(flag); /* Copy residual function in IDAB_mem. */ IDAB_mem->ida_res = resB; IDAB_mem->ida_res_withSensi = SUNFALSE; /* Initialized the initial time field. */ IDAB_mem->ida_t0 = tB0; /* Allocate and initialize space workspace vectors. */ IDAB_mem->ida_yy = N_VClone(yyB0); IDAB_mem->ida_yp = N_VClone(yyB0); N_VScale(ONE, yyB0, IDAB_mem->ida_yy); N_VScale(ONE, ypB0, IDAB_mem->ida_yp); return(flag); } int IDAInitBS(void *ida_mem, int which, IDAResFnBS resS, realtype tB0, N_Vector yyB0, N_Vector ypB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAInitBS", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAInitBS", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the initial time for this backward problem against the adjoint data. */ if ( (tB0 < IDAADJ_mem->ia_tinitial) || (tB0 > IDAADJ_mem->ia_tfinal) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDAInitBS", MSGAM_BAD_TB0); return(IDA_BAD_TB0); } /* Were sensitivities active during the forward integration? */ if (!IDAADJ_mem->ia_storeSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAInitBS", MSGAM_BAD_SENSI); return(IDA_ILL_INPUT); } /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAInitBS", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Allocate and set the IDAS object */ flag = IDAInit(ida_memB, IDAAres, tB0, yyB0, ypB0); if (flag != IDA_SUCCESS) return(flag); /* Copy residual function pointer in IDAB_mem. */ IDAB_mem->ida_res_withSensi = SUNTRUE; IDAB_mem->ida_resS = resS; /* Allocate space and initialize the yy and yp vectors. */ IDAB_mem->ida_t0 = tB0; IDAB_mem->ida_yy = N_VClone(yyB0); IDAB_mem->ida_yp = N_VClone(ypB0); N_VScale(ONE, yyB0, IDAB_mem->ida_yy); N_VScale(ONE, ypB0, IDAB_mem->ida_yp); return(IDA_SUCCESS); } int IDAReInitB(void *ida_mem, int which, realtype tB0, N_Vector yyB0, N_Vector ypB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAReInitB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAReInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the initial time for this backward problem against the adjoint data. */ if ( (tB0 < IDAADJ_mem->ia_tinitial) || (tB0 > IDAADJ_mem->ia_tfinal) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDAReInitB", MSGAM_BAD_TB0); return(IDA_BAD_TB0); } /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAReInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Call the IDAReInit for this backward problem. */ flag = IDAReInit(ida_memB, tB0, yyB0, ypB0); return(flag); } int IDASStolerancesB(void *ida_mem, int which, realtype relTolB, realtype absTolB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASStolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASStolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASStolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Set tolerances and return. */ return IDASStolerances(ida_memB, relTolB, absTolB); } int IDASVtolerancesB(void *ida_mem, int which, realtype relTolB, N_Vector absTolB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASVtolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASVtolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASVtolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Set tolerances and return. */ return IDASVtolerances(ida_memB, relTolB, absTolB); } int IDAQuadSStolerancesB(void *ida_mem, int which, realtype reltolQB, realtype abstolQB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadSStolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadSStolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadSStolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDAQuadSStolerances(ida_memB, reltolQB, abstolQB); } int IDAQuadSVtolerancesB(void *ida_mem, int which, realtype reltolQB, N_Vector abstolQB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadSVtolerancesB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadSVtolerancesB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadSVtolerancesB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; return IDAQuadSVtolerances(ida_memB, reltolQB, abstolQB); } int IDAQuadInitB(void *ida_mem, int which, IDAQuadRhsFnB rhsQB, N_Vector yQB0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadInitB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; flag = IDAQuadInit(ida_memB, IDAArhsQ, yQB0); if (IDA_SUCCESS != flag) return flag; IDAB_mem->ida_rhsQ_withSensi = SUNFALSE; IDAB_mem->ida_rhsQ = rhsQB; return(flag); } int IDAQuadInitBS(void *ida_mem, int which, IDAQuadRhsFnBS rhsQS, N_Vector yQB0) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; IDABMem IDAB_mem; void * ida_memB; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadInitBS", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadInitBS", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadInitBS", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* Get the IDAMem corresponding to this backward problem. */ ida_memB = (void*) IDAB_mem->IDA_mem; /* Allocate and set the IDAS object */ flag = IDAQuadInit(ida_memB, IDAArhsQ, yQB0); if (flag != IDA_SUCCESS) return(flag); /* Copy RHS function pointer in IDAB_mem and enable quad sensitivities. */ IDAB_mem->ida_rhsQ_withSensi = SUNTRUE; IDAB_mem->ida_rhsQS = rhsQS; return(IDA_SUCCESS); } int IDAQuadReInitB(void *ida_mem, int which, N_Vector yQB0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAQuadInitB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAQuadInitB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAQuadInitB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } return IDAQuadReInit(ida_mem, yQB0); } /* * ---------------------------------------------------------------- * Function : IDACalcICB * ---------------------------------------------------------------- * IDACalcIC calculates corrected initial conditions for a DAE * backward system (index-one in semi-implicit form). * It uses Newton iteration combined with a Linesearch algorithm. * Calling IDACalcICB is optional. It is only necessary when the * initial conditions do not solve the given system. I.e., if * yB0 and ypB0 are known to satisfy the backward problem, then * a call to IDACalcIC is NOT necessary (for index-one problems). */ int IDACalcICB(void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDACalcICB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDACalcICB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; /* The wrapper for user supplied res function requires ia_bckpbCrt from IDAAdjMem to be set to curent problem. */ IDAADJ_mem->ia_bckpbCrt = IDAB_mem; /* Save (y, y') in yyTmp and ypTmp for use in the res wrapper.*/ /* yyTmp and ypTmp workspaces are safe to use if IDAADataStore is not called.*/ N_VScale(ONE, yy0, IDAADJ_mem->ia_yyTmp); N_VScale(ONE, yp0, IDAADJ_mem->ia_ypTmp); /* Set noInterp flag to SUNTRUE, so IDAARes will use user provided values for y and y' and will not call the interpolation routine(s). */ IDAADJ_mem->ia_noInterp = SUNTRUE; flag = IDACalcIC(ida_memB, IDA_YA_YDP_INIT, tout1); /* Set interpolation on in IDAARes. */ IDAADJ_mem->ia_noInterp = SUNFALSE; return(flag); } /* * ---------------------------------------------------------------- * Function : IDACalcICBS * ---------------------------------------------------------------- * IDACalcIC calculates corrected initial conditions for a DAE * backward system (index-one in semi-implicit form) that also * dependes on the sensivities. * * It calls IDACalcIC for the 'which' backward problem. */ int IDACalcICBS(void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0, N_Vector *yyS0, N_Vector *ypS0) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag, is, retval; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDACalcICBS", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDACalcICBS", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Were sensitivities active during the forward integration? */ if (!IDAADJ_mem->ia_storeSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICBS", MSGAM_BAD_SENSI); return(IDA_ILL_INPUT); } /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICBS", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; /* Was InitBS called for this problem? */ if (!IDAB_mem->ida_res_withSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDACalcICBS", MSGAM_NO_INITBS); return(IDA_ILL_INPUT); } /* The wrapper for user supplied res function requires ia_bckpbCrt from IDAAdjMem to be set to curent problem. */ IDAADJ_mem->ia_bckpbCrt = IDAB_mem; /* Save (y, y') and (y_p, y'_p) in yyTmp, ypTmp and yySTmp, ypSTmp.The wrapper for residual will use these values instead of calling interpolation routine.*/ /* The four workspaces variables are safe to use if IDAADataStore is not called.*/ N_VScale(ONE, yy0, IDAADJ_mem->ia_yyTmp); N_VScale(ONE, yp0, IDAADJ_mem->ia_ypTmp); for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, yyS0, IDAADJ_mem->ia_yySTmp); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, ypS0, IDAADJ_mem->ia_ypSTmp); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Set noInterp flag to SUNTRUE, so IDAARes will use user provided values for y and y' and will not call the interpolation routine(s). */ IDAADJ_mem->ia_noInterp = SUNTRUE; flag = IDACalcIC(ida_memB, IDA_YA_YDP_INIT, tout1); /* Set interpolation on in IDAARes. */ IDAADJ_mem->ia_noInterp = SUNFALSE; return(flag); } /* * IDASolveB * * This routine performs the backward integration from tB0 * to tinitial through a sequence of forward-backward runs in * between consecutive check points. It returns the values of * the adjoint variables and any existing quadrature variables * at tinitial. * * On a successful return, IDASolveB returns IDA_SUCCESS. * * NOTE that IDASolveB DOES NOT return the solution for the * backward problem(s). Use IDAGetB to extract the solution * for any given backward problem. * * If there are multiple backward problems and multiple check points, * IDASolveB may not succeed in getting all problems to take one step * when called in ONE_STEP mode. */ int IDASolveB(void *ida_mem, realtype tBout, int itaskB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; CkpntMem ck_mem; IDABMem IDAB_mem, tmp_IDAB_mem; int flag=0, sign; realtype tfuzz, tBret, tBn; booleantype gotCkpnt, reachedTBout, isActive; /* Is the mem OK? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDASolveB", MSGAM_NULL_IDAMEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized ? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDASolveB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; if ( IDAADJ_mem->ia_nbckpbs == 0 ) { IDAProcessError(IDA_mem, IDA_NO_BCK, "IDAA", "IDASolveB", MSGAM_NO_BCK); return(IDA_NO_BCK); } IDAB_mem = IDAADJ_mem->IDAB_mem; /* Check whether IDASolveF has been called */ if ( IDAADJ_mem->ia_firstIDAFcall ) { IDAProcessError(IDA_mem, IDA_NO_FWD, "IDAA", "IDASolveB", MSGAM_NO_FWD); return(IDA_NO_FWD); } sign = (IDAADJ_mem->ia_tfinal - IDAADJ_mem->ia_tinitial > ZERO) ? 1 : -1; /* If this is the first call, loop over all backward problems and * - check that tB0 is valid * - check that tBout is ahead of tB0 in the backward direction * - check whether we need to interpolate forward sensitivities */ if (IDAADJ_mem->ia_firstIDABcall) { /* First IDABMem struct. */ tmp_IDAB_mem = IDAB_mem; while (tmp_IDAB_mem != NULL) { tBn = tmp_IDAB_mem->IDA_mem->ida_tn; if ( (sign*(tBn-IDAADJ_mem->ia_tinitial) < ZERO) || (sign*(IDAADJ_mem->ia_tfinal-tBn) < ZERO) ) { IDAProcessError(IDA_mem, IDA_BAD_TB0, "IDAA", "IDASolveB", MSGAM_BAD_TB0, tmp_IDAB_mem->ida_index); return(IDA_BAD_TB0); } if (sign*(tBn-tBout) <= ZERO) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSGAM_BAD_TBOUT, tmp_IDAB_mem->ida_index); return(IDA_ILL_INPUT); } if ( tmp_IDAB_mem->ida_res_withSensi || tmp_IDAB_mem->ida_rhsQ_withSensi ) IDAADJ_mem->ia_interpSensi = SUNTRUE; /* Advance in list. */ tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } if ( IDAADJ_mem->ia_interpSensi && !IDAADJ_mem->ia_storeSensi) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSGAM_BAD_SENSI); return(IDA_ILL_INPUT); } IDAADJ_mem->ia_firstIDABcall = SUNFALSE; } /* Check for valid itask */ if ( (itaskB != IDA_NORMAL) && (itaskB != IDA_ONE_STEP) ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSG_BAD_ITASK); return(IDA_ILL_INPUT); } /* Check if tBout is legal */ if ( (sign*(tBout-IDAADJ_mem->ia_tinitial) < ZERO) || (sign*(IDAADJ_mem->ia_tfinal-tBout) < ZERO) ) { tfuzz = HUNDRED * IDA_mem->ida_uround * (SUNRabs(IDAADJ_mem->ia_tinitial) + SUNRabs(IDAADJ_mem->ia_tfinal)); if ( (sign*(tBout-IDAADJ_mem->ia_tinitial) < ZERO) && (SUNRabs(tBout-IDAADJ_mem->ia_tinitial) < tfuzz) ) { tBout = IDAADJ_mem->ia_tinitial; } else { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDASolveB", MSGAM_BAD_TBOUT); return(IDA_ILL_INPUT); } } /* Loop through the check points and stop as soon as a backward * problem has its tn value behind the current check point's t0_ * value (in the backward direction) */ ck_mem = IDAADJ_mem->ck_mem; gotCkpnt = SUNFALSE; for(;;) { tmp_IDAB_mem = IDAB_mem; while(tmp_IDAB_mem != NULL) { tBn = tmp_IDAB_mem->IDA_mem->ida_tn; if ( sign*(tBn-ck_mem->ck_t0) > ZERO ) { gotCkpnt = SUNTRUE; break; } if ( (itaskB == IDA_NORMAL) && (tBn == ck_mem->ck_t0) && (sign*(tBout-ck_mem->ck_t0) >= ZERO) ) { gotCkpnt = SUNTRUE; break; } tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } if (gotCkpnt) break; if (ck_mem->ck_next == NULL) break; ck_mem = ck_mem->ck_next; } /* Loop while propagating backward problems */ for(;;) { /* Store interpolation data if not available. This is the 2nd forward integration pass */ if (ck_mem != IDAADJ_mem->ia_ckpntData) { flag = IDAAdataStore(IDA_mem, ck_mem); if (flag != IDA_SUCCESS) break; } /* Starting with the current check point from above, loop over check points while propagating backward problems */ tmp_IDAB_mem = IDAB_mem; while (tmp_IDAB_mem != NULL) { /* Decide if current backward problem is "active" in this check point */ isActive = SUNTRUE; tBn = tmp_IDAB_mem->IDA_mem->ida_tn; if ( (tBn == ck_mem->ck_t0) && (sign*(tBout-ck_mem->ck_t0) < ZERO ) ) isActive = SUNFALSE; if ( (tBn == ck_mem->ck_t0) && (itaskB == IDA_ONE_STEP) ) isActive = SUNFALSE; if ( sign*(tBn - ck_mem->ck_t0) < ZERO ) isActive = SUNFALSE; if ( isActive ) { /* Store the address of current backward problem memory * in IDAADJ_mem to be used in the wrapper functions */ IDAADJ_mem->ia_bckpbCrt = tmp_IDAB_mem; /* Integrate current backward problem */ IDASetStopTime(tmp_IDAB_mem->IDA_mem, ck_mem->ck_t0); flag = IDASolve(tmp_IDAB_mem->IDA_mem, tBout, &tBret, tmp_IDAB_mem->ida_yy, tmp_IDAB_mem->ida_yp, itaskB); /* Set the time at which we will report solution and/or quadratures */ tmp_IDAB_mem->ida_tout = tBret; /* If an error occurred, exit while loop */ if (flag < 0) break; } else { flag = IDA_SUCCESS; tmp_IDAB_mem->ida_tout = tBn; } /* Move to next backward problem */ tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } /* End of while: iteration through backward problems. */ /* If an error occurred, return now */ if (flag <0) { IDAProcessError(IDA_mem, flag, "IDAA", "IDASolveB", MSGAM_BACK_ERROR, tmp_IDAB_mem->ida_index); return(flag); } /* If in IDA_ONE_STEP mode, return now (flag = IDA_SUCCESS) */ if (itaskB == IDA_ONE_STEP) break; /* If all backward problems have succesfully reached tBout, return now */ reachedTBout = SUNTRUE; tmp_IDAB_mem = IDAB_mem; while(tmp_IDAB_mem != NULL) { if ( sign*(tmp_IDAB_mem->ida_tout - tBout) > ZERO ) { reachedTBout = SUNFALSE; break; } tmp_IDAB_mem = tmp_IDAB_mem->ida_next; } if ( reachedTBout ) break; /* Move check point in linked list to next one */ ck_mem = ck_mem->ck_next; } /* End of loop. */ return(flag); } /* * IDAGetB * * IDAGetB returns the state variables at the same time (also returned * in tret) as that at which IDASolveBreturned the solution. */ SUNDIALS_EXPORT int IDAGetB(void* ida_mem, int which, realtype *tret, N_Vector yy, N_Vector yp) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } N_VScale(ONE, IDAB_mem->ida_yy, yy); N_VScale(ONE, IDAB_mem->ida_yp, yp); *tret = IDAB_mem->ida_tout; return(IDA_SUCCESS); } /* * IDAGetQuadB * * IDAGetQuadB returns the quadrature variables at the same * time (also returned in tret) as that at which IDASolveB * returned the solution. */ int IDAGetQuadB(void *ida_mem, int which, realtype *tret, N_Vector qB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; long int nstB; /* Is ida_mem valid? */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetQuadB", MSGAM_NULL_IDAMEM); return IDA_MEM_NULL; } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDA_NO_ADJ, "IDAA", "IDAGetQuadB", MSGAM_NO_ADJ); return(IDA_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAA", "IDAGetQuadB", MSGAM_BAD_WHICH); return(IDA_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } ida_memB = (void *) IDAB_mem->IDA_mem; /* If the integration for this backward problem has not started yet, * simply return the current value of qB (i.e. the final conditions) */ flag = IDAGetNumSteps(ida_memB, &nstB); if (IDA_SUCCESS != flag) return(flag); if (nstB == 0) { N_VScale(ONE, IDAB_mem->IDA_mem->ida_phiQ[0], qB); *tret = IDAB_mem->ida_tout; } else { flag = IDAGetQuad(ida_memB, tret, qB); } return(flag); } /*=================================================================*/ /* Private Functions Implementation */ /*=================================================================*/ /* * IDAAckpntInit * * This routine initializes the check point linked list with * information from the initial time. */ static CkpntMem IDAAckpntInit(IDAMem IDA_mem) { CkpntMem ck_mem; /* Allocate space for ckdata */ ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (NULL==ck_mem) return(NULL); ck_mem->ck_t0 = IDA_mem->ida_tn; ck_mem->ck_nst = 0; ck_mem->ck_kk = 1; ck_mem->ck_hh = ZERO; /* Test if we need to carry quadratures */ ck_mem->ck_quadr = IDA_mem->ida_quadr && IDA_mem->ida_errconQ; /* Test if we need to carry sensitivities */ ck_mem->ck_sensi = IDA_mem->ida_sensi; if(ck_mem->ck_sensi) ck_mem->ck_Ns = IDA_mem->ida_Ns; /* Test if we need to carry quadrature sensitivities */ ck_mem->ck_quadr_sensi = IDA_mem->ida_quadr_sensi && IDA_mem->ida_errconQS; /* Alloc 3: current order, i.e. 1, + 2. */ ck_mem->ck_phi_alloc = 3; if (!IDAAckpntAllocVectors(IDA_mem, ck_mem)) { free(ck_mem); ck_mem = NULL; return(NULL); } /* Save phi* vectors from IDA_mem to ck_mem. */ IDAAckpntCopyVectors(IDA_mem, ck_mem); /* Next in list */ ck_mem->ck_next = NULL; return(ck_mem); } /* * IDAAckpntNew * * This routine allocates space for a new check point and sets * its data from current values in IDA_mem. */ static CkpntMem IDAAckpntNew(IDAMem IDA_mem) { CkpntMem ck_mem; int j; /* Allocate space for ckdata */ ck_mem = (CkpntMem) malloc(sizeof(struct CkpntMemRec)); if (ck_mem == NULL) return(NULL); ck_mem->ck_nst = IDA_mem->ida_nst; ck_mem->ck_tretlast = IDA_mem->ida_tretlast; ck_mem->ck_kk = IDA_mem->ida_kk; ck_mem->ck_kused = IDA_mem->ida_kused; ck_mem->ck_knew = IDA_mem->ida_knew; ck_mem->ck_phase = IDA_mem->ida_phase; ck_mem->ck_ns = IDA_mem->ida_ns; ck_mem->ck_hh = IDA_mem->ida_hh; ck_mem->ck_hused = IDA_mem->ida_hused; ck_mem->ck_rr = IDA_mem->ida_rr; ck_mem->ck_cj = IDA_mem->ida_cj; ck_mem->ck_cjlast = IDA_mem->ida_cjlast; ck_mem->ck_cjold = IDA_mem->ida_cjold; ck_mem->ck_cjratio = IDA_mem->ida_cjratio; ck_mem->ck_ss = IDA_mem->ida_ss; ck_mem->ck_ssS = IDA_mem->ida_ssS; ck_mem->ck_t0 = IDA_mem->ida_tn; for (j=0; jck_psi[j] = IDA_mem->ida_psi[j]; ck_mem->ck_alpha[j] = IDA_mem->ida_alpha[j]; ck_mem->ck_beta[j] = IDA_mem->ida_beta[j]; ck_mem->ck_sigma[j] = IDA_mem->ida_sigma[j]; ck_mem->ck_gamma[j] = IDA_mem->ida_gamma[j]; } /* Test if we need to carry quadratures */ ck_mem->ck_quadr = IDA_mem->ida_quadr && IDA_mem->ida_errconQ; /* Test if we need to carry sensitivities */ ck_mem->ck_sensi = IDA_mem->ida_sensi; if(ck_mem->ck_sensi) ck_mem->ck_Ns = IDA_mem->ida_Ns; /* Test if we need to carry quadrature sensitivities */ ck_mem->ck_quadr_sensi = IDA_mem->ida_quadr_sensi && IDA_mem->ida_errconQS; ck_mem->ck_phi_alloc = (IDA_mem->ida_kk+2 < MXORDP1) ? IDA_mem->ida_kk+2 : MXORDP1; if (!IDAAckpntAllocVectors(IDA_mem, ck_mem)) { free(ck_mem); ck_mem = NULL; return(NULL); } /* Save phi* vectors from IDA_mem to ck_mem. */ IDAAckpntCopyVectors(IDA_mem, ck_mem); return(ck_mem); } /* IDAAckpntDelete * * This routine deletes the first check point in list. */ static void IDAAckpntDelete(CkpntMem *ck_memPtr) { CkpntMem tmp; int j; if (*ck_memPtr != NULL) { /* store head of list */ tmp = *ck_memPtr; /* move head of list */ *ck_memPtr = (*ck_memPtr)->ck_next; /* free N_Vectors in tmp */ for (j=0; jck_phi_alloc; j++) N_VDestroy(tmp->ck_phi[j]); /* free N_Vectors for quadratures in tmp */ if (tmp->ck_quadr) { for (j=0; jck_phi_alloc; j++) N_VDestroy(tmp->ck_phiQ[j]); } /* Free sensitivity related data. */ if (tmp->ck_sensi) { for (j=0; jck_phi_alloc; j++) N_VDestroyVectorArray(tmp->ck_phiS[j], tmp->ck_Ns); } if (tmp->ck_quadr_sensi) { for (j=0; jck_phi_alloc; j++) N_VDestroyVectorArray(tmp->ck_phiQS[j], tmp->ck_Ns); } free(tmp); tmp=NULL; } } /* * IDAAckpntAllocVectors * * Allocate checkpoint's phi, phiQ, phiS, phiQS vectors needed to save * current state of IDAMem. * */ static booleantype IDAAckpntAllocVectors(IDAMem IDA_mem, CkpntMem ck_mem) { int j, jj; for (j=0; jck_phi_alloc; j++) { ck_mem->ck_phi[j] = N_VClone(IDA_mem->ida_tempv1); if(ck_mem->ck_phi[j] == NULL) { for(jj=0; jjck_phi[jj]); return(SUNFALSE); } } /* Do we need to carry quadratures? */ if(ck_mem->ck_quadr) { for (j=0; jck_phi_alloc; j++) { ck_mem->ck_phiQ[j] = N_VClone(IDA_mem->ida_eeQ); if(ck_mem->ck_phiQ[j] == NULL) { for (jj=0; jjck_phiQ[jj]); for(jj=0; jjck_phi_alloc; jj++) N_VDestroy(ck_mem->ck_phi[jj]); return(SUNFALSE); } } } /* Do we need to carry sensitivities? */ if(ck_mem->ck_sensi) { for (j=0; jck_phi_alloc; j++) { ck_mem->ck_phiS[j] = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (ck_mem->ck_phiS[j] == NULL) { for (jj=0; jjck_phiS[jj], IDA_mem->ida_Ns); if (ck_mem->ck_quadr) for (jj=0; jjck_phi_alloc; jj++) N_VDestroy(ck_mem->ck_phiQ[jj]); for (jj=0; jjck_phi_alloc; jj++) N_VDestroy(ck_mem->ck_phi[jj]); return(SUNFALSE); } } } /* Do we need to carry quadrature sensitivities? */ if (ck_mem->ck_quadr_sensi) { for (j=0; jck_phi_alloc; j++) { ck_mem->ck_phiQS[j] = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_eeQ); if (ck_mem->ck_phiQS[j] == NULL) { for (jj=0; jjck_phiQS[jj], IDA_mem->ida_Ns); for (jj=0; jjck_phi_alloc; jj++) N_VDestroyVectorArray(ck_mem->ck_phiS[jj], IDA_mem->ida_Ns); if (ck_mem->ck_quadr) for (jj=0; jjck_phi_alloc; jj++) N_VDestroy(ck_mem->ck_phiQ[jj]); for (jj=0; jjck_phi_alloc; jj++) N_VDestroy(ck_mem->ck_phi[jj]); return(SUNFALSE); } } } return(SUNTRUE); } /* * IDAAckpntCopyVectors * * Copy phi* vectors from IDAMem in the corresponding vectors from checkpoint * */ static void IDAAckpntCopyVectors(IDAMem IDA_mem, CkpntMem ck_mem) { int j, is; /* Save phi* arrays from IDA_mem */ for (j=0; jck_phi_alloc; j++) IDA_mem->ida_cvals[j] = ONE; (void) N_VScaleVectorArray(ck_mem->ck_phi_alloc, IDA_mem->ida_cvals, IDA_mem->ida_phi, ck_mem->ck_phi); if (ck_mem->ck_quadr) (void) N_VScaleVectorArray(ck_mem->ck_phi_alloc, IDA_mem->ida_cvals, IDA_mem->ida_phiQ, ck_mem->ck_phiQ); if (ck_mem->ck_sensi || ck_mem->ck_quadr_sensi) { for (j=0; jck_phi_alloc; j++) { for (is=0; isida_Ns; is++) { IDA_mem->ida_cvals[j*IDA_mem->ida_Ns + is] = ONE; } } } if (ck_mem->ck_sensi) { for (j=0; jck_phi_alloc; j++) { for (is=0; isida_Ns; is++) { IDA_mem->ida_Xvecs[j*IDA_mem->ida_Ns + is] = IDA_mem->ida_phiS[j][is]; IDA_mem->ida_Zvecs[j*IDA_mem->ida_Ns + is] = ck_mem->ck_phiS[j][is]; } } (void) N_VScaleVectorArray(ck_mem->ck_phi_alloc * IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs, IDA_mem->ida_Zvecs); } if(ck_mem->ck_quadr_sensi) { for (j=0; jck_phi_alloc; j++) { for (is=0; isida_Ns; is++) { IDA_mem->ida_Xvecs[j*IDA_mem->ida_Ns + is] = IDA_mem->ida_phiQS[j][is]; IDA_mem->ida_Zvecs[j*IDA_mem->ida_Ns + is] = ck_mem->ck_phiQS[j][is]; } } (void) N_VScaleVectorArray(ck_mem->ck_phi_alloc * IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_Xvecs, IDA_mem->ida_Zvecs); } } /* * IDAAdataMalloc * * This routine allocates memory for storing information at all * intermediate points between two consecutive check points. * This data is then used to interpolate the forward solution * at any other time. */ static booleantype IDAAdataMalloc(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; long int i, j; IDAADJ_mem = IDA_mem->ida_adj_mem; IDAADJ_mem->dt_mem = NULL; dt_mem = (DtpntMem *)malloc((IDAADJ_mem->ia_nsteps+1)*sizeof(struct DtpntMemRec *)); if (dt_mem==NULL) return(SUNFALSE); for (i=0; i<=IDAADJ_mem->ia_nsteps; i++) { dt_mem[i] = (DtpntMem)malloc(sizeof(struct DtpntMemRec)); /* On failure, free any allocated memory and return NULL. */ if (dt_mem[i] == NULL) { for(j=0; jcontent = NULL; } /* Attach the allocated dt_mem to IDAADJ_mem. */ IDAADJ_mem->dt_mem = dt_mem; return(SUNTRUE); } /* * IDAAdataFree * * This routine frees the memory allocated for data storage. */ static void IDAAdataFree(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; long int i; IDAADJ_mem = IDA_mem->ida_adj_mem; if (IDAADJ_mem == NULL) return; /* Destroy data points by calling the interpolation's 'free' routine. */ IDAADJ_mem->ia_free(IDA_mem); for (i=0; i<=IDAADJ_mem->ia_nsteps; i++) { free(IDAADJ_mem->dt_mem[i]); IDAADJ_mem->dt_mem[i] = NULL; } free(IDAADJ_mem->dt_mem); IDAADJ_mem->dt_mem = NULL; } /* * IDAAdataStore * * This routine integrates the forward model starting at the check * point ck_mem and stores y and yprime at all intermediate * steps. * * Return values: * - the flag that IDASolve may return on error * - IDA_REIFWD_FAIL if no check point is available for this hot start * - IDA_SUCCESS */ static int IDAAdataStore(IDAMem IDA_mem, CkpntMem ck_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; realtype t; long int i; int flag, sign; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; /* Initialize IDA_mem with data from ck_mem. */ flag = IDAAckpntGet(IDA_mem, ck_mem); if (flag != IDA_SUCCESS) return(IDA_REIFWD_FAIL); /* Set first structure in dt_mem[0] */ dt_mem[0]->t = ck_mem->ck_t0; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[0]); /* Decide whether TSTOP must be activated */ if (IDAADJ_mem->ia_tstopIDAFcall) { IDASetStopTime(IDA_mem, IDAADJ_mem->ia_tstopIDAF); } sign = (IDAADJ_mem->ia_tfinal - IDAADJ_mem->ia_tinitial > ZERO) ? 1 : -1; /* Run IDASolve in IDA_ONE_STEP mode to set following structures in dt_mem[i]. */ i = 1; do { flag = IDASolve(IDA_mem, ck_mem->ck_t1, &t, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDA_ONE_STEP); if (flag < 0) return(IDA_FWD_FAIL); dt_mem[i]->t = t; IDAADJ_mem->ia_storePnt(IDA_mem, dt_mem[i]); i++; } while ( sign*(ck_mem->ck_t1 - t) > ZERO ); /* New data is now available. */ IDAADJ_mem->ia_ckpntData = ck_mem; IDAADJ_mem->ia_newData = SUNTRUE; IDAADJ_mem->ia_np = i; return(IDA_SUCCESS); } /* * CVAckpntGet * * This routine prepares IDAS for a hot restart from * the check point ck_mem */ static int IDAAckpntGet(IDAMem IDA_mem, CkpntMem ck_mem) { int flag, j, is; if (ck_mem->ck_next == NULL) { /* In this case, we just call the reinitialization routine, * but make sure we use the same initial stepsize as on * the first run. */ IDASetInitStep(IDA_mem, IDA_mem->ida_h0u); flag = IDAReInit(IDA_mem, ck_mem->ck_t0, ck_mem->ck_phi[0], ck_mem->ck_phi[1]); if (flag != IDA_SUCCESS) return(flag); if (ck_mem->ck_quadr) { flag = IDAQuadReInit(IDA_mem, ck_mem->ck_phiQ[0]); if (flag != IDA_SUCCESS) return(flag); } if (ck_mem->ck_sensi) { flag = IDASensReInit(IDA_mem, IDA_mem->ida_ism, ck_mem->ck_phiS[0], ck_mem->ck_phiS[1]); if (flag != IDA_SUCCESS) return(flag); } if (ck_mem->ck_quadr_sensi) { flag = IDAQuadSensReInit(IDA_mem, ck_mem->ck_phiQS[0]); if (flag != IDA_SUCCESS) return(flag); } } else { /* Copy parameters from check point data structure */ IDA_mem->ida_nst = ck_mem->ck_nst; IDA_mem->ida_tretlast = ck_mem->ck_tretlast; IDA_mem->ida_kk = ck_mem->ck_kk; IDA_mem->ida_kused = ck_mem->ck_kused; IDA_mem->ida_knew = ck_mem->ck_knew; IDA_mem->ida_phase = ck_mem->ck_phase; IDA_mem->ida_ns = ck_mem->ck_ns; IDA_mem->ida_hh = ck_mem->ck_hh; IDA_mem->ida_hused = ck_mem->ck_hused; IDA_mem->ida_rr = ck_mem->ck_rr; IDA_mem->ida_cj = ck_mem->ck_cj; IDA_mem->ida_cjlast = ck_mem->ck_cjlast; IDA_mem->ida_cjold = ck_mem->ck_cjold; IDA_mem->ida_cjratio = ck_mem->ck_cjratio; IDA_mem->ida_tn = ck_mem->ck_t0; IDA_mem->ida_ss = ck_mem->ck_ss; IDA_mem->ida_ssS = ck_mem->ck_ssS; /* Copy the arrays from check point data structure */ for (j=0; jck_phi_alloc; j++) N_VScale(ONE, ck_mem->ck_phi[j], IDA_mem->ida_phi[j]); if(ck_mem->ck_quadr) { for (j=0; jck_phi_alloc; j++) N_VScale(ONE, ck_mem->ck_phiQ[j], IDA_mem->ida_phiQ[j]); } if (ck_mem->ck_sensi) { for (is=0; isida_Ns; is++) { for (j=0; jck_phi_alloc; j++) N_VScale(ONE, ck_mem->ck_phiS[j][is], IDA_mem->ida_phiS[j][is]); } } if (ck_mem->ck_quadr_sensi) { for (is=0; isida_Ns; is++) { for (j=0; jck_phi_alloc; j++) N_VScale(ONE, ck_mem->ck_phiQS[j][is], IDA_mem->ida_phiQS[j][is]); } } for (j=0; jida_psi[j] = ck_mem->ck_psi[j]; IDA_mem->ida_alpha[j] = ck_mem->ck_alpha[j]; IDA_mem->ida_beta[j] = ck_mem->ck_beta[j]; IDA_mem->ida_sigma[j] = ck_mem->ck_sigma[j]; IDA_mem->ida_gamma[j] = ck_mem->ck_gamma[j]; } /* Force a call to setup */ IDA_mem->ida_forceSetup = SUNTRUE; } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Functions specific to cubic Hermite interpolation * ----------------------------------------------------------------- */ /* * IDAAhermiteMalloc * * This routine allocates memory for storing information at all * intermediate points between two consecutive check points. * This data is then used to interpolate the forward solution * at any other time. */ static booleantype IDAAhermiteMalloc(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i, ii=0; booleantype allocOK; allocOK = SUNTRUE; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Allocate space for the vectors yyTmp and ypTmp. */ IDAADJ_mem->ia_yyTmp = N_VClone(IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_yyTmp == NULL) { return(SUNFALSE); } IDAADJ_mem->ia_ypTmp = N_VClone(IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_ypTmp == NULL) { return(SUNFALSE); } /* Allocate space for sensitivities temporary vectors. */ if (IDAADJ_mem->ia_storeSensi) { IDAADJ_mem->ia_yySTmp = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_yySTmp == NULL) { N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); return(SUNFALSE); } IDAADJ_mem->ia_ypSTmp = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_ypSTmp == NULL) { N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); N_VDestroyVectorArray(IDAADJ_mem->ia_yySTmp, IDA_mem->ida_Ns); return(SUNFALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=IDAADJ_mem->ia_nsteps; i++) { content = NULL; content = (HermiteDataMem) malloc(sizeof(struct HermiteDataMemRec)); if (content == NULL) { ii = i; allocOK = SUNFALSE; break; } content->y = N_VClone(IDA_mem->ida_tempv1); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } content->yd = N_VClone(IDA_mem->ida_tempv1); if (content->yd == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } if (IDAADJ_mem->ia_storeSensi) { content->yS = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (content->yS == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } content->ySd = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (content->ySd == NULL) { N_VDestroy(content->y); N_VDestroy(content->yd); N_VDestroyVectorArray(content->yS, IDA_mem->ida_Ns); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(IDAADJ_mem->ia_yySTmp, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDAADJ_mem->ia_ypSTmp, IDA_mem->ida_Ns); } for (i=0; icontent); N_VDestroy(content->y); N_VDestroy(content->yd); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(content->yS, IDA_mem->ida_Ns); N_VDestroyVectorArray(content->ySd, IDA_mem->ida_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * IDAAhermiteFree * * This routine frees the memory allocated for data storage. */ static void IDAAhermiteFree(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content; long int i; IDAADJ_mem = IDA_mem->ida_adj_mem; N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(IDAADJ_mem->ia_yySTmp, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDAADJ_mem->ia_ypSTmp, IDA_mem->ida_Ns); } dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=IDAADJ_mem->ia_nsteps; i++) { content = (HermiteDataMem) (dt_mem[i]->content); /* content might be NULL, if IDAAdjInit was called but IDASolveF was not. */ if(content) { N_VDestroy(content->y); N_VDestroy(content->yd); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(content->yS, IDA_mem->ida_Ns); N_VDestroyVectorArray(content->ySd, IDA_mem->ida_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } } /* * IDAAhermiteStorePnt * * This routine stores a new point (y,yd) in the structure d for use * in the cubic Hermite interpolation. * Note that the time is already stored. */ static int IDAAhermiteStorePnt(IDAMem IDA_mem, DtpntMem d) { IDAadjMem IDAADJ_mem; HermiteDataMem content; int is, retval; IDAADJ_mem = IDA_mem->ida_adj_mem; content = (HermiteDataMem) d->content; /* Load solution(s) */ N_VScale(ONE, IDA_mem->ida_phi[0], content->y); if (IDAADJ_mem->ia_storeSensi) { for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiS[0], content->yS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } /* Load derivative(s). */ IDAAGettnSolutionYp(IDA_mem, content->yd); if (IDAADJ_mem->ia_storeSensi) { IDAAGettnSolutionYpS(IDA_mem, content->ySd); } return(0); } /* * IDAAhermiteGetY * * This routine uses cubic piece-wise Hermite interpolation for * the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB) but * can be directly called by the user through IDAGetAdjY */ static int IDAAhermiteGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; HermiteDataMem content0, content1; realtype t0, t1, delta; realtype factor1, factor2, factor3; N_Vector y0, yd0, y1, yd1; N_Vector *yS0=NULL, *ySd0=NULL, *yS1, *ySd1; int flag, is, NS; long int indx; booleantype newpoint; /* local variables for fused vector oerations */ int retval; realtype cvals[4]; N_Vector Xvecs[4]; N_Vector* XXvecs[4]; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; /* Local value of Ns */ NS = (IDAADJ_mem->ia_interpSensi && (yyS != NULL)) ? IDA_mem->ida_Ns : 0; /* Get the index in dt_mem */ flag = IDAAfindIndex(IDA_mem, t, &indx, &newpoint); if (flag != IDA_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content0 = (HermiteDataMem) (dt_mem[0]->content); N_VScale(ONE, content0->y, yy); N_VScale(ONE, content0->yd, yp); if (NS > 0) { for (is=0; isida_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, IDA_mem->ida_cvals, content0->yS, yyS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); retval = N_VScaleVectorArray(NS, IDA_mem->ida_cvals, content0->ySd, ypS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } return(IDA_SUCCESS); } /* Extract stuff from the appropriate data points */ t0 = dt_mem[indx-1]->t; t1 = dt_mem[indx]->t; delta = t1 - t0; content0 = (HermiteDataMem) (dt_mem[indx-1]->content); y0 = content0->y; yd0 = content0->yd; if (IDAADJ_mem->ia_interpSensi) { yS0 = content0->yS; ySd0 = content0->ySd; } if (newpoint) { /* Recompute Y0 and Y1 */ content1 = (HermiteDataMem) (dt_mem[indx]->content); y1 = content1->y; yd1 = content1->yd; /* Y1 = delta (yd1 + yd0) - 2 (y1 - y0) */ cvals[0] = -TWO; Xvecs[0] = y1; cvals[1] = TWO; Xvecs[1] = y0; cvals[2] = delta; Xvecs[2] = yd1; cvals[3] = delta; Xvecs[3] = yd0; retval = N_VLinearCombination(4, cvals, Xvecs, IDAADJ_mem->ia_Y[1]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Y0 = y1 - y0 - delta * yd0 */ cvals[0] = ONE; Xvecs[0] = y1; cvals[1] = -ONE; Xvecs[1] = y0; cvals[2] = -delta; Xvecs[2] = yd0; retval = N_VLinearCombination(3, cvals, Xvecs, IDAADJ_mem->ia_Y[0]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Recompute YS0 and YS1, if needed */ if (NS > 0) { yS1 = content1->yS; ySd1 = content1->ySd; /* YS1 = delta (ySd1 + ySd0) - 2 (yS1 - yS0) */ cvals[0] = -TWO; XXvecs[0] = yS1; cvals[1] = TWO; XXvecs[1] = yS0; cvals[2] = delta; XXvecs[2] = ySd1; cvals[3] = delta; XXvecs[3] = ySd0; retval = N_VLinearCombinationVectorArray(NS, 4, cvals, XXvecs, IDAADJ_mem->ia_YS[1]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* YS0 = yS1 - yS0 - delta * ySd0 */ cvals[0] = ONE; XXvecs[0] = yS1; cvals[1] = -ONE; XXvecs[1] = yS0; cvals[2] = -delta; XXvecs[2] = ySd0; retval = N_VLinearCombinationVectorArray(NS, 3, cvals, XXvecs, IDAADJ_mem->ia_YS[0]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } } /* Perform the actual interpolation. */ /* For y. */ factor1 = t - t0; factor2 = factor1/delta; factor2 = factor2*factor2; factor3 = factor2*(t-t1)/delta; cvals[0] = ONE; cvals[1] = factor1; cvals[2] = factor2; cvals[3] = factor3; /* y = y0 + factor1 yd0 + factor2 * Y[0] + factor3 Y[1] */ Xvecs[0] = y0; Xvecs[1] = yd0; Xvecs[2] = IDAADJ_mem->ia_Y[0]; Xvecs[3] = IDAADJ_mem->ia_Y[1]; retval = N_VLinearCombination(4, cvals, Xvecs, yy); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Sensi Interpolation. */ /* yS = yS0 + factor1 ySd0 + factor2 * YS[0] + factor3 YS[1], if needed */ if (NS > 0) { XXvecs[0] = yS0; XXvecs[1] = ySd0; XXvecs[2] = IDAADJ_mem->ia_YS[0]; XXvecs[3] = IDAADJ_mem->ia_YS[1]; retval = N_VLinearCombinationVectorArray(NS, 4, cvals, XXvecs, yyS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } /* For y'. */ factor1 = factor1/delta/delta; /* factor1 = 2(t-t0)/(t1-t0)^2 */ factor2 = factor1*((3*t-2*t1-t0)/delta); /* factor2 = (t-t0)(3*t-2*t1-t0)/(t1-t0)^3 */ factor1 *= 2; cvals[0] = ONE; cvals[1] = factor1; cvals[2] = factor2; /* yp = yd0 + factor1 Y[0] + factor 2 Y[1] */ Xvecs[0] = yd0; Xvecs[1] = IDAADJ_mem->ia_Y[0]; Xvecs[2] = IDAADJ_mem->ia_Y[1]; retval = N_VLinearCombination(3, cvals, Xvecs, yp); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* Sensi interpolation for 1st derivative. */ /* ypS = ySd0 + factor1 YS[0] + factor 2 YS[1], if needed */ if (NS > 0) { XXvecs[0] = ySd0; XXvecs[1] = IDAADJ_mem->ia_YS[0]; XXvecs[2] = IDAADJ_mem->ia_YS[1]; retval = N_VLinearCombinationVectorArray(NS, 3, cvals, XXvecs, ypS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } return(IDA_SUCCESS); } /* * ----------------------------------------------------------------- * Functions specific to Polynomial interpolation * ----------------------------------------------------------------- */ /* * IDAApolynomialMalloc * * This routine allocates memory for storing information at all * intermediate points between two consecutive check points. * This data is then used to interpolate the forward solution * at any other time. * * Information about the first derivative is stored only for the first * data point. */ static booleantype IDAApolynomialMalloc(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; long int i, ii=0; booleantype allocOK; allocOK = SUNTRUE; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Allocate space for the vectors yyTmp and ypTmp */ IDAADJ_mem->ia_yyTmp = N_VClone(IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_yyTmp == NULL) { return(SUNFALSE); } IDAADJ_mem->ia_ypTmp = N_VClone(IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_ypTmp == NULL) { return(SUNFALSE); } if (IDAADJ_mem->ia_storeSensi) { IDAADJ_mem->ia_yySTmp = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_yySTmp == NULL) { N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); return(SUNFALSE); } IDAADJ_mem->ia_ypSTmp = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (IDAADJ_mem->ia_ypSTmp == NULL) { N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); N_VDestroyVectorArray(IDAADJ_mem->ia_yySTmp, IDA_mem->ida_Ns); return(SUNFALSE); } } /* Allocate space for the content field of the dt structures */ dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=IDAADJ_mem->ia_nsteps; i++) { content = NULL; content = (PolynomialDataMem) malloc(sizeof(struct PolynomialDataMemRec)); if (content == NULL) { ii = i; allocOK = SUNFALSE; break; } content->y = N_VClone(IDA_mem->ida_tempv1); if (content->y == NULL) { free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } /* Allocate space for yp also. Needed for the most left point interpolation. */ if (i == 0) { content->yd = N_VClone(IDA_mem->ida_tempv1); /* Memory allocation failure ? */ if (content->yd == NULL) { N_VDestroy(content->y); free(content); content = NULL; ii = i; allocOK = SUNFALSE; } } else { /* Not the first data point. */ content->yd = NULL; } if (IDAADJ_mem->ia_storeSensi) { content->yS = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (content->yS == NULL) { N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); free(content); content = NULL; ii = i; allocOK = SUNFALSE; break; } if (i==0) { content->ySd = N_VCloneVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_tempv1); if (content->ySd == NULL) { N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); N_VDestroyVectorArray(content->yS, IDA_mem->ida_Ns); free(content); content = NULL; ii = i; allocOK = SUNFALSE; } } else { content->ySd = NULL; } } dt_mem[i]->content = content; } /* If an error occurred, deallocate and return */ if (!allocOK) { N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(IDAADJ_mem->ia_yySTmp, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDAADJ_mem->ia_ypSTmp, IDA_mem->ida_Ns); } for (i=0; icontent); N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(content->yS, IDA_mem->ida_Ns); if (content->ySd) N_VDestroyVectorArray(content->ySd, IDA_mem->ida_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } return(allocOK); } /* * IDAApolynomialFree * * This routine frees the memory allocated for data storage. */ static void IDAApolynomialFree(IDAMem IDA_mem) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; long int i; IDAADJ_mem = IDA_mem->ida_adj_mem; N_VDestroy(IDAADJ_mem->ia_yyTmp); N_VDestroy(IDAADJ_mem->ia_ypTmp); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(IDAADJ_mem->ia_yySTmp, IDA_mem->ida_Ns); N_VDestroyVectorArray(IDAADJ_mem->ia_ypSTmp, IDA_mem->ida_Ns); } dt_mem = IDAADJ_mem->dt_mem; for (i=0; i<=IDAADJ_mem->ia_nsteps; i++) { content = (PolynomialDataMem) (dt_mem[i]->content); /* content might be NULL, if IDAAdjInit was called but IDASolveF was not. */ if(content) { N_VDestroy(content->y); if (content->yd) N_VDestroy(content->yd); if (IDAADJ_mem->ia_storeSensi) { N_VDestroyVectorArray(content->yS, IDA_mem->ida_Ns); if (content->ySd) N_VDestroyVectorArray(content->ySd, IDA_mem->ida_Ns); } free(dt_mem[i]->content); dt_mem[i]->content = NULL; } } } /* * IDAApolynomialStorePnt * * This routine stores a new point y in the structure d for use * in the Polynomial interpolation. * * Note that the time is already stored. Information about the * first derivative is available only for the first data point, * in which case content->yp is non-null. */ static int IDAApolynomialStorePnt(IDAMem IDA_mem, DtpntMem d) { IDAadjMem IDAADJ_mem; PolynomialDataMem content; int is, retval; IDAADJ_mem = IDA_mem->ida_adj_mem; content = (PolynomialDataMem) d->content; N_VScale(ONE, IDA_mem->ida_phi[0], content->y); /* copy also the derivative for the first data point (in this case content->yp is non-null). */ if (content->yd) IDAAGettnSolutionYp(IDA_mem, content->yd); if (IDAADJ_mem->ia_storeSensi) { for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiS[0], content->yS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); /* store the derivative if it is the first data point. */ if(content->ySd) IDAAGettnSolutionYpS(IDA_mem, content->ySd); } content->order = IDA_mem->ida_kused; return(0); } /* * IDAApolynomialGetY * * This routine uses polynomial interpolation for the forward solution vector. * It is typically called by the wrapper routines before calling * user provided routines (fB, djacB, bjacB, jtimesB, psolB)) but * can be directly called by the user through CVodeGetAdjY. */ static int IDAApolynomialGetY(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS) { IDAadjMem IDAADJ_mem; DtpntMem *dt_mem; PolynomialDataMem content; int flag, dir, order, i, j, is, NS, retval; long int indx, base; booleantype newpoint; realtype delt, factor, Psi, Psiprime; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; /* Local value of Ns */ NS = (IDAADJ_mem->ia_interpSensi && (yyS != NULL)) ? IDA_mem->ida_Ns : 0; /* Get the index in dt_mem */ flag = IDAAfindIndex(IDA_mem, t, &indx, &newpoint); if (flag != IDA_SUCCESS) return(flag); /* If we are beyond the left limit but close enough, then return y at the left limit. */ if (indx == 0) { content = (PolynomialDataMem) (dt_mem[0]->content); N_VScale(ONE, content->y, yy); N_VScale(ONE, content->yd, yp); if (NS > 0) { for (is=0; isida_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, IDA_mem->ida_cvals, content->yS, yyS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); retval = N_VScaleVectorArray(NS, IDA_mem->ida_cvals, content->ySd, ypS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } return(IDA_SUCCESS); } /* Scaling factor */ delt = SUNRabs(dt_mem[indx]->t - dt_mem[indx-1]->t); /* Find the direction of the forward integration */ dir = (IDAADJ_mem->ia_tfinal - IDAADJ_mem->ia_tinitial > ZERO) ? 1 : -1; /* Establish the base point depending on the integration direction. Modify the base if there are not enough points for the current order */ if (dir == 1) { base = indx; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if(indx < order) base += order-indx; } else { base = indx-1; content = (PolynomialDataMem) (dt_mem[base]->content); order = content->order; if (IDAADJ_mem->ia_np-indx > order) base -= indx+order-IDAADJ_mem->ia_np; } /* Recompute Y (divided differences for Newton polynomial) if needed */ if (newpoint) { /* Store 0-th order DD */ if (dir == 1) { for(j=0;j<=order;j++) { IDAADJ_mem->ia_T[j] = dt_mem[base-j]->t; content = (PolynomialDataMem) (dt_mem[base-j]->content); N_VScale(ONE, content->y, IDAADJ_mem->ia_Y[j]); if (NS > 0) { for (is=0; isida_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, IDA_mem->ida_cvals, content->yS, IDAADJ_mem->ia_YS[j]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } } } else { for(j=0;j<=order;j++) { IDAADJ_mem->ia_T[j] = dt_mem[base-1+j]->t; content = (PolynomialDataMem) (dt_mem[base-1+j]->content); N_VScale(ONE, content->y, IDAADJ_mem->ia_Y[j]); if (NS > 0) { for (is=0; isida_cvals[is] = ONE; retval = N_VScaleVectorArray(NS, IDA_mem->ida_cvals, content->yS, IDAADJ_mem->ia_YS[j]); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } } } /* Compute higher-order DD */ for(i=1;i<=order;i++) { for(j=order;j>=i;j--) { factor = delt/(IDAADJ_mem->ia_T[j]-IDAADJ_mem->ia_T[j-i]); N_VLinearSum(factor, IDAADJ_mem->ia_Y[j], -factor, IDAADJ_mem->ia_Y[j-1], IDAADJ_mem->ia_Y[j]); for (is=0; isia_YS[j][is], -factor, IDAADJ_mem->ia_YS[j-1][is], IDAADJ_mem->ia_YS[j][is]); } } } /* Perform the actual interpolation for yy using nested multiplications */ IDA_mem->ida_cvals[0] = ONE; for (i=0; iida_cvals[i+1] = IDA_mem->ida_cvals[i] * (t-IDAADJ_mem->ia_T[i]) / delt; retval = N_VLinearCombination(order+1, IDA_mem->ida_cvals, IDAADJ_mem->ia_Y, yy); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); if (NS > 0) { retval = N_VLinearCombinationVectorArray(NS, order+1, IDA_mem->ida_cvals, IDAADJ_mem->ia_YS, yyS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } /* Perform the actual interpolation for yp. Writing p(t) = y0 + (t-t0)*f[t0,t1] + ... + (t-t0)(t-t1)...(t-tn)*f[t0,t1,...tn], denote psi_k(t) = (t-t0)(t-t1)...(t-tk). The formula used for p'(t) is: - p'(t) = f[t0,t1] + psi_1'(t)*f[t0,t1,t2] + ... + psi_n'(t)*f[t0,t1,...,tn] We reccursively compute psi_k'(t) from: - psi_k'(t) = (t-tk)*psi_{k-1}'(t) + psi_{k-1} psi_k is rescaled with 1/delt each time is computed, because the Newton DDs from Y were scaled with delt. */ Psi = ONE; Psiprime = ZERO; for(i=1; i<=order; i++) { factor = (t-IDAADJ_mem->ia_T[i-1])/delt; Psiprime = Psi/delt + factor * Psiprime; Psi = Psi * factor; IDA_mem->ida_cvals[i-1] = Psiprime; } retval = N_VLinearCombination(order, IDA_mem->ida_cvals, IDAADJ_mem->ia_Y+1, yp); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); if (NS > 0) { retval = N_VLinearCombinationVectorArray(NS, order, IDA_mem->ida_cvals, IDAADJ_mem->ia_YS+1, ypS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); } return(IDA_SUCCESS); } /* * IDAAGettnSolutionYp * * Evaluates the first derivative of the solution at the last time returned by * IDASolve (tretlast). * * The function implements the same algorithm as in IDAGetSolution but in the * particular case when t=tn (i.e. delta=0). * * This function was implemented to avoid calls to IDAGetSolution which computes * y by doing a loop that is not necessary for this particular situation. */ static int IDAAGettnSolutionYp(IDAMem IDA_mem, N_Vector yp) { int j, kord, retval; realtype C, D, gam; if (IDA_mem->ida_nst==0) { /* If no integration was done, return the yp supplied by user.*/ N_VScale(ONE, IDA_mem->ida_phi[1], yp); return(0); } /* Compute yp as in IDAGetSolution for this particular case when t=tn. */ kord = IDA_mem->ida_kused; if(IDA_mem->ida_kused==0) kord=1; C = ONE; D = ZERO; gam = ZERO; for (j=1; j <= kord; j++) { D = D*gam + C/IDA_mem->ida_psi[j-1]; C = C*gam; gam = IDA_mem->ida_psi[j-1] / IDA_mem->ida_psi[j]; IDA_mem->ida_dvals[j-1] = D; } retval = N_VLinearCombination(kord, IDA_mem->ida_dvals, IDA_mem->ida_phi+1, yp); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(0); } /* * IDAAGettnSolutionYpS * * Same as IDAAGettnSolutionYp, but for first derivative of the sensitivities. * */ static int IDAAGettnSolutionYpS(IDAMem IDA_mem, N_Vector *ypS) { int j, kord, is, retval; realtype C, D, gam; if (IDA_mem->ida_nst==0) { /* If no integration was done, return the ypS supplied by user.*/ for (is=0; isida_Ns; is++) IDA_mem->ida_cvals[is] = ONE; retval = N_VScaleVectorArray(IDA_mem->ida_Ns, IDA_mem->ida_cvals, IDA_mem->ida_phiS[1], ypS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(0); } kord = IDA_mem->ida_kused; if(IDA_mem->ida_kused==0) kord=1; C = ONE; D = ZERO; gam = ZERO; for (j=1; j <= kord; j++) { D = D*gam + C/IDA_mem->ida_psi[j-1]; C = C*gam; gam = IDA_mem->ida_psi[j-1] / IDA_mem->ida_psi[j]; IDA_mem->ida_dvals[j-1] = D; } retval = N_VLinearCombinationVectorArray(IDA_mem->ida_Ns, kord, IDA_mem->ida_dvals, IDA_mem->ida_phiS+1, ypS); if (retval != IDA_SUCCESS) return (IDA_VECTOROP_ERR); return(0); } /* * IDAAfindIndex * * Finds the index in the array of data point strctures such that * dt_mem[indx-1].t <= t < dt_mem[indx].t * If indx is changed from the previous invocation, then newpoint = SUNTRUE * * If t is beyond the leftmost limit, but close enough, indx=0. * * Returns IDA_SUCCESS if successful and IDA_GETY_BADT if unable to * find indx (t is too far beyond limits). */ static int IDAAfindIndex(IDAMem ida_mem, realtype t, long int *indx, booleantype *newpoint) { IDAadjMem IDAADJ_mem; IDAMem IDA_mem; DtpntMem *dt_mem; int sign; booleantype to_left, to_right; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; dt_mem = IDAADJ_mem->dt_mem; *newpoint = SUNFALSE; /* Find the direction of integration */ sign = (IDAADJ_mem->ia_tfinal - IDAADJ_mem->ia_tinitial > ZERO) ? 1 : -1; /* If this is the first time we use new data */ if (IDAADJ_mem->ia_newData) { IDAADJ_mem->ia_ilast = IDAADJ_mem->ia_np-1; *newpoint = SUNTRUE; IDAADJ_mem->ia_newData = SUNFALSE; } /* Search for indx starting from ilast */ to_left = ( sign*(t - dt_mem[IDAADJ_mem->ia_ilast-1]->t) < ZERO); to_right = ( sign*(t - dt_mem[IDAADJ_mem->ia_ilast]->t) > ZERO); if ( to_left ) { /* look for a new indx to the left */ *newpoint = SUNTRUE; *indx = IDAADJ_mem->ia_ilast; for(;;) { if ( *indx == 0 ) break; if ( sign*(t - dt_mem[*indx-1]->t) <= ZERO ) (*indx)--; else break; } if ( *indx == 0 ) IDAADJ_mem->ia_ilast = 1; else IDAADJ_mem->ia_ilast = *indx; if ( *indx == 0 ) { /* t is beyond leftmost limit. Is it too far? */ if ( SUNRabs(t - dt_mem[0]->t) > FUZZ_FACTOR * IDA_mem->ida_uround ) { return(IDA_GETY_BADT); } } } else if ( to_right ) { /* look for a new indx to the right */ *newpoint = SUNTRUE; *indx = IDAADJ_mem->ia_ilast; for(;;) { if ( sign*(t - dt_mem[*indx]->t) > ZERO) (*indx)++; else break; } IDAADJ_mem->ia_ilast = *indx; } else { /* ilast is still OK */ *indx = IDAADJ_mem->ia_ilast; } return(IDA_SUCCESS); } /* * IDAGetAdjY * * This routine returns the interpolated forward solution at time t. * The user must allocate space for y. */ int IDAGetAdjY(void *ida_mem, realtype t, N_Vector yy, N_Vector yp) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAA", "IDAGetAdjY", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; flag = IDAADJ_mem->ia_getY(IDA_mem, t, yy, yp, NULL, NULL); return(flag); } /*=================================================================*/ /* Wrappers for adjoint system */ /*=================================================================*/ /* * IDAAres * * This routine interfaces to the RhsFnB routine provided by * the user. */ static int IDAAres(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *ida_mem) { IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDAMem IDA_mem; int flag, retval; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get the current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get forward solution from interpolation. */ if( IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) flag = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); else flag = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDAA", "IDAAres", MSGAM_BAD_TINTERP, tt); return(-1); } } /* Call the user supplied residual. */ if(IDAB_mem->ida_res_withSensi) { retval = IDAB_mem->ida_resS(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, rrB, IDAB_mem->ida_user_data); }else { retval = IDAB_mem->ida_res(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, rrB, IDAB_mem->ida_user_data); } return(retval); } /* *IDAArhsQ * * This routine interfaces to the IDAQuadRhsFnB routine provided by * the user. * * It is passed to IDAQuadInit calls for backward problem, so it must * be of IDAQuadRhsFn type. */ static int IDAArhsQ(realtype tt, N_Vector yyB, N_Vector ypB, N_Vector resvalQB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; int retval, flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; retval = IDA_SUCCESS; /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp == SUNFALSE) { if (IDAADJ_mem->ia_interpSensi) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp); } else { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); } if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDAA", "IDAArhsQ", MSGAM_BAD_TINTERP, tt); return(-1); } } /* Call user's adjoint quadrature RHS routine */ if (IDAB_mem->ida_rhsQ_withSensi) { retval = IDAB_mem->ida_rhsQS(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, IDAADJ_mem->ia_yySTmp, IDAADJ_mem->ia_ypSTmp, yyB, ypB, resvalQB, IDAB_mem->ida_user_data); } else { retval = IDAB_mem->ida_rhsQ(tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, resvalQB, IDAB_mem->ida_user_data); } return(retval); } StanHeaders/src/idas/idas_bbdpre.c0000644000176200001440000007217513766554457016626 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file contains implementations of routines for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks, for use with IDA, the IDASLS * linear solver interface. * * NOTE: With only one processor in use, a banded matrix results * rather than a block-diagonal matrix with banded blocks. * Diagonal blocking occurs at the processor level. * ----------------------------------------------------------------- */ #include #include #include "idas_impl.h" #include "idas_ls_impl.h" #include "idas_bbdpre_impl.h" #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* Prototypes of IDABBDPrecSetup and IDABBDPrecSolve */ static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *prec_data); static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *prec_data); /* Prototype for IDABBDPrecFree */ static int IDABBDPrecFree(IDAMem ida_mem); /* Prototype for difference quotient Jacobian calculation routine */ static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp); /* Wrapper functions for adjoint code */ static int IDAAglocal(sunindextype NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *user_dataB); static int IDAAgcomm(sunindextype NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, void *user_dataB); /* Prototype for the pfree routine for backward problems. */ static int IDABBDPrecFreeB(IDABMem IDAB_mem); /*================================================================ PART I - forward problems ================================================================*/ /*--------------------------------------------------------------- User-Callable Functions: initialization, reinit and free ---------------------------------------------------------------*/ int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm) { IDAMem IDA_mem; IDALsMem idals_mem; IBBDPrecData pdata; sunindextype muk, mlk, storage_mu, lrw1, liw1; long int lrw, liw; int flag; if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the LS linear solver interface has been created */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Test compatibility of NVECTOR package with the BBD preconditioner */ if(IDA_mem->ida_tempv1->ops->nvgetarraypointer == NULL) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_BAD_NVECTOR); return(IDALS_ILL_INPUT); } /* Allocate data memory. */ pdata = NULL; pdata = (IBBDPrecData) malloc(sizeof *pdata); if (pdata == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* Set pointers to glocal and gcomm; load half-bandwidths. */ pdata->ida_mem = IDA_mem; pdata->glocal = Gres; pdata->gcomm = Gcomm; pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); muk = SUNMIN(Nlocal-1, SUNMAX(0, mukeep)); mlk = SUNMIN(Nlocal-1, SUNMAX(0, mlkeep)); pdata->mukeep = muk; pdata->mlkeep = mlk; /* Set extended upper half-bandwidth for PP (required for pivoting). */ storage_mu = SUNMIN(Nlocal-1, muk+mlk); /* Allocate memory for preconditioner matrix. */ pdata->PP = NULL; pdata->PP = SUNBandMatrixStorage(Nlocal, muk, mlk, storage_mu); if (pdata->PP == NULL) { free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* Allocate memory for temporary N_Vectors */ pdata->zlocal = NULL; pdata->zlocal = N_VNewEmpty_Serial(Nlocal); if (pdata->zlocal == NULL) { SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->rlocal = NULL; pdata->rlocal = N_VNewEmpty_Serial(Nlocal); if (pdata->rlocal == NULL) { N_VDestroy(pdata->zlocal); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv1 = NULL; pdata->tempv1 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv1 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv2 = NULL; pdata->tempv2 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv2 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv3 = NULL; pdata->tempv3 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv3 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } pdata->tempv4 = NULL; pdata->tempv4 = N_VClone(IDA_mem->ida_tempv1); if (pdata->tempv4 == NULL){ N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* Allocate memory for banded linear solver */ pdata->LS = NULL; pdata->LS = SUNLinSol_Band(pdata->rlocal, pdata->PP); if (pdata->LS == NULL) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); N_VDestroy(pdata->tempv4); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* initialize band linear solver object */ flag = SUNLinSolInitialize(pdata->LS); if (flag != SUNLS_SUCCESS) { N_VDestroy(pdata->zlocal); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); N_VDestroy(pdata->tempv4); SUNMatDestroy(pdata->PP); SUNLinSolFree(pdata->LS); free(pdata); pdata = NULL; IDAProcessError(IDA_mem, IDALS_SUNLS_FAIL, "IDASBBDPRE", "IDABBDPrecInit", MSGBBD_SUNLS_FAIL); return(IDALS_SUNLS_FAIL); } /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround); /* Store Nlocal to be used in IDABBDPrecSetup */ pdata->n_local = Nlocal; /* Set work space sizes and initialize nge. */ pdata->rpwsize = 0; pdata->ipwsize = 0; if (IDA_mem->ida_tempv1->ops->nvspace) { N_VSpace(IDA_mem->ida_tempv1, &lrw1, &liw1); pdata->rpwsize += 4*lrw1; pdata->ipwsize += 4*liw1; } if (pdata->rlocal->ops->nvspace) { N_VSpace(pdata->rlocal, &lrw1, &liw1); pdata->rpwsize += 2*lrw1; pdata->ipwsize += 2*liw1; } if (pdata->PP->ops->space) { flag = SUNMatSpace(pdata->PP, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } if (pdata->LS->ops->space) { flag = SUNLinSolSpace(pdata->LS, &lrw, &liw); pdata->rpwsize += lrw; pdata->ipwsize += liw; } pdata->nge = 0; /* make sure pdata is free from any previous allocations */ if (idals_mem->pfree) idals_mem->pfree(IDA_mem); /* Point to the new pdata field in the LS memory */ idals_mem->pdata = pdata; /* Attach the pfree function */ idals_mem->pfree = IDABBDPrecFree; /* Attach preconditioner solve and setup functions */ flag = IDASetPreconditioner(ida_mem, IDABBDPrecSetup, IDABBDPrecSolve); return(flag); } /*-------------------------------------------------------------*/ int IDABBDPrecReInit(void *ida_mem, sunindextype mudq, sunindextype mldq, realtype dq_rel_yy) { IDAMem IDA_mem; IDALsMem idals_mem; IBBDPrecData pdata; sunindextype Nlocal; if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecReInit", MSGBBD_MEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Test if the LS linear solver interface has been created */ if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE", "IDABBDPrecReInit", MSGBBD_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; /* Test if the preconditioner data is non-NULL */ if (idals_mem->pdata == NULL) { IDAProcessError(IDA_mem, IDALS_PMEM_NULL, "IDASBBDPRE", "IDABBDPrecReInit", MSGBBD_PMEM_NULL); return(IDALS_PMEM_NULL); } pdata = (IBBDPrecData) idals_mem->pdata; /* Load half-bandwidths. */ Nlocal = pdata->n_local; pdata->mudq = SUNMIN(Nlocal-1, SUNMAX(0, mudq)); pdata->mldq = SUNMIN(Nlocal-1, SUNMAX(0, mldq)); /* Set rel_yy based on input value dq_rel_yy (0 implies default). */ pdata->rel_yy = (dq_rel_yy > ZERO) ? dq_rel_yy : SUNRsqrt(IDA_mem->ida_uround); /* Re-initialize nge */ pdata->nge = 0; return(IDALS_SUCCESS); } /*-------------------------------------------------------------*/ int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP) { IDAMem IDA_mem; IDALsMem idals_mem; IBBDPrecData pdata; if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_MEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; if (idals_mem->pdata == NULL) { IDAProcessError(IDA_mem, IDALS_PMEM_NULL, "IDASBBDPRE", "IDABBDPrecGetWorkSpace", MSGBBD_PMEM_NULL); return(IDALS_PMEM_NULL); } pdata = (IBBDPrecData) idals_mem->pdata; *lenrwBBDP = pdata->rpwsize; *leniwBBDP = pdata->ipwsize; return(IDALS_SUCCESS); } /*-------------------------------------------------------------*/ int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP) { IDAMem IDA_mem; IDALsMem idals_mem; IBBDPrecData pdata; if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_MEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; if (IDA_mem->ida_lmem == NULL) { IDAProcessError(IDA_mem, IDALS_LMEM_NULL, "IDASBBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_LMEM_NULL); return(IDALS_LMEM_NULL); } idals_mem = (IDALsMem) IDA_mem->ida_lmem; if (idals_mem->pdata == NULL) { IDAProcessError(IDA_mem, IDALS_PMEM_NULL, "IDASBBDPRE", "IDABBDPrecGetNumGfnEvals", MSGBBD_PMEM_NULL); return(IDALS_PMEM_NULL); } pdata = (IBBDPrecData) idals_mem->pdata; *ngevalsBBDP = pdata->nge; return(IDALS_SUCCESS); } /*--------------------------------------------------------------- IDABBDPrecSetup: IDABBDPrecSetup generates a band-block-diagonal preconditioner matrix, where the local block (on this processor) is a band matrix. Each local block is computed by a difference quotient scheme via calls to the user-supplied routines glocal, gcomm. After generating the block in the band matrix PP, this routine does an LU factorization in place in PP. The IDABBDPrecSetup parameters used here are as follows: tt is the current value of the independent variable t. yy is the current value of the dependent variable vector, namely the predicted value of y(t). yp is the current value of the derivative vector y', namely the predicted value of y'(t). c_j is the scalar in the system Jacobian, proportional to 1/hh. bbd_data is the pointer to BBD memory set by IDABBDInit The argument rr is not used. Return value: The value returned by this IDABBDPrecSetup function is a int flag indicating whether it was successful. This value is 0 if successful, > 0 for a recoverable error (step will be retried), or < 0 for a nonrecoverable error (step fails). ----------------------------------------------------------------*/ static int IDABBDPrecSetup(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *bbd_data) { sunindextype ier; IBBDPrecData pdata; IDAMem IDA_mem; int retval; pdata =(IBBDPrecData) bbd_data; IDA_mem = (IDAMem) pdata->ida_mem; /* Call IBBDDQJac for a new Jacobian calculation and store in PP. */ retval = SUNMatZero(pdata->PP); retval = IBBDDQJac(pdata, tt, c_j, yy, yp, pdata->tempv1, pdata->tempv2, pdata->tempv3, pdata->tempv4); if (retval < 0) { IDAProcessError(IDA_mem, -1, "IDASBBDPRE", "IDABBDPrecSetup", MSGBBD_FUNC_FAILED); return(-1); } if (retval > 0) { return(+1); } /* Do LU factorization of matrix and return error flag */ ier = SUNLinSolSetup_Band(pdata->LS, pdata->PP); return(ier); } /*--------------------------------------------------------------- IDABBDPrecSolve The function IDABBDPrecSolve computes a solution to the linear system P z = r, where P is the left preconditioner defined by the routine IDABBDPrecSetup. The IDABBDPrecSolve parameters used here are as follows: rvec is the input right-hand side vector r. zvec is the computed solution vector z. bbd_data is the pointer to BBD data set by IDABBDInit. The arguments tt, yy, yp, rr, c_j and delta are NOT used. IDABBDPrecSolve returns the value returned from the linear solver object. ---------------------------------------------------------------*/ static int IDABBDPrecSolve(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *bbd_data) { IBBDPrecData pdata; int retval; pdata = (IBBDPrecData) bbd_data; /* Attach local data arrays for rvec and zvec to rlocal and zlocal */ N_VSetArrayPointer(N_VGetArrayPointer(rvec), pdata->rlocal); N_VSetArrayPointer(N_VGetArrayPointer(zvec), pdata->zlocal); /* Call banded solver object to do the work */ retval = SUNLinSolSolve(pdata->LS, pdata->PP, pdata->zlocal, pdata->rlocal, ZERO); /* Detach local data arrays from rlocal and zlocal */ N_VSetArrayPointer(NULL, pdata->rlocal); N_VSetArrayPointer(NULL, pdata->zlocal); return(retval); } /*-------------------------------------------------------------*/ static int IDABBDPrecFree(IDAMem IDA_mem) { IDALsMem idals_mem; IBBDPrecData pdata; if (IDA_mem->ida_lmem == NULL) return(0); idals_mem = (IDALsMem) IDA_mem->ida_lmem; if (idals_mem->pdata == NULL) return(0); pdata = (IBBDPrecData) idals_mem->pdata; SUNLinSolFree(pdata->LS); N_VDestroy(pdata->rlocal); N_VDestroy(pdata->zlocal); N_VDestroy(pdata->tempv1); N_VDestroy(pdata->tempv2); N_VDestroy(pdata->tempv3); N_VDestroy(pdata->tempv4); SUNMatDestroy(pdata->PP); free(pdata); pdata = NULL; return(0); } /*--------------------------------------------------------------- IBBDDQJac This routine generates a banded difference quotient approximation to the local block of the Jacobian of G(t,y,y'). It assumes that a band matrix of type SUNMatrix is stored column-wise, and that elements within each column are contiguous. All matrix elements are generated as difference quotients, by way of calls to the user routine glocal. By virtue of the band structure, the number of these calls is bandwidth + 1, where bandwidth = mldq + mudq + 1. But the band matrix kept has bandwidth = mlkeep + mukeep + 1. This routine also assumes that the local elements of a vector are stored contiguously. Return values are: 0 (success), > 0 (recoverable error), or < 0 (nonrecoverable error). ----------------------------------------------------------------*/ static int IBBDDQJac(IBBDPrecData pdata, realtype tt, realtype cj, N_Vector yy, N_Vector yp, N_Vector gref, N_Vector ytemp, N_Vector yptemp, N_Vector gtemp) { IDAMem IDA_mem; realtype inc, inc_inv; int retval; sunindextype group, i, j, width, ngroups, i1, i2; realtype *ydata, *ypdata, *ytempdata, *yptempdata, *grefdata, *gtempdata; realtype *cnsdata = NULL, *ewtdata; realtype *col_j, conj, yj, ypj, ewtj; IDA_mem = (IDAMem) pdata->ida_mem; /* Initialize ytemp and yptemp. */ N_VScale(ONE, yy, ytemp); N_VScale(ONE, yp, yptemp); /* Obtain pointers as required to the data array of vectors. */ ydata = N_VGetArrayPointer(yy); ypdata = N_VGetArrayPointer(yp); gtempdata = N_VGetArrayPointer(gtemp); ewtdata = N_VGetArrayPointer(IDA_mem->ida_ewt); if (IDA_mem->ida_constraints != NULL) cnsdata = N_VGetArrayPointer(IDA_mem->ida_constraints); ytempdata = N_VGetArrayPointer(ytemp); yptempdata= N_VGetArrayPointer(yptemp); grefdata = N_VGetArrayPointer(gref); /* Call gcomm and glocal to get base value of G(t,y,y'). */ if (pdata->gcomm != NULL) { retval = pdata->gcomm(pdata->n_local, tt, yy, yp, IDA_mem->ida_user_data); if (retval != 0) return(retval); } retval = pdata->glocal(pdata->n_local, tt, yy, yp, gref, IDA_mem->ida_user_data); pdata->nge++; if (retval != 0) return(retval); /* Set bandwidth and number of column groups for band differencing. */ width = pdata->mldq + pdata->mudq + 1; ngroups = SUNMIN(width, pdata->n_local); /* Loop over groups. */ for(group = 1; group <= ngroups; group++) { /* Loop over the components in this group. */ for(j = group-1; j < pdata->n_local; j += width) { yj = ydata[j]; ypj = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc to yj based on rel_yy*abs(yj), with adjustments using ypj and ewtj if this is small, and a further adjustment to give it the same sign as hh*ypj. */ inc = pdata->rel_yy * SUNMAX(SUNRabs(yj), SUNMAX( SUNRabs(IDA_mem->ida_hh*ypj), ONE/ewtj)); if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; /* Adjust sign(inc) again if yj has an inequality constraint. */ if (IDA_mem->ida_constraints != NULL) { conj = cnsdata[j]; if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Increment yj and ypj. */ ytempdata[j] += inc; yptempdata[j] += cj*inc; } /* Evaluate G with incremented y and yp arguments. */ retval = pdata->glocal(pdata->n_local, tt, ytemp, yptemp, gtemp, IDA_mem->ida_user_data); pdata->nge++; if (retval != 0) return(retval); /* Loop over components of the group again; restore ytemp and yptemp. */ for(j = group-1; j < pdata->n_local; j += width) { yj = ytempdata[j] = ydata[j]; ypj = yptempdata[j] = ypdata[j]; ewtj = ewtdata[j]; /* Set increment inc as before .*/ inc = pdata->rel_yy * SUNMAX(SUNRabs(yj), SUNMAX( SUNRabs(IDA_mem->ida_hh*ypj), ONE/ewtj)); if (IDA_mem->ida_hh*ypj < ZERO) inc = -inc; inc = (yj + inc) - yj; if (IDA_mem->ida_constraints != NULL) { conj = cnsdata[j]; if (SUNRabs(conj) == ONE) {if ((yj+inc)*conj < ZERO) inc = -inc;} else if (SUNRabs(conj) == TWO) {if ((yj+inc)*conj <= ZERO) inc = -inc;} } /* Form difference quotients and load into PP. */ inc_inv = ONE/inc; col_j = SUNBandMatrix_Column(pdata->PP,j); i1 = SUNMAX(0, j-pdata->mukeep); i2 = SUNMIN(j + pdata->mlkeep, pdata->n_local-1); for(i = i1; i <= i2; i++) SM_COLUMN_ELEMENT_B(col_j,i,j) = inc_inv * (gtempdata[i] - grefdata[i]); } } return(0); } /*================================================================ PART II - backward problems ================================================================*/ /*--------------------------------------------------------------- User-Callable Functions: initialization, reinit and free ---------------------------------------------------------------*/ int IDABBDPrecInitB(void *ida_mem, int which, sunindextype NlocalB, sunindextype mudqB, sunindextype mldqB, sunindextype mukeepB, sunindextype mlkeepB, realtype dq_rel_yyB, IDABBDLocalFnB glocalB, IDABBDCommFnB gcommB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecInitB", MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDALS_NO_ADJ, "IDASBBDPRE", "IDABBDPrecInitB", MSG_LS_NO_ADJ); return(IDALS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE", "IDABBDPrecInitB", MSG_LS_BAD_WHICH); return(IDALS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* Initialize the BBD preconditioner for this backward problem. */ flag = IDABBDPrecInit(ida_memB, NlocalB, mudqB, mldqB, mukeepB, mlkeepB, dq_rel_yyB, IDAAglocal, IDAAgcomm); if (flag != IDA_SUCCESS) return(flag); /* Allocate memory for IDABBDPrecDataB to store the user-provided functions which will be called from the wrappers */ idabbdB_mem = NULL; idabbdB_mem = (IDABBDPrecDataB) malloc(sizeof(* idabbdB_mem)); if (idabbdB_mem == NULL) { IDAProcessError(IDA_mem, IDALS_MEM_FAIL, "IDASBBDPRE", "IDABBDPrecInitB", MSGBBD_MEM_FAIL); return(IDALS_MEM_FAIL); } /* set pointers to user-provided functions */ idabbdB_mem->glocalB = glocalB; idabbdB_mem->gcommB = gcommB; /* Attach pmem and pfree */ IDAB_mem->ida_pmem = idabbdB_mem; IDAB_mem->ida_pfree = IDABBDPrecFreeB; return(IDALS_SUCCESS); } /*-------------------------------------------------------------*/ int IDABBDPrecReInitB(void *ida_mem, int which, sunindextype mudqB, sunindextype mldqB, realtype dq_rel_yyB) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; void *ida_memB; int flag; /* Check if ida_mem is allright. */ if (ida_mem == NULL) { IDAProcessError(NULL, IDALS_MEM_NULL, "IDASBBDPRE", "IDABBDPrecReInitB", MSG_LS_IDAMEM_NULL); return(IDALS_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* Is ASA initialized? */ if (IDA_mem->ida_adjMallocDone == SUNFALSE) { IDAProcessError(IDA_mem, IDALS_NO_ADJ, "IDASBBDPRE", "IDABBDPrecReInitB", MSG_LS_NO_ADJ); return(IDALS_NO_ADJ); } IDAADJ_mem = IDA_mem->ida_adj_mem; /* Check the value of which */ if ( which >= IDAADJ_mem->ia_nbckpbs ) { IDAProcessError(IDA_mem, IDALS_ILL_INPUT, "IDASBBDPRE", "IDABBDPrecReInitB", MSG_LS_BAD_WHICH); return(IDALS_ILL_INPUT); } /* Find the IDABMem entry in the linked list corresponding to 'which'. */ IDAB_mem = IDAADJ_mem->IDAB_mem; while (IDAB_mem != NULL) { if( which == IDAB_mem->ida_index ) break; /* advance */ IDAB_mem = IDAB_mem->ida_next; } /* ida_mem corresponding to 'which' backward problem. */ ida_memB = (void *) IDAB_mem->IDA_mem; /* ReInitialize the BBD preconditioner for this backward problem. */ flag = IDABBDPrecReInit(ida_memB, mudqB, mldqB, dq_rel_yyB); return(flag); } /*-------------------------------------------------------------*/ static int IDABBDPrecFreeB(IDABMem IDAB_mem) { free(IDAB_mem->ida_pmem); IDAB_mem->ida_pmem = NULL; return(0); } /*---------------------------------------------------------------- Wrapper functions ----------------------------------------------------------------*/ /*---------------------------------------------------------------- IDAAglocal This routine interfaces to the IDALocalFnB routine provided by the user. ----------------------------------------------------------------*/ static int IDAAglocal(sunindextype NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get the preconditioner's memory. */ idabbdB_mem = (IDABBDPrecDataB) IDAB_mem->ida_pmem; /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp == SUNFALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDASBBDPRE", "IDAAglocal", MSGBBD_BAD_T); return(-1); } } /* Call user's adjoint LocalFnB function. */ return idabbdB_mem->glocalB(NlocalB, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, gvalB, IDAB_mem->ida_user_data); } /*---------------------------------------------------------------- IDAAgcomm This routine interfaces to the IDACommFnB routine provided by the user. ----------------------------------------------------------------*/ static int IDAAgcomm(sunindextype NlocalB, realtype tt, N_Vector yyB, N_Vector ypB, void *ida_mem) { IDAMem IDA_mem; IDAadjMem IDAADJ_mem; IDABMem IDAB_mem; IDABBDPrecDataB idabbdB_mem; int flag; IDA_mem = (IDAMem) ida_mem; IDAADJ_mem = IDA_mem->ida_adj_mem; /* Get current backward problem. */ IDAB_mem = IDAADJ_mem->ia_bckpbCrt; /* Get the preconditioner's memory. */ idabbdB_mem = (IDABBDPrecDataB) IDAB_mem->ida_pmem; if (idabbdB_mem->gcommB == NULL) return(0); /* Get forward solution from interpolation. */ if (IDAADJ_mem->ia_noInterp == SUNFALSE) { flag = IDAADJ_mem->ia_getY(IDA_mem, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, NULL, NULL); if (flag != IDA_SUCCESS) { IDAProcessError(IDA_mem, -1, "IDASBBDPRE", "IDAAgcomm", MSGBBD_BAD_T); return(-1); } } /* Call user's adjoint CommFnB routine */ return idabbdB_mem->gcommB(NlocalB, tt, IDAADJ_mem->ia_yyTmp, IDAADJ_mem->ia_ypTmp, yyB, ypB, IDAB_mem->ida_user_data); } StanHeaders/src/idas/idas_spils.c0000644000176200001440000001070413766554457016510 0ustar liggesusers/*----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------- * Implementation file for the deprecated Scaled and Preconditioned * Iterative Linear Solver interface in IDAS; these routines now just * wrap the updated IDA generic linear solver interface in idas_ls.h. *-----------------------------------------------------------------*/ #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Exported Functions (wrappers for equivalent routines in idas_ls.h) =================================================================*/ int IDASpilsSetLinearSolver(void *ida_mem, SUNLinearSolver LS) { return(IDASetLinearSolver(ida_mem, LS, NULL)); } int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve) { return(IDASetPreconditioner(ida_mem, pset, psolve)); } int IDASpilsSetJacTimes(void *ida_mem, IDASpilsJacTimesSetupFn jtsetup, IDASpilsJacTimesVecFn jtimes) { return(IDASetJacTimes(ida_mem, jtsetup, jtimes)); } int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac) { return(IDASetEpsLin(ida_mem, eplifac)); } int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac) { return(IDASetIncrementFactor(ida_mem, dqincfac)); } int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS) { return(IDAGetLinWorkSpace(ida_mem, lenrwLS, leniwLS)); } int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals) { return(IDAGetNumPrecEvals(ida_mem, npevals)); } int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves) { return(IDAGetNumPrecSolves(ida_mem, npsolves)); } int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters) { return(IDAGetNumLinIters(ida_mem, nliters)); } int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails) { return(IDAGetNumLinConvFails(ida_mem, nlcfails)); } int IDASpilsGetNumJTSetupEvals(void *ida_mem, long int *njtsetups) { return(IDAGetNumJTSetupEvals(ida_mem, njtsetups)); } int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals) { return(IDAGetNumJtimesEvals(ida_mem, njvevals)); } int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS) { return(IDAGetNumLinResEvals(ida_mem, nrevalsLS)); } int IDASpilsGetLastFlag(void *ida_mem, long int *flag) { return(IDAGetLastLinFlag(ida_mem, flag)); } char *IDASpilsGetReturnFlagName(long int flag) { return(IDAGetLinReturnFlagName(flag)); } int IDASpilsSetLinearSolverB(void *ida_mem, int which, SUNLinearSolver LS) { return(IDASetLinearSolverB(ida_mem, which, LS, NULL)); } int IDASpilsSetEpsLinB(void *ida_mem, int which, realtype eplifacB) { return(IDASetEpsLinB(ida_mem, which, eplifacB)); } int IDASpilsSetIncrementFactorB(void *ida_mem, int which, realtype dqincfacB) { return(IDASetIncrementFactorB(ida_mem, which, dqincfacB)); } int IDASpilsSetPreconditionerB(void *ida_mem, int which, IDASpilsPrecSetupFnB psetB, IDASpilsPrecSolveFnB psolveB) { return(IDASetPreconditionerB(ida_mem, which, psetB, psolveB)); } int IDASpilsSetPreconditionerBS(void *ida_mem, int which, IDASpilsPrecSetupFnBS psetBS, IDASpilsPrecSolveFnBS psolveBS) { return(IDASetPreconditionerBS(ida_mem, which, psetBS, psolveBS)); } int IDASpilsSetJacTimesB(void *ida_mem, int which, IDASpilsJacTimesSetupFnB jtsetupB, IDASpilsJacTimesVecFnB jtimesB) { return(IDASetJacTimesB(ida_mem, which, jtsetupB, jtimesB)); } int IDASpilsSetJacTimesBS(void *ida_mem, int which, IDASpilsJacTimesSetupFnBS jtsetupBS, IDASpilsJacTimesVecFnBS jtimesBS) { return(IDASetJacTimesBS(ida_mem, which, jtsetupBS, jtimesBS)); } #ifdef __cplusplus } #endif StanHeaders/src/idas/idas_impl.h0000644000176200001440000013632713766554457016336 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file (private version) for the main IDAS solver. * ----------------------------------------------------------------- */ #ifndef _IDAS_IMPL_H #define _IDAS_IMPL_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ================================================================= * M A I N I N T E G R A T O R M E M O R Y B L O C K * ================================================================= */ /* Basic IDA constants */ #define HMAX_INV_DEFAULT RCONST(0.0) /* hmax_inv default value */ #define MAXORD_DEFAULT 5 /* maxord default value */ #define MXORDP1 6 /* max. number of N_Vectors in phi */ #define MXSTEP_DEFAULT 500 /* mxstep default value */ /* Return values for lower level routines used by IDASolve and functions provided to the nonlinear solver */ #define IDA_RES_RECVR +1 #define IDA_LSETUP_RECVR +2 #define IDA_LSOLVE_RECVR +3 #define IDA_CONSTR_RECVR +5 #define IDA_NLS_SETUP_RECVR +6 #define IDA_QRHS_RECVR +10 #define IDA_SRES_RECVR +11 #define IDA_QSRHS_RECVR +12 /* itol */ #define IDA_NN 0 #define IDA_SS 1 #define IDA_SV 2 #define IDA_WF 3 #define IDA_EE 4 /* * ----------------------------------------------------------------- * Types: struct IDAMemRec, IDAMem * ----------------------------------------------------------------- * The type IDAMem is type pointer to struct IDAMemRec. * This structure contains fields to keep track of problem state. * ----------------------------------------------------------------- */ typedef struct IDAMemRec { realtype ida_uround; /* machine unit roundoff */ /*-------------------------- Problem Specification Data --------------------------*/ IDAResFn ida_res; /* F(t,y(t),y'(t))=0; the function F */ void *ida_user_data; /* user pointer passed to res */ int ida_itol; /* itol = IDA_SS, IDA_SV, IDA_WF, IDA_NN */ realtype ida_rtol; /* relative tolerance */ realtype ida_Satol; /* scalar absolute tolerance */ N_Vector ida_Vatol; /* vector absolute tolerance */ booleantype ida_user_efun; /* SUNTRUE if user provides efun */ IDAEwtFn ida_efun; /* function to set ewt */ void *ida_edata; /* user pointer passed to efun */ /*----------------------- Quadrature Related Data -----------------------*/ booleantype ida_quadr; IDAQuadRhsFn ida_rhsQ; void *ida_user_dataQ; booleantype ida_errconQ; int ida_itolQ; realtype ida_rtolQ; realtype ida_SatolQ; /* scalar absolute tolerance for quadratures */ N_Vector ida_VatolQ; /* vector absolute tolerance for quadratures */ /*------------------------ Sensitivity Related Data ------------------------*/ booleantype ida_sensi; int ida_Ns; int ida_ism; IDASensResFn ida_resS; void *ida_user_dataS; booleantype ida_resSDQ; realtype *ida_p; realtype *ida_pbar; int *ida_plist; int ida_DQtype; realtype ida_DQrhomax; booleantype ida_errconS; /* SUNTRUE if sensitivities in err. control */ int ida_itolS; realtype ida_rtolS; /* relative tolerance for sensitivities */ realtype *ida_SatolS; /* scalar absolute tolerances for sensi. */ N_Vector *ida_VatolS; /* vector absolute tolerances for sensi. */ /*----------------------------------- Quadrature Sensitivity Related Data -----------------------------------*/ booleantype ida_quadr_sensi; /* SUNTRUE if computing sensitivities of quadrs. */ IDAQuadSensRhsFn ida_rhsQS; /* fQS = (dfQ/dy)*yS + (dfQ/dp) */ void *ida_user_dataQS; /* data pointer passed to fQS */ booleantype ida_rhsQSDQ; /* SUNTRUE if using internal DQ functions */ booleantype ida_errconQS; /* SUNTRUE if yQS are considered in err. con. */ int ida_itolQS; realtype ida_rtolQS; /* relative tolerance for yQS */ realtype *ida_SatolQS; /* scalar absolute tolerances for yQS */ N_Vector *ida_VatolQS; /* vector absolute tolerances for yQS */ /*----------------------------------------------- Divided differences array and associated arrays -----------------------------------------------*/ N_Vector ida_phi[MXORDP1]; /* phi = (maxord+1) arrays of divided differences */ realtype ida_psi[MXORDP1]; /* differences in t (sums of recent step sizes) */ realtype ida_alpha[MXORDP1]; /* ratios of current stepsize to psi values */ realtype ida_beta[MXORDP1]; /* ratios of current to previous product of psi's */ realtype ida_sigma[MXORDP1]; /* product successive alpha values and factorial */ realtype ida_gamma[MXORDP1]; /* sum of reciprocals of psi values */ /*------------------------- N_Vectors for integration -------------------------*/ N_Vector ida_ewt; /* error weight vector */ N_Vector ida_yy; /* work space for y vector (= user's yret) */ N_Vector ida_yp; /* work space for y' vector (= user's ypret) */ N_Vector ida_yypredict; /* predicted y vector */ N_Vector ida_yppredict; /* predicted y' vector */ N_Vector ida_delta; /* residual vector */ N_Vector ida_id; /* bit vector for diff./algebraic components */ N_Vector ida_constraints; /* vector of inequality constraint options */ N_Vector ida_savres; /* saved residual vector */ N_Vector ida_ee; /* accumulated corrections to y vector, but set equal to estimated local errors upon successful return */ N_Vector ida_mm; /* mask vector in constraints tests (= tempv2) */ N_Vector ida_tempv1; /* work space vector */ N_Vector ida_tempv2; /* work space vector */ N_Vector ida_tempv3; /* work space vector */ N_Vector ida_ynew; /* work vector for y in IDACalcIC (= tempv2) */ N_Vector ida_ypnew; /* work vector for yp in IDACalcIC (= ee) */ N_Vector ida_delnew; /* work vector for delta in IDACalcIC (= phi[2]) */ N_Vector ida_dtemp; /* work vector in IDACalcIC (= phi[3]) */ /*---------------------------- Quadrature Related N_Vectors ----------------------------*/ N_Vector ida_phiQ[MXORDP1]; N_Vector ida_yyQ; N_Vector ida_ypQ; N_Vector ida_ewtQ; N_Vector ida_eeQ; /*--------------------------- Sensitivity Related Vectors ---------------------------*/ N_Vector *ida_phiS[MXORDP1]; N_Vector *ida_ewtS; N_Vector *ida_eeS; /* cumulative sensitivity corrections */ N_Vector *ida_yyS; /* allocated and used for: */ N_Vector *ida_ypS; /* ism = SIMULTANEOUS */ N_Vector *ida_yySpredict; /* ism = STAGGERED */ N_Vector *ida_ypSpredict; N_Vector *ida_deltaS; N_Vector ida_tmpS1; /* work space vectors | tmpS1 = tempv1 */ N_Vector ida_tmpS2; /* for resS | tmpS2 = tempv2 */ N_Vector ida_tmpS3; /* | tmpS3 = allocated */ N_Vector *ida_savresS; /* work vector in IDACalcIC for stg (= phiS[2]) */ N_Vector *ida_delnewS; /* work vector in IDACalcIC for stg (= phiS[3]) */ N_Vector *ida_yyS0; /* initial yS, ypS vectors allocated and */ N_Vector *ida_ypS0; /* deallocated in IDACalcIC function */ N_Vector *ida_yyS0new; /* work vector in IDASensLineSrch (= phiS[4]) */ N_Vector *ida_ypS0new; /* work vector in IDASensLineSrch (= eeS) */ /*-------------------------------------- Quadrature Sensitivity Related Vectors --------------------------------------*/ N_Vector *ida_phiQS[MXORDP1];/* Mod. div. diffs. for quadr. sensitivities */ N_Vector *ida_ewtQS; /* error weight vectors for sensitivities */ N_Vector *ida_eeQS; /* cumulative quadr.sensi.corrections */ N_Vector *ida_yyQS; /* Unlike yS, yQS is not allocated by the user */ N_Vector *ida_tempvQS; /* temporary storage vector (~ tempv) */ N_Vector ida_savrhsQ; /* saved quadr. rhs (needed for rhsQS calls) */ /*------------------------------ Variables for use by IDACalcIC ------------------------------*/ realtype ida_t0; /* initial t */ N_Vector ida_yy0; /* initial y vector (user-supplied). */ N_Vector ida_yp0; /* initial y' vector (user-supplied). */ int ida_icopt; /* IC calculation user option */ booleantype ida_lsoff; /* IC calculation linesearch turnoff option */ int ida_maxnh; /* max. number of h tries in IC calculation */ int ida_maxnj; /* max. number of J tries in IC calculation */ int ida_maxnit; /* max. number of Netwon iterations in IC calc. */ int ida_nbacktr; /* number of IC linesearch backtrack operations */ int ida_sysindex; /* computed system index (0 or 1) */ int ida_maxbacks; /* max backtracks per Newton step */ realtype ida_epiccon; /* IC nonlinear convergence test constant */ realtype ida_steptol; /* minimum Newton step size in IC calculation */ realtype ida_tscale; /* time scale factor = abs(tout1 - t0) */ /* Tstop information */ booleantype ida_tstopset; realtype ida_tstop; /* Step Data */ int ida_kk; /* current BDF method order */ int ida_knew; /* order for next step from order decrease decision */ int ida_phase; /* flag to trigger step doubling in first few steps */ int ida_ns; /* counts steps at fixed stepsize and order */ realtype ida_hin; /* initial step */ realtype ida_hh; /* current step size h */ realtype ida_rr; /* rr = hnext / hused */ realtype ida_tn; /* current internal value of t */ realtype ida_tretlast; /* value of tret previously returned by IDASolve */ realtype ida_cj; /* current value of scalar (-alphas/hh) in Jacobian */ realtype ida_cjlast; /* cj value saved from last successful step */ realtype ida_cjold; /* cj value saved from last call to lsetup */ realtype ida_cjratio; /* ratio of cj values: cj/cjold */ realtype ida_ss; /* scalar used in Newton iteration convergence test */ realtype ida_oldnrm; /* norm of previous nonlinear solver update */ realtype ida_epsNewt; /* test constant in Newton convergence test */ realtype ida_epcon; /* coeficient of the Newton covergence test */ realtype ida_toldel; /* tolerance in direct test on Newton corrections */ realtype ida_ssS; /* scalar ss for staggered sensitivities */ /*------ Limits ------*/ int ida_maxncf; /* max numer of convergence failures */ int ida_maxcor; /* max number of Newton corrections */ int ida_maxnef; /* max number of error test failures */ int ida_maxord; /* max value of method order k: */ int ida_maxord_alloc; /* value of maxord used when allocating memory */ long int ida_mxstep; /* max number of internal steps for one user call */ realtype ida_hmax_inv; /* inverse of max. step size hmax (default = 0.0) */ int ida_maxcorS; /* max number of Newton corrections for sensitivity systems (staggered method) */ /*-------- Counters --------*/ long int ida_nst; /* number of internal steps taken */ long int ida_nre; /* number of function (res) calls */ long int ida_nrQe; long int ida_nrSe; long int ida_nrQSe; /* number of fQS calls */ long int ida_nreS; long int ida_nrQeS; /* number of fQ calls from sensi DQ */ long int ida_ncfn; /* number of corrector convergence failures */ long int ida_ncfnQ; long int ida_ncfnS; long int ida_netf; /* number of error test failures */ long int ida_netfQ; long int ida_netfS; long int ida_netfQS; /* number of quadr. sensi. error test failures */ long int ida_nni; /* number of Newton iterations performed */ long int ida_nniS; long int ida_nsetups; /* number of lsetup calls */ long int ida_nsetupsS; /*--------------------------- Space requirements for IDAS ---------------------------*/ sunindextype ida_lrw1; /* no. of realtype words in 1 N_Vector */ sunindextype ida_liw1; /* no. of integer words in 1 N_Vector */ sunindextype ida_lrw1Q; sunindextype ida_liw1Q; long int ida_lrw; /* number of realtype words in IDA work vectors */ long int ida_liw; /* no. of integer words in IDA work vectors */ /*------------------------------------------- Error handler function and error ouput file -------------------------------------------*/ IDAErrHandlerFn ida_ehfun; /* Error messages are handled by ehfun */ void *ida_eh_data; /* dats pointer passed to ehfun */ FILE *ida_errfp; /* IDA error messages are sent to errfp */ /* Flags to verify correct calling sequence */ booleantype ida_SetupDone; /* set to SUNFALSE by IDAInit and IDAReInit set to SUNTRUE by IDACalcIC or IDASolve */ booleantype ida_VatolMallocDone; booleantype ida_constraintsMallocDone; booleantype ida_idMallocDone; booleantype ida_MallocDone; /* set to SUNFALSE by IDACreate set to SUNTRUE by IDAInit tested by IDAReInit and IDASolve */ booleantype ida_VatolQMallocDone; booleantype ida_quadMallocDone; booleantype ida_VatolSMallocDone; booleantype ida_SatolSMallocDone; booleantype ida_sensMallocDone; booleantype ida_VatolQSMallocDone; booleantype ida_SatolQSMallocDone; booleantype ida_quadSensMallocDone; /*--------------------- Nonlinear Solver Data ---------------------*/ SUNNonlinearSolver NLS; /* nonlinear solver object for DAE solves */ booleantype ownNLS; /* flag indicating NLS ownership */ SUNNonlinearSolver NLSsim; /* nonlinear solver object for DAE+Sens solves with the simultaneous corrector option */ booleantype ownNLSsim; /* flag indicating NLS ownership */ SUNNonlinearSolver NLSstg; /* nonlinear solver object for DAE+Sens solves with the staggered corrector option */ booleantype ownNLSstg; /* flag indicating NLS ownership */ /* The following vectors are NVector wrappers for use with the simultaneous and staggered corrector methods: Simult: ycor0Sim = [ida_delta, ida_deltaS] ycorSim = [ida_ee, ida_eeS] ewtSim = [ida_ewt, ida_ewtS] Stagger: ycor0Stg = ida_deltaS ycorStg = ida_eeS ewtStg = ida_ewtS */ N_Vector ycor0Sim, ycorSim, ewtSim; N_Vector ycor0Stg, ycorStg, ewtStg; /* flags indicating if vector wrappers for the simultaneous and staggered correctors have been allocated */ booleantype simMallocDone; booleantype stgMallocDone; /*------------------ Linear Solver Data ------------------*/ /* Linear Solver functions to be called */ int (*ida_linit)(struct IDAMemRec *idamem); int (*ida_lsetup)(struct IDAMemRec *idamem, N_Vector yyp, N_Vector ypp, N_Vector resp, N_Vector tempv1, N_Vector tempv2, N_Vector tempv3); int (*ida_lsolve)(struct IDAMemRec *idamem, N_Vector b, N_Vector weight, N_Vector ycur, N_Vector ypcur, N_Vector rescur); int (*ida_lperf)(struct IDAMemRec *idamem, int perftask); int (*ida_lfree)(struct IDAMemRec *idamem); /* Linear Solver specific memory */ void *ida_lmem; /* Flag to request a call to the setup routine */ booleantype ida_forceSetup; /* Flag to indicate successful ida_linit call */ booleantype ida_linitOK; /*------------ Saved Values ------------*/ booleantype ida_constraintsSet; /* constraints vector present */ booleantype ida_suppressalg; /* SUNTRUE if suppressing algebraic vars. in local error tests */ int ida_kused; /* method order used on last successful step */ realtype ida_h0u; /* actual initial stepsize */ realtype ida_hused; /* step size used on last successful step */ realtype ida_tolsf; /* tolerance scale factor (saved value) */ /*---------------- Rootfinding Data ----------------*/ IDARootFn ida_gfun; /* Function g for roots sought */ int ida_nrtfn; /* number of components of g */ int *ida_iroots; /* array for root information */ int *ida_rootdir; /* array specifying direction of zero-crossing */ realtype ida_tlo; /* nearest endpoint of interval in root search */ realtype ida_thi; /* farthest endpoint of interval in root search */ realtype ida_trout; /* t return value from rootfinder routine */ realtype *ida_glo; /* saved array of g values at t = tlo */ realtype *ida_ghi; /* saved array of g values at t = thi */ realtype *ida_grout; /* array of g values at t = trout */ realtype ida_toutc; /* copy of tout (if NORMAL mode) */ realtype ida_ttol; /* tolerance on root location */ int ida_taskc; /* copy of parameter itask */ int ida_irfnd; /* flag showing whether last step had a root */ long int ida_nge; /* counter for g evaluations */ booleantype *ida_gactive; /* array with active/inactive event functions */ int ida_mxgnull; /* number of warning messages about possible g==0 */ /* Arrays for Fused Vector Operations */ /* scalar arrays */ realtype* ida_cvals; realtype ida_dvals[MAXORD_DEFAULT]; /* vector arrays */ N_Vector* ida_Xvecs; N_Vector* ida_Zvecs; /*------------------------ Adjoint sensitivity data ------------------------*/ booleantype ida_adj; /* SUNTRUE if performing ASA */ struct IDAadjMemRec *ida_adj_mem; /* Pointer to adjoint memory structure */ booleantype ida_adjMallocDone; } *IDAMem; /* * ================================================================= * A D J O I N T M O D U L E M E M O R Y B L O C K * ================================================================= */ /* * ----------------------------------------------------------------- * Forward references for pointers to various structures * ----------------------------------------------------------------- */ typedef struct IDAadjMemRec *IDAadjMem; typedef struct CkpntMemRec *CkpntMem; typedef struct DtpntMemRec *DtpntMem; typedef struct IDABMemRec *IDABMem; /* * ----------------------------------------------------------------- * Types for functions provided by an interpolation module * ----------------------------------------------------------------- * IDAAMMallocFn: Type for a function that initializes the content * field of the structures in the dt array * IDAAMFreeFn: Type for a function that deallocates the content * field of the structures in the dt array * IDAAGetYFn: Function type for a function that returns the * interpolated forward solution. * IDAAStorePnt: Function type for a function that stores a new * point in the structure d * ----------------------------------------------------------------- */ typedef booleantype (*IDAAMMallocFn)(IDAMem IDA_mem); typedef void (*IDAAMFreeFn)(IDAMem IDA_mem); typedef int (*IDAAGetYFn)(IDAMem IDA_mem, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS); typedef int (*IDAAStorePntFn)(IDAMem IDA_mem, DtpntMem d); /* * ----------------------------------------------------------------- * Types : struct CkpntMemRec, CkpntMem * ----------------------------------------------------------------- * The type CkpntMem is type pointer to struct CkpntMemRec. * This structure contains fields to store all information at a * check point that is needed to 'hot' start IDAS. * ----------------------------------------------------------------- */ struct CkpntMemRec { /* Integration limits */ realtype ck_t0; realtype ck_t1; /* Modified divided difference array */ N_Vector ck_phi[MXORDP1]; /* Do we need to carry quadratures? */ booleantype ck_quadr; /* Modified divided difference array for quadratures */ N_Vector ck_phiQ[MXORDP1]; /* Do we need to carry sensitivities? */ booleantype ck_sensi; /* number of sensitivities */ int ck_Ns; /* Modified divided difference array for sensitivities */ N_Vector *ck_phiS[MXORDP1]; /* Do we need to carry quadrature sensitivities? */ booleantype ck_quadr_sensi; /* Modified divided difference array for quadrature sensitivities */ N_Vector *ck_phiQS[MXORDP1]; /* Step data */ long int ck_nst; realtype ck_tretlast; long int ck_ns; int ck_kk; int ck_kused; int ck_knew; int ck_phase; realtype ck_hh; realtype ck_hused; realtype ck_rr; realtype ck_cj; realtype ck_cjlast; realtype ck_cjold; realtype ck_cjratio; realtype ck_ss; realtype ck_ssS; realtype ck_psi[MXORDP1]; realtype ck_alpha[MXORDP1]; realtype ck_beta[MXORDP1]; realtype ck_sigma[MXORDP1]; realtype ck_gamma[MXORDP1]; /* How many phi, phiS, phiQ and phiQS were allocated? */ int ck_phi_alloc; /* Pointer to next structure in list */ struct CkpntMemRec *ck_next; }; /* * ----------------------------------------------------------------- * Type : struct DtpntMemRec * ----------------------------------------------------------------- * This structure contains fields to store all information at a * data point that is needed to interpolate solution of forward * simulations. Its content field is interpType-dependent. * ----------------------------------------------------------------- */ struct DtpntMemRec { realtype t; /* time */ void *content; /* interpType-dependent content */ }; /* Data for cubic Hermite interpolation */ typedef struct HermiteDataMemRec { N_Vector y; N_Vector yd; N_Vector *yS; N_Vector *ySd; } *HermiteDataMem; /* Data for polynomial interpolation */ typedef struct PolynomialDataMemRec { N_Vector y; N_Vector *yS; /* yd and ySd store the derivative(s) only for the first dt point. NULL otherwise. */ N_Vector yd; N_Vector *ySd; int order; } *PolynomialDataMem; /* * ----------------------------------------------------------------- * Type : struct IDABMemRec * ----------------------------------------------------------------- * The type IDABMemRec is a pointer to a structure which stores all * information for ONE backward problem. * The IDAadjMem struct contains a linked list of IDABMem pointers * ----------------------------------------------------------------- */ struct IDABMemRec { /* Index of this backward problem */ int ida_index; /* Time at which the backward problem is initialized. */ realtype ida_t0; /* Memory for this backward problem */ IDAMem IDA_mem; /* Flags to indicate that this backward problem's RHS or quad RHS * require forward sensitivities */ booleantype ida_res_withSensi; booleantype ida_rhsQ_withSensi; /* Residual function for backward run */ IDAResFnB ida_res; IDAResFnBS ida_resS; /* Right hand side quadrature function (fQB) for backward run */ IDAQuadRhsFnB ida_rhsQ; IDAQuadRhsFnBS ida_rhsQS; /* User user_data */ void *ida_user_data; /* Linear solver's data and functions */ /* Memory block for a linear solver's interface to IDAA */ void *ida_lmem; /* Function to free any memory allocated by the linear solver */ int (*ida_lfree)(IDABMem IDAB_mem); /* Memory block for a preconditioner's module interface to IDAA */ void *ida_pmem; /* Function to free any memory allocated by the preconditioner module */ int (*ida_pfree)(IDABMem IDAB_mem); /* Time at which to extract solution / quadratures */ realtype ida_tout; /* Workspace Nvectors */ N_Vector ida_yy; N_Vector ida_yp; /* Link to next structure in list. */ struct IDABMemRec *ida_next; }; /* * ----------------------------------------------------------------- * Type : struct IDAadjMemRec * ----------------------------------------------------------------- * The type IDAadjMem is type pointer to struct IDAadjMemRec. * This structure contins fields to store all information * necessary for adjoint sensitivity analysis. * ----------------------------------------------------------------- */ struct IDAadjMemRec { /* -------------------- * Forward problem data * -------------------- */ /* Integration interval */ realtype ia_tinitial, ia_tfinal; /* Flag for first call to IDASolveF */ booleantype ia_firstIDAFcall; /* Flag if IDASolveF was called with TSTOP */ booleantype ia_tstopIDAFcall; realtype ia_tstopIDAF; /* ---------------------- * Backward problems data * ---------------------- */ /* Storage for backward problems */ struct IDABMemRec *IDAB_mem; /* Number of backward problems. */ int ia_nbckpbs; /* Address of current backward problem (iterator). */ struct IDABMemRec *ia_bckpbCrt; /* Flag for first call to IDASolveB */ booleantype ia_firstIDABcall; /* ---------------- * Check point data * ---------------- */ /* Storage for check point information */ struct CkpntMemRec *ck_mem; /* address of the check point structure for which data is available */ struct CkpntMemRec *ia_ckpntData; /* Number of checkpoints. */ int ia_nckpnts; /* ------------------ * Interpolation data * ------------------ */ /* Number of steps between 2 check points */ long int ia_nsteps; /* Last index used in IDAAfindIndex */ long int ia_ilast; /* Storage for data from forward runs */ struct DtpntMemRec **dt_mem; /* Actual number of data points saved in current dt_mem */ /* Commonly, np = nsteps+1 */ long int ia_np; /* Interpolation type */ int ia_interpType; /* Functions set by the interpolation module */ IDAAStorePntFn ia_storePnt; /* store a new interpolation point */ IDAAGetYFn ia_getY; /* interpolate forward solution */ IDAAMMallocFn ia_malloc; /* allocate new data point */ IDAAMFreeFn ia_free; /* destroys data point */ /* Flags controlling the interpolation module */ booleantype ia_mallocDone; /* IM initialized? */ booleantype ia_newData; /* new data available in dt_mem? */ booleantype ia_storeSensi; /* store sensitivities? */ booleantype ia_interpSensi; /* interpolate sensitivities? */ booleantype ia_noInterp; /* interpolations are temporarly */ /* disabled ( IDACalcICB ) */ /* Workspace for polynomial interpolation */ N_Vector ia_Y[MXORDP1]; /* pointers phi[i] */ N_Vector *ia_YS[MXORDP1]; /* pointers phiS[i] */ realtype ia_T[MXORDP1]; /* Workspace for wrapper functions */ N_Vector ia_yyTmp, ia_ypTmp; N_Vector *ia_yySTmp, *ia_ypSTmp; }; /* * ================================================================= * I N T E R F A C E T O L I N E A R S O L V E R S * ================================================================= */ /* * ----------------------------------------------------------------- * int (*ida_linit)(IDAMem IDA_mem); * ----------------------------------------------------------------- * The purpose of ida_linit is to allocate memory for the * solver-specific fields in the structure *(idamem->ida_lmem) and * perform any needed initializations of solver-specific memory, * such as counters/statistics. An (*ida_linit) should return * 0 if it has successfully initialized the IDA linear solver and * a non-zero value otherwise. If an error does occur, an * appropriate message should be issued. * ---------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lsetup)(IDAMem IDA_mem, N_Vector yyp, N_Vector ypp, * N_Vector resp, N_Vector tempv1, * N_Vector tempv2, N_Vector tempv3); * ----------------------------------------------------------------- * The job of ida_lsetup is to prepare the linear solver for * subsequent calls to ida_lsolve. Its parameters are as follows: * * idamem - problem memory pointer of type IDAMem. See the big * typedef earlier in this file. * * yyp - the predicted y vector for the current IDA internal * step. * * ypp - the predicted y' vector for the current IDA internal * step. * * resp - F(tn, yyp, ypp). * * tempv1, tempv2, tempv3 - temporary N_Vectors provided for use * by ida_lsetup. * * The ida_lsetup routine should return 0 if successful, * a positive value for a recoverable error, and a negative value * for an unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lsolve)(IDAMem IDA_mem, N_Vector b, N_Vector weight, * N_Vector ycur, N_Vector ypcur, N_Vector rescur); * ----------------------------------------------------------------- * ida_lsolve must solve the linear equation P x = b, where * P is some approximation to the system Jacobian * J = (dF/dy) + cj (dF/dy') * evaluated at (tn,ycur,ypcur) and the RHS vector b is input. * The N-vector ycur contains the solver's current approximation * to y(tn), ypcur contains that for y'(tn), and the vector rescur * contains the N-vector residual F(tn,ycur,ypcur). * The solution is to be returned in the vector b. * * The ida_lsolve routine should return 0 if successful, * a positive value for a recoverable error, and a negative value * for an unrecoverable error. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lperf)(IDAMem IDA_mem, int perftask); * ----------------------------------------------------------------- * ida_lperf is called two places in IDAS where linear solver * performance data is required by IDAS. For perftask = 0, an * initialization of performance variables is performed, while for * perftask = 1, the performance is evaluated. * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * int (*ida_lfree)(IDAMem IDA_mem); * ----------------------------------------------------------------- * ida_lfree should free up any memory allocated by the linear * solver. This routine is called once a problem has been * completed and the linear solver is no longer needed. It should * return 0 upon success, nonzero on failure. * ----------------------------------------------------------------- */ /* * ================================================================= * I D A S I N T E R N A L F U N C T I O N S * ================================================================= */ /* Prototype of internal ewtSet function */ int IDAEwtSet(N_Vector ycur, N_Vector weight, void *data); /* High level error handler */ void IDAProcessError(IDAMem IDA_mem, int error_code, const char *module, const char *fname, const char *msgfmt, ...); /* Prototype of internal errHandler function */ void IDAErrHandler(int error_code, const char *module, const char *function, char *msg, void *data); /* Norm functions. Also used for IC, so they are global.*/ realtype IDAWrmsNorm(IDAMem IDA_mem, N_Vector x, N_Vector w, booleantype mask); realtype IDASensWrmsNorm(IDAMem IDA_mem, N_Vector *xS, N_Vector *wS, booleantype mask); realtype IDASensWrmsNormUpdate(IDAMem IDA_mem, realtype old_nrm, N_Vector *xS, N_Vector *wS, booleantype mask); /* Nonlinear solver functions */ int idaNlsInit(IDAMem IDA_mem); int idaNlsInitSensSim(IDAMem IDA_mem); int idaNlsInitSensStg(IDAMem IDA_mem); /* Prototype for internal sensitivity residual DQ function */ int IDASensResDQ(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_dataS, N_Vector ytemp, N_Vector yptemp, N_Vector restemp); /* * ================================================================= * I D A S E R R O R M E S S A G E S * ================================================================= */ #if defined(SUNDIALS_EXTENDED_PRECISION) #define MSG_TIME "t = %Lg, " #define MSG_TIME_H "t = %Lg and h = %Lg, " #define MSG_TIME_INT "t = %Lg is not between tcur - hu = %Lg and tcur = %Lg." #define MSG_TIME_TOUT "tout = %Lg" #define MSG_TIME_TSTOP "tstop = %Lg" #elif defined(SUNDIALS_DOUBLE_PRECISION) #define MSG_TIME "t = %lg, " #define MSG_TIME_H "t = %lg and h = %lg, " #define MSG_TIME_INT "t = %lg is not between tcur - hu = %lg and tcur = %lg." #define MSG_TIME_TOUT "tout = %lg" #define MSG_TIME_TSTOP "tstop = %lg" #else #define MSG_TIME "t = %g, " #define MSG_TIME_H "t = %g and h = %g, " #define MSG_TIME_INT "t = %g is not between tcur - hu = %g and tcur = %g." #define MSG_TIME_TOUT "tout = %g" #define MSG_TIME_TSTOP "tstop = %g" #endif /* General errors */ #define MSG_MEM_FAIL "A memory request failed." #define MSG_NO_MEM "ida_mem = NULL illegal." #define MSG_NO_MALLOC "Attempt to call before IDAMalloc." #define MSG_BAD_NVECTOR "A required vector operation is not implemented." /* Initialization errors */ #define MSG_Y0_NULL "y0 = NULL illegal." #define MSG_YP0_NULL "yp0 = NULL illegal." #define MSG_BAD_ITOL "Illegal value for itol. The legal values are IDA_SS, IDA_SV, and IDA_WF." #define MSG_RES_NULL "res = NULL illegal." #define MSG_BAD_RTOL "rtol < 0 illegal." #define MSG_ATOL_NULL "atol = NULL illegal." #define MSG_BAD_ATOL "Some atol component < 0.0 illegal." #define MSG_ROOT_FUNC_NULL "g = NULL illegal." #define MSG_MISSING_ID "id = NULL but suppressalg option on." #define MSG_NO_TOLS "No integration tolerances have been specified." #define MSG_FAIL_EWT "The user-provide EwtSet function failed." #define MSG_BAD_EWT "Some initial ewt component = 0.0 illegal." #define MSG_Y0_FAIL_CONSTR "y0 fails to satisfy constraints." #define MSG_BAD_ISM_CONSTR "Constraints can not be enforced while forward sensitivity is used with simultaneous method." #define MSG_LSOLVE_NULL "The linear solver's solve routine is NULL." #define MSG_LINIT_FAIL "The linear solver's init routine failed." #define MSG_NLS_INIT_FAIL "The nonlinear solver's init routine failed." #define MSG_NO_QUAD "Illegal attempt to call before calling IDAQuadInit." #define MSG_BAD_EWTQ "Initial ewtQ has component(s) equal to zero (illegal)." #define MSG_BAD_ITOLQ "Illegal value for itolQ. The legal values are IDA_SS and IDA_SV." #define MSG_NO_TOLQ "No integration tolerances for quadrature variables have been specified." #define MSG_NULL_ATOLQ "atolQ = NULL illegal." #define MSG_BAD_RTOLQ "rtolQ < 0 illegal." #define MSG_BAD_ATOLQ "atolQ has negative component(s) (illegal)." #define MSG_NO_SENSI "Illegal attempt to call before calling IDASensInit." #define MSG_BAD_EWTS "Initial ewtS has component(s) equal to zero (illegal)." #define MSG_BAD_ITOLS "Illegal value for itolS. The legal values are IDA_SS, IDA_SV, and IDA_EE." #define MSG_NULL_ATOLS "atolS = NULL illegal." #define MSG_BAD_RTOLS "rtolS < 0 illegal." #define MSG_BAD_ATOLS "atolS has negative component(s) (illegal)." #define MSG_BAD_PBAR "pbar has zero component(s) (illegal)." #define MSG_BAD_PLIST "plist has negative component(s) (illegal)." #define MSG_BAD_NS "NS <= 0 illegal." #define MSG_NULL_YYS0 "yyS0 = NULL illegal." #define MSG_NULL_YPS0 "ypS0 = NULL illegal." #define MSG_BAD_ISM "Illegal value for ism. Legal values are: IDA_SIMULTANEOUS and IDA_STAGGERED." #define MSG_BAD_IS "Illegal value for is." #define MSG_NULL_DKYA "dkyA = NULL illegal." #define MSG_BAD_DQTYPE "Illegal value for DQtype. Legal values are: IDA_CENTERED and IDA_FORWARD." #define MSG_BAD_DQRHO "DQrhomax < 0 illegal." #define MSG_NULL_ABSTOLQS "abstolQS = NULL illegal parameter." #define MSG_BAD_RELTOLQS "reltolQS < 0 illegal parameter." #define MSG_BAD_ABSTOLQS "abstolQS has negative component(s) (illegal)." #define MSG_NO_QUADSENSI "Forward sensitivity analysis for quadrature variables was not activated." #define MSG_NULL_YQS0 "yQS0 = NULL illegal parameter." /* IDACalcIC error messages */ #define MSG_IC_BAD_ICOPT "icopt has an illegal value." #define MSG_IC_BAD_MAXBACKS "maxbacks <= 0 illegal." #define MSG_IC_MISSING_ID "id = NULL conflicts with icopt." #define MSG_IC_TOO_CLOSE "tout1 too close to t0 to attempt initial condition calculation." #define MSG_IC_BAD_ID "id has illegal values." #define MSG_IC_BAD_EWT "Some initial ewt component = 0.0 illegal." #define MSG_IC_RES_NONREC "The residual function failed unrecoverably. " #define MSG_IC_RES_FAIL "The residual function failed at the first call. " #define MSG_IC_SETUP_FAIL "The linear solver setup failed unrecoverably." #define MSG_IC_SOLVE_FAIL "The linear solver solve failed unrecoverably." #define MSG_IC_NO_RECOVERY "The residual routine or the linear setup or solve routine had a recoverable error, but IDACalcIC was unable to recover." #define MSG_IC_FAIL_CONSTR "Unable to satisfy the inequality constraints." #define MSG_IC_FAILED_LINS "The linesearch algorithm failed: step too small or too many backtracks." #define MSG_IC_CONV_FAILED "Newton/Linesearch algorithm failed to converge." /* IDASolve error messages */ #define MSG_YRET_NULL "yret = NULL illegal." #define MSG_YPRET_NULL "ypret = NULL illegal." #define MSG_TRET_NULL "tret = NULL illegal." #define MSG_BAD_ITASK "itask has an illegal value." #define MSG_TOO_CLOSE "tout too close to t0 to start integration." #define MSG_BAD_HINIT "Initial step is not towards tout." #define MSG_BAD_TSTOP "The value " MSG_TIME_TSTOP " is behind current " MSG_TIME "in the direction of integration." #define MSG_CLOSE_ROOTS "Root found at and very near " MSG_TIME "." #define MSG_MAX_STEPS "At " MSG_TIME ", mxstep steps taken before reaching tout." #define MSG_EWT_NOW_FAIL "At " MSG_TIME "the user-provide EwtSet function failed." #define MSG_EWT_NOW_BAD "At " MSG_TIME "some ewt component has become <= 0.0." #define MSG_TOO_MUCH_ACC "At " MSG_TIME "too much accuracy requested." #define MSG_BAD_T "Illegal value for t. " MSG_TIME_INT #define MSG_BAD_TOUT "Trouble interpolating at " MSG_TIME_TOUT ". tout too far back in direction of integration." #define MSG_BAD_K "Illegal value for k." #define MSG_NULL_DKY "dky = NULL illegal." #define MSG_NULL_DKYP "dkyp = NULL illegal." #define MSG_ERR_FAILS "At " MSG_TIME_H "the error test failed repeatedly or with |h| = hmin." #define MSG_CONV_FAILS "At " MSG_TIME_H "the corrector convergence failed repeatedly or with |h| = hmin." #define MSG_SETUP_FAILED "At " MSG_TIME "the linear solver setup failed unrecoverably." #define MSG_SOLVE_FAILED "At " MSG_TIME "the linear solver solve failed unrecoverably." #define MSG_REP_RES_ERR "At " MSG_TIME "repeated recoverable residual errors." #define MSG_RES_NONRECOV "At " MSG_TIME "the residual function failed unrecoverably." #define MSG_FAILED_CONSTR "At " MSG_TIME "unable to satisfy inequality constraints." #define MSG_RTFUNC_FAILED "At " MSG_TIME ", the rootfinding routine failed in an unrecoverable manner." #define MSG_NO_ROOT "Rootfinding was not initialized." #define MSG_INACTIVE_ROOTS "At the end of the first step, there are still some root functions identically 0. This warning will not be issued again." #define MSG_NLS_INPUT_NULL "At " MSG_TIME "the nonlinear solver was passed a NULL input." #define MSG_NLS_SETUP_FAILED "At " MSG_TIME "the nonlinear solver setup failed unrecoverably." #define MSG_EWTQ_NOW_BAD "At " MSG_TIME ", a component of ewtQ has become <= 0." #define MSG_QRHSFUNC_FAILED "At " MSG_TIME ", the quadrature right-hand side routine failed in an unrecoverable manner." #define MSG_QRHSFUNC_UNREC "At " MSG_TIME ", the quadrature right-hand side failed in a recoverable manner, but no recovery is possible." #define MSG_QRHSFUNC_REPTD "At " MSG_TIME "repeated recoverable quadrature right-hand side function errors." #define MSG_QRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." #define MSG_NULL_P "p = NULL when using internal DQ for sensitivity residual is illegal." #define MSG_EWTS_NOW_BAD "At " MSG_TIME ", a component of ewtS has become <= 0." #define MSG_SRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity residual routine failed in an unrecoverable manner." #define MSG_SRHSFUNC_UNREC "At " MSG_TIME ", the sensitivity residual failed in a recoverable manner, but no recovery is possible." #define MSG_SRHSFUNC_REPTD "At " MSG_TIME "repeated recoverable sensitivity residual function errors." #define MSG_NO_TOLQS "No integration tolerances for quadrature sensitivity variables have been specified." #define MSG_NULL_RHSQ "IDAS is expected to use DQ to evaluate the RHS of quad. sensi., but quadratures were not initialized." #define MSG_BAD_EWTQS "Initial ewtQS has component(s) equal to zero (illegal)." #define MSG_EWTQS_NOW_BAD "At " MSG_TIME ", a component of ewtQS has become <= 0." #define MSG_QSRHSFUNC_FAILED "At " MSG_TIME ", the sensitivity quadrature right-hand side routine failed in an unrecoverable manner." #define MSG_QSRHSFUNC_FIRST "The quadrature right-hand side routine failed at the first call." /* IDASet* / IDAGet* error messages */ #define MSG_NEG_MAXORD "maxord<=0 illegal." #define MSG_BAD_MAXORD "Illegal attempt to increase maximum order." #define MSG_NEG_HMAX "hmax < 0 illegal." #define MSG_NEG_EPCON "epcon <= 0.0 illegal." #define MSG_BAD_CONSTR "Illegal values in constraints vector." #define MSG_BAD_EPICCON "epiccon <= 0.0 illegal." #define MSG_BAD_MAXNH "maxnh <= 0 illegal." #define MSG_BAD_MAXNJ "maxnj <= 0 illegal." #define MSG_BAD_MAXNIT "maxnit <= 0 illegal." #define MSG_BAD_STEPTOL "steptol <= 0.0 illegal." #define MSG_TOO_LATE "IDAGetConsistentIC can only be called before IDASolve." /* * ================================================================= * I D A A E R R O R M E S S A G E S * ================================================================= */ #define MSGAM_NULL_IDAMEM "ida_mem = NULL illegal." #define MSGAM_NO_ADJ "Illegal attempt to call before calling IDAadjInit." #define MSGAM_BAD_INTERP "Illegal value for interp." #define MSGAM_BAD_STEPS "Steps nonpositive illegal." #define MSGAM_BAD_WHICH "Illegal value for which." #define MSGAM_NO_BCK "No backward problems have been defined yet." #define MSGAM_NO_FWD "Illegal attempt to call before calling IDASolveF." #define MSGAM_BAD_TB0 "The initial time tB0 is outside the interval over which the forward problem was solved." #define MSGAM_BAD_SENSI "At least one backward problem requires sensitivities, but they were not stored for interpolation." #define MSGAM_BAD_ITASKB "Illegal value for itaskB. Legal values are IDA_NORMAL and IDA_ONE_STEP." #define MSGAM_BAD_TBOUT "The final time tBout is outside the interval over which the forward problem was solved." #define MSGAM_BACK_ERROR "Error occured while integrating backward problem # %d" #define MSGAM_BAD_TINTERP "Bad t = %g for interpolation." #define MSGAM_BAD_T "Bad t for interpolation." #define MSGAM_WRONG_INTERP "This function cannot be called for the specified interp type." #define MSGAM_MEM_FAIL "A memory request failed." #define MSGAM_NO_INITBS "Illegal attempt to call before calling IDAInitBS." #ifdef __cplusplus } #endif #endif StanHeaders/src/idas/idas_nls_stg.c0000644000176200001440000002733413766554457017036 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This the implementation file for the IDA nonlinear solver interface. * ---------------------------------------------------------------------------*/ #include "idas_impl.h" #include "sundials/sundials_math.h" #include "sundials/sundials_nvector_senswrapper.h" /* constant macros */ #define PT0001 RCONST(0.0001) /* real 0.0001 */ #define ONE RCONST(1.0) /* real 1.0 */ #define TWENTY RCONST(20.0) /* real 20.0 */ /* nonlinear solver parameters */ #define MAXIT 4 /* default max number of nonlinear iterations */ #define RATEMAX RCONST(0.9) /* max convergence rate used in divergence check */ /* private functions passed to nonlinear solver */ static int idaNlsResidualSensStg(N_Vector ycor, N_Vector res, void* ida_mem); static int idaNlsLSetupSensStg(N_Vector ycor, N_Vector res, booleantype jbad, booleantype* jcur, void* ida_mem); static int idaNlsLSolveSensStg(N_Vector ycor, N_Vector delta, void* ida_mem); static int idaNlsConvTestSensStg(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem); /* ----------------------------------------------------------------------------- * Exported functions * ---------------------------------------------------------------------------*/ int IDASetNonlinearSolverSensStg(void *ida_mem, SUNNonlinearSolver NLS) { IDAMem IDA_mem; int retval, is; /* return immediately if IDA memory is NULL */ if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "IDASetNonlinearSolverSensStg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* return immediately if NLS memory is NULL */ if (NLS == NULL) { IDAProcessError(NULL, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "NLS must be non-NULL"); return(IDA_ILL_INPUT); } /* check for required nonlinear solver functions */ if ( NLS->ops->gettype == NULL || NLS->ops->initialize == NULL || NLS->ops->solve == NULL || NLS->ops->free == NULL || NLS->ops->setsysfn == NULL ) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "NLS does not support required operations"); return(IDA_ILL_INPUT); } /* check for allowed nonlinear solver types */ if (SUNNonlinSolGetType(NLS) != SUNNONLINEARSOLVER_ROOTFIND) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "NLS type must be SUNNONLINEARSOLVER_ROOTFIND"); return(IDA_ILL_INPUT); } /* check that sensitivities were initialized */ if (!(IDA_mem->ida_sensi)) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", MSG_NO_SENSI); return(IDA_ILL_INPUT); } /* check that the staggered corrector was selected */ if (IDA_mem->ida_ism != IDA_STAGGERED) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "Sensitivity solution method is not IDA_STAGGERED"); return(IDA_ILL_INPUT); } /* free any existing nonlinear solver */ if ((IDA_mem->NLSstg != NULL) && (IDA_mem->ownNLSstg)) retval = SUNNonlinSolFree(IDA_mem->NLSstg); /* set SUNNonlinearSolver pointer */ IDA_mem->NLSstg = NLS; /* Set NLS ownership flag. If this function was called to attach the default NLS, IDA will set the flag to SUNTRUE after this function returns. */ IDA_mem->ownNLSstg = SUNFALSE; /* set the nonlinear residual function */ retval = SUNNonlinSolSetSysFn(IDA_mem->NLSstg, idaNlsResidualSensStg); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "Setting nonlinear system function failed"); return(IDA_ILL_INPUT); } /* set convergence test function */ retval = SUNNonlinSolSetConvTestFn(IDA_mem->NLSstg, idaNlsConvTestSensStg); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "Setting convergence test function failed"); return(IDA_ILL_INPUT); } /* set max allowed nonlinear iterations */ retval = SUNNonlinSolSetMaxIters(IDA_mem->NLSstg, MAXIT); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "IDASetNonlinearSolverSensStg", "Setting maximum number of nonlinear iterations failed"); return(IDA_ILL_INPUT); } /* create vector wrappers if necessary */ if (IDA_mem->stgMallocDone == SUNFALSE) { IDA_mem->ycor0Stg = N_VNewEmpty_SensWrapper(IDA_mem->ida_Ns); if (IDA_mem->ycor0Stg == NULL) { IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASetNonlinearSolverSensStg", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ycorStg = N_VNewEmpty_SensWrapper(IDA_mem->ida_Ns); if (IDA_mem->ycorStg == NULL) { N_VDestroy(IDA_mem->ycor0Stg); IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASetNonlinearSolverSensStg", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->ewtStg = N_VNewEmpty_SensWrapper(IDA_mem->ida_Ns); if (IDA_mem->ewtStg == NULL) { N_VDestroy(IDA_mem->ycor0Stg); N_VDestroy(IDA_mem->ycorStg); IDAProcessError(IDA_mem, IDA_MEM_FAIL, "IDAS", "IDASetNonlinearSolverSensStg", MSG_MEM_FAIL); return(IDA_MEM_FAIL); } IDA_mem->stgMallocDone = SUNTRUE; } /* attach vectors to vector wrappers */ for (is=0; is < IDA_mem->ida_Ns; is++) { NV_VEC_SW(IDA_mem->ycor0Stg, is) = IDA_mem->ida_deltaS[is]; NV_VEC_SW(IDA_mem->ycorStg, is) = IDA_mem->ida_eeS[is]; NV_VEC_SW(IDA_mem->ewtStg, is) = IDA_mem->ida_ewtS[is]; } return(IDA_SUCCESS); } /* ----------------------------------------------------------------------------- * Private functions * ---------------------------------------------------------------------------*/ int idaNlsInitSensStg(IDAMem IDA_mem) { int retval; /* set the linear solver setup wrapper function */ if (IDA_mem->ida_lsetup) retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLSstg, idaNlsLSetupSensStg); else retval = SUNNonlinSolSetLSetupFn(IDA_mem->NLSstg, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInitSensStg", "Setting the linear solver setup function failed"); return(IDA_NLS_INIT_FAIL); } /* set the linear solver solve wrapper function */ if (IDA_mem->ida_lsolve) retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLSstg, idaNlsLSolveSensStg); else retval = SUNNonlinSolSetLSolveFn(IDA_mem->NLSstg, NULL); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInitSensStg", "Setting linear solver solve function failed"); return(IDA_NLS_INIT_FAIL); } /* initialize nonlinear solver */ retval = SUNNonlinSolInitialize(IDA_mem->NLSstg); if (retval != IDA_SUCCESS) { IDAProcessError(IDA_mem, IDA_ILL_INPUT, "IDAS", "idaNlsInitSensStg", MSG_NLS_INIT_FAIL); return(IDA_NLS_INIT_FAIL); } return(IDA_SUCCESS); } static int idaNlsLSetupSensStg(N_Vector ycorStg, N_Vector resStg, booleantype jbad, booleantype* jcur, void* ida_mem) { IDAMem IDA_mem; int retval; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsLSetupSensStg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; IDA_mem->ida_nsetupsS++; retval = IDA_mem->ida_lsetup(IDA_mem, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_delta, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); /* update Jacobian status */ *jcur = SUNTRUE; /* update convergence test constants */ IDA_mem->ida_cjold = IDA_mem->ida_cj; IDA_mem->ida_cjratio = ONE; IDA_mem->ida_ss = TWENTY; IDA_mem->ida_ssS = TWENTY; if (retval < 0) return(IDA_LSETUP_FAIL); if (retval > 0) return(IDA_LSETUP_RECVR); return(IDA_SUCCESS); } static int idaNlsLSolveSensStg(N_Vector ycorStg, N_Vector deltaStg, void* ida_mem) { IDAMem IDA_mem; int retval, is; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsLSolveSensStg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; for(is=0;isida_Ns;is++) { retval = IDA_mem->ida_lsolve(IDA_mem, NV_VEC_SW(deltaStg,is), IDA_mem->ida_ewtS[is], IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_delta); if (retval < 0) return(IDA_LSOLVE_FAIL); if (retval > 0) return(IDA_LSOLVE_RECVR); } return(IDA_SUCCESS); } static int idaNlsResidualSensStg(N_Vector ycorStg, N_Vector resStg, void* ida_mem) { IDAMem IDA_mem; int retval; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsResidualSensStg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* update yS and ypS based on the current correction */ N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_yySpredict, ONE, NV_VECS_SW(ycorStg), IDA_mem->ida_yyS); N_VLinearSumVectorArray(IDA_mem->ida_Ns, ONE, IDA_mem->ida_ypSpredict, IDA_mem->ida_cj, NV_VECS_SW(ycorStg), IDA_mem->ida_ypS); /* evaluate sens residual */ retval = IDA_mem->ida_resS(IDA_mem->ida_Ns, IDA_mem->ida_tn, IDA_mem->ida_yy, IDA_mem->ida_yp, IDA_mem->ida_delta, IDA_mem->ida_yyS, IDA_mem->ida_ypS, NV_VECS_SW(resStg), IDA_mem->ida_user_dataS, IDA_mem->ida_tmpS1, IDA_mem->ida_tmpS2, IDA_mem->ida_tmpS3); /* increment the number of sens residual evaluations */ IDA_mem->ida_nrSe++; if (retval < 0) return(IDA_SRES_FAIL); if (retval > 0) return(IDA_SRES_RECVR); return(IDA_SUCCESS); } static int idaNlsConvTestSensStg(SUNNonlinearSolver NLS, N_Vector ycor, N_Vector del, realtype tol, N_Vector ewt, void* ida_mem) { IDAMem IDA_mem; int m, retval; realtype delnrm; realtype rate; if (ida_mem == NULL) { IDAProcessError(NULL, IDA_MEM_NULL, "IDAS", "idaNlsConvTestSensStg", MSG_NO_MEM); return(IDA_MEM_NULL); } IDA_mem = (IDAMem) ida_mem; /* compute the norm of the correction */ delnrm = N_VWrmsNorm(del, ewt); /* get the current nonlinear solver iteration count */ retval = SUNNonlinSolGetCurIter(NLS, &m); if (retval != IDA_SUCCESS) return(IDA_MEM_NULL); /* test for convergence, first directly, then with rate estimate. */ if (m == 0){ IDA_mem->ida_oldnrm = delnrm; if (delnrm <= IDA_mem->ida_toldel) return(SUN_NLS_SUCCESS); } else { rate = SUNRpowerR( delnrm/IDA_mem->ida_oldnrm, ONE/m ); if (rate > RATEMAX) return(SUN_NLS_CONV_RECVR); IDA_mem->ida_ssS = rate/(ONE - rate); } if (IDA_mem->ida_ssS*delnrm <= tol) return(SUN_NLS_SUCCESS); /* not yet converged */ return(SUN_NLS_CONTINUE); } StanHeaders/src/sundials/0000755000176200001440000000000013766554456015111 5ustar liggesusersStanHeaders/src/sundials/sundials_mpi.c0000644000176200001440000000450413766554457017750 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is implementation of SUNDIALS MPI wrapper functions. * -----------------------------------------------------------------*/ #include int SUNMPI_Comm_size(SUNMPI_Comm comm, int *size) { #if SUNDIALS_MPI_ENABLED return MPI_Comm_size(comm, size); #else *size = 1; return 0; #endif } realtype SUNMPI_Allreduce_scalar(realtype d, int op, SUNMPI_Comm comm) { /* * This function does a global reduction. The operation is * sum if op = 1, * max if op = 2, * min if op = 3. * The operation is over all processors in the communicator */ #if SUNDIALS_MPI_ENABLED realtype out; switch (op) { case 1: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_SUM, comm); break; case 2: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MAX, comm); break; case 3: MPI_Allreduce(&d, &out, 1, PVEC_REAL_MPI_TYPE, MPI_MIN, comm); break; default: break; } return(out); #else /* If MPI is not enabled don't do reduction */ return d; #endif /* ifdef SUNDIALS_MPI_ENABLED */ } void SUNMPI_Allreduce(realtype *d, int nvec, int op, SUNMPI_Comm comm) { /* * This function does a global reduction. The operation is * sum if op = 1, * max if op = 2, * min if op = 3. * The operation is over all processors in the communicator */ #if SUNDIALS_MPI_ENABLED switch (op) { case 1: MPI_Allreduce(MPI_IN_PLACE, d, nvec, PVEC_REAL_MPI_TYPE, MPI_SUM, comm); break; case 2: MPI_Allreduce(MPI_IN_PLACE, d, nvec, PVEC_REAL_MPI_TYPE, MPI_MAX, comm); break; case 3: MPI_Allreduce(MPI_IN_PLACE, d, nvec, PVEC_REAL_MPI_TYPE, MPI_MIN, comm); break; default: break; } #else /* If MPI is not enabled don't do reduction */ #endif /* ifdef SUNDIALS_MPI_ENABLED */ } StanHeaders/src/sundials/sundials_version.c0000644000176200001440000000270513766554457020651 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This file implements functions for getting SUNDIALS version * information. * -----------------------------------------------------------------*/ #include #include /* fill string with SUNDIALS version information */ int SUNDIALSGetVersion(char *version, int len) { if (strlen(SUNDIALS_VERSION) > len) { return(-1); } strncpy(version, SUNDIALS_VERSION, len); return(0); } /* fill integers with SUNDIALS major, minor, and patch release numbers and fill a string with the release label */ int SUNDIALSGetVersionNumber(int *major, int *minor, int *patch, char *label, int len) { if (strlen(SUNDIALS_VERSION_LABEL) > len) { return(-1); } *major = SUNDIALS_VERSION_MAJOR; *minor = SUNDIALS_VERSION_MINOR; *patch = SUNDIALS_VERSION_PATCH; strncpy(label, SUNDIALS_VERSION_LABEL, len); return(0); } StanHeaders/src/sundials/sundials_sparse.c0000644000176200001440000005213113766554457020457 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmers: Carol Woodward, Slaven Peles @ LLNL * Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for operations on the SUNDIALS * sparse matrix structure. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ================================================================== * Private function prototypes (functions working on SlsMat) * ================================================================== */ /* * ----------------------------------------------------------------- * Functions: SparseMatvecCSC * ----------------------------------------------------------------- * This function computes the matrix-vector product, y=A*x, where A * is a CSC sparse matrix of dimension MxN, x is a realtype array of * length N, and y is a realtype array of length M. Upon successful * completion, the return value is zero; otherwise 1 is returned. * ----------------------------------------------------------------- */ static int SparseMatvecCSC(const SlsMat A, const realtype *x, realtype *y); /* * ----------------------------------------------------------------- * Functions: SparseMatvecCSR * ----------------------------------------------------------------- * This function computes the matrix-vector product, y=A*x, where A * is a CSR sparse matrix of dimension MxN, x is a realtype array of * length N, and y is a realtype array of length M. Upon successful * completion, the return value is zero; otherwise 1 is returned. * ----------------------------------------------------------------- */ static int SparseMatvecCSR(const SlsMat A, const realtype *x, realtype *y); /* * ================================================================== * Implementation of sparse matrix methods (functions on SlsMat) * ================================================================== */ /* * Default Constructor * * Creates a new (empty) sparse matrix of a desired size and nonzero density. * Returns NULL if a memory allocation error occurred. * */ SlsMat SparseNewMat(int M, int N, int NNZ, int sparsetype) { SlsMat A; if ( (M <= 0) || (N <= 0) ) return(NULL); A = NULL; A = (SlsMat) malloc(sizeof(struct _SlsMat)); if (A==NULL) return (NULL); A->sparsetype = sparsetype; switch(A->sparsetype){ case CSC_MAT: A->NP = N; A->rowvals = &(A->indexvals); A->colptrs = &(A->indexptrs); /* CSR indices */ A->colvals = NULL; A->rowptrs = NULL; break; case CSR_MAT: A->NP = M; A->colvals = &(A->indexvals); A->rowptrs = &(A->indexptrs); /* CSC indices */ A->rowvals = NULL; A->colptrs = NULL; break; default: free(A); A = NULL; return(NULL); } A->data = (realtype *) malloc(NNZ * sizeof(realtype)); if (A->data == NULL) { free(A); A = NULL; return(NULL); } A->indexvals = (int *) malloc(NNZ * sizeof(int)); if (A->indexvals == NULL) { free(A->data); A->data = NULL; free(A); A = NULL; return(NULL); } A->indexptrs = (int *) malloc((A->NP + 1) * sizeof(int)); if (A->indexptrs == NULL) { free(A->indexvals); free(A->data); A->data = NULL; free(A); A = NULL; return(NULL); } A->M = M; A->N = N; A->NNZ = NNZ; /* A->colptrs[N] = NNZ; */ A->indexptrs[A->NP] = 0; return(A); } /** * Constructor * * Creates a new sparse matrix out of an existing dense or band matrix. * Returns NULL if a memory allocation error occurred. * */ SlsMat SparseFromDenseMat(const DlsMat Ad, int sparsetype) { int i, j, nnz; int M, N; realtype dtmp; SlsMat As = NULL; switch(sparsetype) { case CSC_MAT: /* CSC is transpose of CSR */ M = Ad->N; N = Ad->M; break; case CSR_MAT: M = Ad->M; N = Ad->N; break; default: /* Sparse matrix type not recognized */ return NULL; } /* proceed according to A's type (dense/band) */ if (Ad->type == SUNDIALS_DENSE) { /* determine total number of nonzeros */ nnz = 0; for (j=0; jN; j++) for (i=0; iM; i++) nnz += (DENSE_ELEM(Ad,i,j) != 0.0); /* allocate sparse matrix */ As = SparseNewMat(Ad->M, Ad->N, nnz, sparsetype); if (As == NULL) return NULL; /* copy nonzeros from A into As */ nnz = 0; for (i=0; iindexptrs)[i] = nnz; for (j=0; jindexvals)[nnz] = j; As->data[nnz++] = dtmp; } } } (As->indexptrs)[M] = nnz; } else { /* SUNDIALS_BAND */ /* determine total number of nonzeros */ nnz = 0; for (j=0; jN; j++) for (i=j-(Ad->mu); iml); i++) nnz += (BAND_ELEM(Ad,i,j) != 0.0); /* allocate sparse matrix */ As = SparseNewMat(Ad->M, Ad->N, nnz, sparsetype); if (As == NULL) return NULL; /* copy nonzeros from A into As */ nnz = 0; for (i=0; iindexptrs)[i] = nnz; for (j=i-(Ad->mu); jml); j++) { /* CSR = row major looping; CSC = column major looping */ dtmp = (sparsetype == CSR_MAT) ? BAND_ELEM(Ad,i,j) : BAND_ELEM(Ad,j,i); if ( dtmp != 0.0 ) { (As->indexvals)[nnz] = j; As->data[nnz++] = dtmp; } } } (As->indexptrs)[M] = nnz; } return(As); } /** * * Destructor * * Frees memory and deletes the structure for an existing sparse matrix. * */ int SparseDestroyMat(SlsMat A) { if (A->data) { free(A->data); A->data = NULL; } if (A->indexvals) { free(A->indexvals); A->indexvals = NULL; A->rowvals = NULL; A->colvals = NULL; } if (A->indexptrs) { free(A->indexptrs); A->indexptrs = NULL; A->colptrs = NULL; A->rowptrs = NULL; } free(A); A = NULL; return 0; } /** * Sets all sparse matrix entries to zero. */ int SparseSetMatToZero(SlsMat A) { int i; for (i=0; iNNZ; i++) { A->data[i] = ZERO; A->indexvals[i] = 0; } for (i=0; iNP; i++) { A->indexptrs[i] = 0; } /* A->colptrs[A->N] = A->NNZ; */ A->indexptrs[A->NP] = 0; return 0; } /** * Copies the sparse matrix A into sparse matrix B. * * It is assumed that A and B have the same dimensions, but we account * for the situation in which B has fewer nonzeros than A. * */ int SparseCopyMat(const SlsMat A, SlsMat B) { int i; int A_nz = A->indexptrs[A->NP]; if(A->M != B->M || A->N != B->N) { /* STAN_SUNDIALS_FPRINTF(stderr, "Error: Copying sparse matrices of different size!\n"); */ return (-1); } /* ensure B is of the same type as A */ B->sparsetype = A->sparsetype; /* ensure that B is allocated with at least as much memory as we have nonzeros in A */ if (B->NNZ < A_nz) { B->indexvals = (int *) realloc(B->indexvals, A_nz*sizeof(int)); B->data = (realtype *) realloc(B->data, A_nz*sizeof(realtype)); B->NNZ = A_nz; } /* zero out B so that copy works correctly */ SparseSetMatToZero(B); /* copy the data and row indices over */ for (i=0; idata[i] = A->data[i]; B->indexvals[i] = A->indexvals[i]; } /* copy the column pointers over */ for (i=0; iNP; i++) { B->indexptrs[i] = A->indexptrs[i]; } B->indexptrs[A->NP] = A_nz; return 0; } /** * Scales a sparse matrix A by the coefficient b. */ int SparseScaleMat(realtype b, SlsMat A) { int i; for (i=0; iindexptrs[A->NP]; i++){ A->data[i] = b * (A->data[i]); } return 0; } /** * Adds 1 to every diagonal entry of A. * * Works for general [rectangular] matrices and handles potentially increased * size if A does not currently contain a value on the diagonal. * * The function was developed originally for CSC matrices. To make it work for * CSR, one simply need to transpose it, i.e. transpose M and N in the * implementation. * */ int SparseAddIdentityMat(SlsMat A) { int j, i, p, nz, newmat, found; int *w, *Ap, *Ai, *Cp, *Ci; realtype *x, *Ax, *Cx; SlsMat C; int M; int N; /* determine if A already contains values on the diagonal (hence memory allocation necessary)*/ newmat=0; for (j=0; j < SUNMIN(A->N,A->M); j++) { /* scan column (row if CSR) of A, searching for diagonal value */ found = 0; for (i=A->indexptrs[j]; iindexptrs[j+1]; i++) { if (A->indexvals[i] == j) { found = 1; break; } } /* if no diagonal found, signal new matrix */ if (!found) { newmat=1; break; } } /* perform operation */ /* case 1: A already contains a diagonal */ if (!newmat) { /* iterate through columns, adding 1.0 to diagonal */ for (j=0; j < SUNMIN(A->N,A->M); j++) for (i=A->indexptrs[j]; iindexptrs[j+1]; i++) if (A->indexvals[i] == j) A->data[i] += ONE; /* case 2: A does not already contain a diagonal */ } else { if (A->sparsetype == CSC_MAT) { M = A->M; N = A->N; } else if (A->sparsetype == CSR_MAT) { M = A->N; N = A->M; } else return (-1); /* create work arrays for row indices and nonzero column values */ w = (int *) malloc(A->M * sizeof(int)); x = (realtype *) malloc(A->M * sizeof(realtype)); /* create new matrix for sum (overestimate nnz as sum of each) */ C = SparseNewMat(A->M, A->N, (A->indexptrs)[A->NP] + SUNMIN(A->M, A->N), A->sparsetype); /* access data from CSR structures (return if failure) */ Cp = Ci = Ap = Ai = NULL; Cx = Ax = NULL; if (C->indexptrs) Cp = C->indexptrs; else return (-1); if (C->indexvals) Ci = C->indexvals; else return (-1); if (C->data) Cx = C->data; else return (-1); if (A->indexptrs) Ap = A->indexptrs; else return (-1); if (A->indexvals) Ai = A->indexvals; else return (-1); if (A->data) Ax = A->data; else return (-1); /* initialize total nonzero count */ nz = 0; /* iterate through columns (rows for CSR) */ for (j=0; j 0 ) { Ci[nz] = i; Cx[nz++] = x[i]; } } } /* indicate end of data */ Cp[N] = nz; /* update A's structure with C's values; nullify C's pointers */ A->NNZ = C->NNZ; if (A->data) free(A->data); A->data = C->data; C->data = NULL; if (A->indexvals) free(A->indexvals); A->indexvals = C->indexvals; C->indexvals = NULL; if (A->indexptrs) free(A->indexptrs); A->indexptrs = C->indexptrs; C->indexptrs = NULL; /* clean up */ SparseDestroyMat(C); free(w); free(x); /* reallocate the new matrix to remove extra space */ SparseReallocMat(A); } return 0; } /** * Add two sparse matrices: A = A+B. * * Handles potentially increased size if matrices have different sparsity patterns. * Returns 0 if successful, and 1 if unsuccessful (in which case A is left unchanged). * * The function was developed originally for CSC matrices. To make it work for * CSR, one simply need to transpose it, i.e. transpose M and N in the * implementation. * */ int SparseAddMat(SlsMat A, const SlsMat B) { int j, i, p, nz, newmat; int *w, *Ap, *Ai, *Bp, *Bi, *Cp, *Ci; realtype *x, *Ax, *Bx, *Cx; SlsMat C; int M; int N; /* ensure that matrix dimensions agree */ if ((A->M != B->M) || (A->N != B->N)) { /* STAN_SUNDIALS_FPRINTF(stderr, "Error: Adding sparse matrices of different size!\n"); */ return(-1); } /* if A is CSR matrix, transpose M and N */ if (A->sparsetype == CSC_MAT) { M = A->M; N = A->N; } else if (A->sparsetype == CSR_MAT) { M = A->N; N = A->M; } else return(-1); /* create work arrays for row indices and nonzero column values */ w = (int *) malloc(M * sizeof(int)); x = (realtype *) malloc(M * sizeof(realtype)); /* determine if A already contains the sparsity pattern of B */ newmat=0; for (j=0; jindexptrs[j]; iindexptrs[j+1]; i++) w[A->indexvals[i]] += 1; /* scan column of B, decrementing w by one */ for (i=B->indexptrs[j]; iindexptrs[j+1]; i++) w[B->indexvals[i]] -= 1; /* if any entry of w is negative, A doesn't contain B's sparsity */ for (i=0; iindexptrs[j]; i < B->indexptrs[j+1]; i++) x[B->indexvals[i]] = B->data[i]; /* scan column of A, updating entries appropriately array */ for (i = A->indexptrs[j]; i < A->indexptrs[j+1]; i++) A->data[i] += x[A->indexvals[i]]; } /* case 2: A does not already contain B's sparsity */ } else { /* create new matrix for sum (overestimate nnz as sum of each) */ C = SparseNewMat(M, N, (A->indexptrs[N])+(B->indexptrs[N]), A->sparsetype); /* access data from CSR structures (return if failure) */ Cp = Ci = Ap = Ai = Bp = Bi = NULL; Cx = Ax = Bx = NULL; if (C->indexptrs) Cp = C->indexptrs; else return(-1); if (C->indexvals) Ci = C->indexvals; else return(-1); if (C->data) Cx = C->data; else return(-1); if (A->indexptrs) Ap = (A->indexptrs); else return(-1); if (A->indexvals) Ai = (A->indexvals); else return(-1); if (A->data) Ax = A->data; else return(-1); if (B->indexptrs) Bp = B->indexptrs; else return(-1); if (B->indexvals) Bi = B->indexvals; else return(-1); if (B->data) Bx = B->data; else return(-1); /* initialize total nonzero count */ nz = 0; /* iterate through columns */ for (j=0; j 0 ) { Ci[nz] = i; Cx[nz++] = x[i]; } } } /* indicate end of data */ Cp[N] = nz; /* update A's structure with C's values; nullify C's pointers */ A->NNZ = C->NNZ; free(A->data); A->data = C->data; C->data = NULL; free(A->indexvals); A->indexvals = C->indexvals; C->indexvals = NULL; free(A->indexptrs); A->indexptrs = C->indexptrs; C->indexptrs = NULL; /* clean up */ SparseDestroyMat(C); /* reallocate the new matrix to remove extra space */ SparseReallocMat(A); } /* clean up */ free(w); free(x); /* return success */ return(0); } /** * Resizes the memory allocated for a given sparse matrix, shortening * it down to the number of actual nonzero entries. */ int SparseReallocMat(SlsMat A) { int nzmax; nzmax = A->indexptrs[A->NP]; A->indexvals = (int *) realloc(A->indexvals, nzmax*sizeof(int)); A->data = (realtype *) realloc(A->data, nzmax*sizeof(realtype)); A->NNZ = nzmax; return 0; } /** * Computes y=A*x, where A is a sparse matrix of dimension MxN, x is a * realtype array of length N, and y is a realtype array of length M. * * Returns 0 if successful, -1 if unsuccessful (failed memory access). */ int SparseMatvec(const SlsMat A, const realtype *x, realtype *y) { if(A->sparsetype == CSC_MAT) return SparseMatvecCSC(A, x, y); else if (A->sparsetype == CSR_MAT) return SparseMatvecCSR(A, x, y); else return(-1); } /** * Prints the nonzero entries of a sparse matrix to screen. */ void SparsePrintMat(const SlsMat A, FILE* outfile) { int i,j, NNZ; char *matrixtype; char *indexname; NNZ = A->NNZ; switch(A->sparsetype) { case CSC_MAT: indexname = (char*) "col"; matrixtype = (char*) "CSC"; break; case CSR_MAT: indexname = (char*) "row"; matrixtype = (char*) "CSR"; break; default: /* Sparse matrix type not recognized */ return; } STAN_SUNDIALS_FPRINTF(outfile, "\n"); STAN_SUNDIALS_FPRINTF(outfile, "%d by %d %s matrix, NNZ: %d \n", A->M, A->N, matrixtype, NNZ); for (j=0; j < A->NP; j++) { STAN_SUNDIALS_FPRINTF(outfile, "%s %d : locations %d to %d\n", indexname, j, (A->indexptrs)[j], (A->indexptrs)[j+1]-1); STAN_SUNDIALS_FPRINTF(outfile, " "); for (i = (A->indexptrs)[j]; i < (A->indexptrs)[j+1]; i++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%d: %Lg ", A->indexvals[i], A->data[i]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%d: %g ", A->indexvals[i], A->data[i]); #else STAN_SUNDIALS_FPRINTF(outfile, "%d: %g ", A->indexvals[i], A->data[i]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); } STAN_SUNDIALS_FPRINTF(outfile, "\n"); } /* * ================================================================== * Private function definitions * ================================================================== */ /** * Computes y=A*x, where A is a CSC matrix of dimension MxN, x is a * realtype array of length N, and y is a realtype array of length M. * * Returns 0 if successful, -1 if unsuccessful (failed memory access). */ int SparseMatvecCSC(const SlsMat A, const realtype *x, realtype *y) { int j, i; int *Ap, *Ai; realtype *Ax; /* access data from CSR structure (return if failure) */ if (*A->colptrs) Ap = A->indexptrs; else return(-1); if (*A->rowvals) Ai = A->indexvals; else return(-1); if (A->data) Ax = A->data; else return(-1); /* ensure that vectors are non-NULL */ if ((x == NULL) || (y == NULL)) return(-1); /* initialize result */ for (i=0; iM; i++) y[i] = 0.0; /* iterate through matrix columns */ for (j=0; jN; j++) { /* iterate down column of A, performing product */ for (i=Ap[j]; irowptrs) Ap = A->indexptrs; else return(-1); if (*A->colvals) Aj = A->indexvals; else return(-1); if (A->data) Ax = A->data; else return(-1); /* ensure that vectors are non-NULL */ if ((x == NULL) || (y == NULL)) return(-1); /* initialize result */ for (i=0; iM; i++) y[i] = 0.0; /* iterate through matrix rows */ for (i=0; iM; ++i) { /* iterate along row of A, performing product */ for (j=Ap[i]; j #include #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : SpbcgMalloc * ----------------------------------------------------------------- */ SpbcgMem SpbcgMalloc(int l_max, N_Vector vec_tmpl) { SpbcgMem mem; N_Vector r_star, r, p, q, u, Ap, vtemp; /* Check the input parameters */ if (l_max <= 0) return(NULL); /* Get arrays to hold temporary vectors */ r_star = N_VClone(vec_tmpl); if (r_star == NULL) { return(NULL); } r = N_VClone(vec_tmpl); if (r == NULL) { N_VDestroy(r_star); return(NULL); } p = N_VClone(vec_tmpl); if (p == NULL) { N_VDestroy(r_star); N_VDestroy(r); return(NULL); } q = N_VClone(vec_tmpl); if (q == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); return(NULL); } u = N_VClone(vec_tmpl); if (u == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); return(NULL); } Ap = N_VClone(vec_tmpl); if (Ap == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); N_VDestroy(u); return(NULL); } vtemp = N_VClone(vec_tmpl); if (vtemp == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); N_VDestroy(u); N_VDestroy(Ap); return(NULL); } /* Get memory for an SpbcgMemRec containing SPBCG matrices and vectors */ mem = NULL; mem = (SpbcgMem) malloc(sizeof(SpbcgMemRec)); if (mem == NULL) { N_VDestroy(r_star); N_VDestroy(r); N_VDestroy(p); N_VDestroy(q); N_VDestroy(u); N_VDestroy(Ap); N_VDestroy(vtemp); return(NULL); } /* Set the fields of mem */ mem->l_max = l_max; mem->r_star = r_star; mem->r = r; mem->p = p; mem->q = q; mem->u = u; mem->Ap = Ap; mem->vtemp = vtemp; /* Return the pointer to SPBCG memory */ return(mem); } /* * ----------------------------------------------------------------- * Function : SpbcgSolve * ----------------------------------------------------------------- */ int SpbcgSolve(SpbcgMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector sx, N_Vector sb, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps) { realtype alpha, beta, omega, omega_denom, beta_num, beta_denom, r_norm, rho; N_Vector r_star, r, p, q, u, Ap, vtemp; booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; int l, l_max, ier; if (mem == NULL) return(SPBCG_MEM_NULL); /* Make local copies of mem variables */ l_max = mem->l_max; r_star = mem->r_star; r = mem->r; p = mem->p; q = mem->q; u = mem->u; Ap = mem->Ap; vtemp = mem->vtemp; *nli = *nps = 0; /* Initialize counters */ converged = SUNFALSE; /* Initialize converged flag */ if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); scale_x = (sx != NULL); scale_b = (sb != NULL); /* Set r_star to initial (unscaled) residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); else { ier = atimes(A_data, x, r_star); if (ier != 0) return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); N_VLinearSum(ONE, b, -ONE, r_star, r_star); } /* Apply left preconditioner and b-scaling to r_star = r_0 */ if (preOnLeft) { ier = psolve(P_data, r_star, r, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, r_star, r); if (scale_b) N_VProd(sb, r, r_star); else N_VScale(ONE, r, r_star); /* Initialize beta_denom to the dot product of r0 with r0 */ beta_denom = N_VDotProd(r_star, r_star); /* Set r_norm to L2 norm of r_star = sb P1_inv r_0, and return if small */ *res_norm = r_norm = rho = SUNRsqrt(beta_denom); if (r_norm <= delta) return(SPBCG_SUCCESS); /* Copy r_star to r and p */ N_VScale(ONE, r_star, r); N_VScale(ONE, r_star, p); /* Begin main iteration loop */ for(l = 0; l < l_max; l++) { (*nli)++; /* Generate Ap = A-tilde p, where A-tilde = sb P1_inv A P2_inv sx_inv */ /* Apply x-scaling: vtemp = sx_inv p */ if (scale_x) N_VDiv(p, sx, vtemp); else N_VScale(ONE, p, vtemp); /* Apply right preconditioner: vtemp = P2_inv sx_inv p */ if (preOnRight) { N_VScale(ONE, vtemp, Ap); ier = psolve(P_data, Ap, vtemp, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } /* Apply A: Ap = A P2_inv sx_inv p */ ier = atimes(A_data, vtemp, Ap ); if (ier != 0) return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ if (preOnLeft) { ier = psolve(P_data, Ap, vtemp, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, Ap, vtemp); /* Apply b-scaling: Ap = sb P1_inv A P2_inv sx_inv p */ if (scale_b) N_VProd(sb, vtemp, Ap); else N_VScale(ONE, vtemp, Ap); /* Calculate alpha = / */ alpha = ((beta_denom / N_VDotProd(Ap, r_star))); /* Update q = r - alpha*Ap = r - alpha*(sb P1_inv A P2_inv sx_inv p) */ N_VLinearSum(ONE, r, -alpha, Ap, q); /* Generate u = A-tilde q */ /* Apply x-scaling: vtemp = sx_inv q */ if (scale_x) N_VDiv(q, sx, vtemp); else N_VScale(ONE, q, vtemp); /* Apply right preconditioner: vtemp = P2_inv sx_inv q */ if (preOnRight) { N_VScale(ONE, vtemp, u); ier = psolve(P_data, u, vtemp, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } /* Apply A: u = A P2_inv sx_inv u */ ier = atimes(A_data, vtemp, u ); if (ier != 0) return((ier < 0) ? SPBCG_ATIMES_FAIL_UNREC : SPBCG_ATIMES_FAIL_REC); /* Apply left preconditioner: vtemp = P1_inv A P2_inv sx_inv p */ if (preOnLeft) { ier = psolve(P_data, u, vtemp, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, u, vtemp); /* Apply b-scaling: u = sb P1_inv A P2_inv sx_inv u */ if (scale_b) N_VProd(sb, vtemp, u); else N_VScale(ONE, vtemp, u); /* Calculate omega = / */ omega_denom = N_VDotProd(u, u); if (omega_denom == ZERO) omega_denom = ONE; omega = (N_VDotProd(u, q) / omega_denom); /* Update x = x + alpha*p + omega*q */ N_VLinearSum(alpha, p, omega, q, vtemp); N_VLinearSum(ONE, x, ONE, vtemp, x); /* Update the residual r = q - omega*u */ N_VLinearSum(ONE, q, -omega, u, r); /* Set rho = norm(r) and check convergence */ *res_norm = rho = SUNRsqrt(N_VDotProd(r, r)); if (rho <= delta) { converged = SUNTRUE; break; } /* Not yet converged, continue iteration */ /* Update beta = / * alpha / omega */ beta_num = N_VDotProd(r, r_star); beta = ((beta_num / beta_denom) * (alpha / omega)); beta_denom = beta_num; /* Update p = r + beta*(p - omega*Ap) */ N_VLinearSum(ONE, p, -omega, Ap, vtemp); N_VLinearSum(ONE, r, beta, vtemp, p); } /* Main loop finished */ if ((converged == SUNTRUE) || (rho < r_norm)) { /* Apply the x-scaling and right preconditioner: x = P2_inv sx_inv x */ if (scale_x) N_VDiv(x, sx, x); if (preOnRight) { ier = psolve(P_data, x, vtemp, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPBCG_PSOLVE_FAIL_UNREC : SPBCG_PSOLVE_FAIL_REC); N_VScale(ONE, vtemp, x); } if (converged == SUNTRUE) return(SPBCG_SUCCESS); else return(SPBCG_RES_REDUCED); } else return(SPBCG_CONV_FAIL); } /* * ----------------------------------------------------------------- * Function : SpbcgFree * ----------------------------------------------------------------- */ void SpbcgFree(SpbcgMem mem) { if (mem == NULL) return; N_VDestroy(mem->r_star); N_VDestroy(mem->r); N_VDestroy(mem->p); N_VDestroy(mem->q); N_VDestroy(mem->u); N_VDestroy(mem->Ap); N_VDestroy(mem->vtemp); free(mem); mem = NULL; } StanHeaders/src/sundials/sundials_nonlinearsolver.c0000644000176200001440000001121513766554457022400 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This is the implementation file for a generic SUNNonlinerSolver package. It * contains the implementation of the SUNNonlinearSolver operations listed in * the 'ops' structure in sundials_nonlinearsolver.h * ---------------------------------------------------------------------------*/ #include #include /* ----------------------------------------------------------------------------- * core functions * ---------------------------------------------------------------------------*/ SUNNonlinearSolver_Type SUNNonlinSolGetType(SUNNonlinearSolver NLS) { return(NLS->ops->gettype(NLS)); } int SUNNonlinSolInitialize(SUNNonlinearSolver NLS) { if (NLS->ops->initialize) return((int) NLS->ops->initialize(NLS)); else return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetup(SUNNonlinearSolver NLS, N_Vector y, void* mem) { if (NLS->ops->setup) return((int) NLS->ops->setup(NLS, y, mem)); else return(SUN_NLS_SUCCESS); } int SUNNonlinSolSolve(SUNNonlinearSolver NLS, N_Vector y0, N_Vector y, N_Vector w, realtype tol, booleantype callLSetup, void* mem) { return((int) NLS->ops->solve(NLS, y0, y, w, tol, callLSetup, mem)); } int SUNNonlinSolFree(SUNNonlinearSolver NLS) { if (NLS == NULL) return(SUN_NLS_SUCCESS); if (NLS->ops == NULL) return(SUN_NLS_SUCCESS); if (NLS->ops->free) { return(NLS->ops->free(NLS)); } else { /* free the content structure */ if (NLS->content) { free(NLS->content); NLS->content = NULL; } /* free the ops structure */ if (NLS->ops) { free(NLS->ops); NLS->ops = NULL; } /* free the nonlinear solver */ free(NLS); return(SUN_NLS_SUCCESS); } } /* ----------------------------------------------------------------------------- * set functions * ---------------------------------------------------------------------------*/ /* set the nonlinear system function (required) */ int SUNNonlinSolSetSysFn(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn) { return((int) NLS->ops->setsysfn(NLS, SysFn)); } /* set the linear solver setup function (optional) */ int SUNNonlinSolSetLSetupFn(SUNNonlinearSolver NLS, SUNNonlinSolLSetupFn LSetupFn) { if (NLS->ops->setlsetupfn) return((int) NLS->ops->setlsetupfn(NLS, LSetupFn)); else return(SUN_NLS_SUCCESS); } /* set the linear solver solve function (optional) */ int SUNNonlinSolSetLSolveFn(SUNNonlinearSolver NLS, SUNNonlinSolLSolveFn LSolveFn) { if (NLS->ops->setlsolvefn) return((int) NLS->ops->setlsolvefn(NLS, LSolveFn)); else return(SUN_NLS_SUCCESS); } /* set the convergence test function (optional) */ int SUNNonlinSolSetConvTestFn(SUNNonlinearSolver NLS, SUNNonlinSolConvTestFn CTestFn) { if (NLS->ops->setctestfn) return((int) NLS->ops->setctestfn(NLS, CTestFn)); else return(SUN_NLS_SUCCESS); } int SUNNonlinSolSetMaxIters(SUNNonlinearSolver NLS, int maxiters) { if (NLS->ops->setmaxiters) return((int) NLS->ops->setmaxiters(NLS, maxiters)); else return(SUN_NLS_SUCCESS); } /* ----------------------------------------------------------------------------- * get functions * ---------------------------------------------------------------------------*/ /* get the total number on nonlinear iterations (optional) */ int SUNNonlinSolGetNumIters(SUNNonlinearSolver NLS, long int *niters) { if (NLS->ops->getnumiters) { return((int) NLS->ops->getnumiters(NLS, niters)); } else { *niters = 0; return(SUN_NLS_SUCCESS); } } /* get the iteration count for the current nonlinear solve */ int SUNNonlinSolGetCurIter(SUNNonlinearSolver NLS, int *iter) { if (NLS->ops->getcuriter) { return((int) NLS->ops->getcuriter(NLS, iter)); } else { *iter = -1; return(SUN_NLS_SUCCESS); } } /* get the total number on nonlinear solve convergence failures (optional) */ int SUNNonlinSolGetNumConvFails(SUNNonlinearSolver NLS, long int *nconvfails) { if (NLS->ops->getnumconvfails) { return((int) NLS->ops->getnumconvfails(NLS, nconvfails)); } else { *nconvfails = 0; return(SUN_NLS_SUCCESS); } } StanHeaders/src/sundials/sundials_iterative.c0000644000176200001440000001751013766554457021160 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the iterative.h header * file. It contains the implementation of functions that may be * useful for many different iterative solvers of A x = b. * ----------------------------------------------------------------- */ #include #include #include #define FACTOR RCONST(1000.0) #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : ModifiedGS * ----------------------------------------------------------------- * This implementation of ModifiedGS is a slight modification of a * previous modified Gram-Schmidt routine (called mgs) written by * Milo Dorr. * ----------------------------------------------------------------- */ int ModifiedGS(N_Vector *v, realtype **h, int k, int p, realtype *new_vk_norm) { int i, k_minus_1, i0; realtype new_norm_2, new_product, vk_norm, temp; vk_norm = SUNRsqrt(N_VDotProd(v[k],v[k])); k_minus_1 = k - 1; i0 = SUNMAX(k-p, 0); /* Perform modified Gram-Schmidt */ for (i=i0; i < k; i++) { h[i][k_minus_1] = N_VDotProd(v[i], v[k]); N_VLinearSum(ONE, v[k], -h[i][k_minus_1], v[i], v[k]); } /* Compute the norm of the new vector at v[k] */ *new_vk_norm = SUNRsqrt(N_VDotProd(v[k], v[k])); /* If the norm of the new vector at v[k] is less than FACTOR (== 1000) times unit roundoff times the norm of the input vector v[k], then the vector will be reorthogonalized in order to ensure that nonorthogonality is not being masked by a very small vector length. */ temp = FACTOR * vk_norm; if ((temp + (*new_vk_norm)) != temp) return(0); new_norm_2 = ZERO; for (i=i0; i < k; i++) { new_product = N_VDotProd(v[i], v[k]); temp = FACTOR * h[i][k_minus_1]; if ((temp + new_product) == temp) continue; h[i][k_minus_1] += new_product; N_VLinearSum(ONE, v[k],-new_product, v[i], v[k]); new_norm_2 += SUNSQR(new_product); } if (new_norm_2 != ZERO) { new_product = SUNSQR(*new_vk_norm) - new_norm_2; *new_vk_norm = (new_product > ZERO) ? SUNRsqrt(new_product) : ZERO; } return(0); } /* * ----------------------------------------------------------------- * Function : ClassicalGS * ----------------------------------------------------------------- * This implementation of ClassicalGS was contributed by Homer Walker * and Peter Brown. * ----------------------------------------------------------------- */ int ClassicalGS(N_Vector *v, realtype **h, int k, int p, realtype *new_vk_norm, realtype *stemp, N_Vector *vtemp) { int i, i0, k_minus_1, retval; realtype vk_norm; k_minus_1 = k - 1; i0 = SUNMAX(k-p,0); /* Perform Classical Gram-Schmidt */ retval = N_VDotProdMulti(k-i0+1, v[k], v+i0, stemp); if (retval != 0) return(-1); vk_norm = SUNRsqrt(stemp[k-i0]); for (i=k-i0-1; i >= 0; i--) { h[i][k_minus_1] = stemp[i]; stemp[i+1] = -stemp[i]; vtemp[i+1] = v[i]; } stemp[0] = ONE; vtemp[0] = v[k]; retval = N_VLinearCombination(k-i0+1, stemp, vtemp, v[k]); if (retval != 0) return(-1); /* Compute the norm of the new vector at v[k] */ *new_vk_norm = SUNRsqrt(N_VDotProd(v[k], v[k])); /* Reorthogonalize if necessary */ if ((FACTOR * (*new_vk_norm)) < vk_norm) { retval = N_VDotProdMulti(k-i0, v[k], v+i0, stemp+1); if (retval != 0) return(-1); stemp[0] = ONE; vtemp[0] = v[k]; for (i=i0; i < k; i++) { h[i][k_minus_1] += stemp[i-i0+1]; stemp[i-i0+1] = -stemp[i-i0+1]; vtemp[i-i0+1] = v[i-i0]; } retval = N_VLinearCombination(k+1, stemp, vtemp, v[k]); if (retval != 0) return(-1); *new_vk_norm = SUNRsqrt(N_VDotProd(v[k],v[k])); } return(0); } /* * ----------------------------------------------------------------- * Function : QRfact * ----------------------------------------------------------------- * This implementation of QRfact is a slight modification of a * previous routine (called qrfact) written by Milo Dorr. * ----------------------------------------------------------------- */ int QRfact(int n, realtype **h, realtype *q, int job) { realtype c, s, temp1, temp2, temp3; int i, j, k, q_ptr, n_minus_1, code=0; switch (job) { case 0: /* Compute a new factorization of H */ code = 0; for (k=0; k < n; k++) { /* Multiply column k by the previous k-1 Givens rotations */ for (j=0; j < k-1; j++) { i = 2*j; temp1 = h[j][k]; temp2 = h[j+1][k]; c = q[i]; s = q[i+1]; h[j][k] = c*temp1 - s*temp2; h[j+1][k] = s*temp1 + c*temp2; } /* Compute the Givens rotation components c and s */ q_ptr = 2*k; temp1 = h[k][k]; temp2 = h[k+1][k]; if( temp2 == ZERO) { c = ONE; s = ZERO; } else if (SUNRabs(temp2) >= SUNRabs(temp1)) { temp3 = temp1/temp2; s = -ONE/SUNRsqrt(ONE+SUNSQR(temp3)); c = -s*temp3; } else { temp3 = temp2/temp1; c = ONE/SUNRsqrt(ONE+SUNSQR(temp3)); s = -c*temp3; } q[q_ptr] = c; q[q_ptr+1] = s; if( (h[k][k] = c*temp1 - s*temp2) == ZERO) code = k+1; } break; default: /* Update the factored H to which a new column has been added */ n_minus_1 = n - 1; code = 0; /* Multiply the new column by the previous n-1 Givens rotations */ for (k=0; k < n_minus_1; k++) { i = 2*k; temp1 = h[k][n_minus_1]; temp2 = h[k+1][n_minus_1]; c = q[i]; s = q[i+1]; h[k][n_minus_1] = c*temp1 - s*temp2; h[k+1][n_minus_1] = s*temp1 + c*temp2; } /* Compute new Givens rotation and multiply it times the last two entries in the new column of H. Note that the second entry of this product will be 0, so it is not necessary to compute it. */ temp1 = h[n_minus_1][n_minus_1]; temp2 = h[n][n_minus_1]; if (temp2 == ZERO) { c = ONE; s = ZERO; } else if (SUNRabs(temp2) >= SUNRabs(temp1)) { temp3 = temp1/temp2; s = -ONE/SUNRsqrt(ONE+SUNSQR(temp3)); c = -s*temp3; } else { temp3 = temp2/temp1; c = ONE/SUNRsqrt(ONE+SUNSQR(temp3)); s = -c*temp3; } q_ptr = 2*n_minus_1; q[q_ptr] = c; q[q_ptr+1] = s; if ((h[n_minus_1][n_minus_1] = c*temp1 - s*temp2) == ZERO) code = n; } return (code); } /* * ----------------------------------------------------------------- * Function : QRsol * ----------------------------------------------------------------- * This implementation of QRsol is a slight modification of a * previous routine (called qrsol) written by Milo Dorr. * ----------------------------------------------------------------- */ int QRsol(int n, realtype **h, realtype *q, realtype *b) { realtype c, s, temp1, temp2; int i, k, q_ptr, code=0; /* Compute Q*b */ for (k=0; k < n; k++) { q_ptr = 2*k; c = q[q_ptr]; s = q[q_ptr+1]; temp1 = b[k]; temp2 = b[k+1]; b[k] = c*temp1 - s*temp2; b[k+1] = s*temp1 + c*temp2; } /* Solve R*x = Q*b */ for (k=n-1; k >= 0; k--) { if (h[k][k] == ZERO) { code = k + 1; break; } b[k] /= h[k][k]; for (i=0; i < k; i++) b[i] -= b[k]*h[i][k]; } return (code); } StanHeaders/src/sundials/sundials_pcg.c0000644000176200001440000001326113766554457017734 0ustar liggesusers/*--------------------------------------------------------------- Programmer(s): Daniel R. Reynolds @ SMU ---------------------------------------------------------------- LLNS/SMU Copyright Start Copyright (c) 2002-2018, Southern Methodist University and Lawrence Livermore National Security This work was performed under the auspices of the U.S. Department of Energy by Southern Methodist University and Lawrence Livermore National Laboratory under Contract DE-AC52-07NA27344. Produced at Southern Methodist University and the Lawrence Livermore National Laboratory. All rights reserved. For details, see the LICENSE file. LLNS/SMU Copyright End ---------------------------------------------------------------- This is the implementation file for the preconditioned conjugate gradient solver in SUNDIALS. --------------------------------------------------------------*/ #include #include #include #include /*--------------------------------------------------------------- private constants --------------------------------------------------------------*/ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /*--------------------------------------------------------------- Function : PcgMalloc --------------------------------------------------------------*/ PcgMem PcgMalloc(int l_max, N_Vector vec_tmpl) { PcgMem mem; N_Vector r, p, z, Ap; /* Check the input parameters */ if (l_max <= 0) return(NULL); /* Create temporary arrays */ r = N_VClone(vec_tmpl); if (r == NULL) { return(NULL); } p = N_VClone(vec_tmpl); if (p == NULL) { N_VDestroy(r); return(NULL); } z = N_VClone(vec_tmpl); if (z == NULL) { N_VDestroy(r); N_VDestroy(p); return(NULL); } Ap = N_VClone(vec_tmpl); if (Ap == NULL) { N_VDestroy(r); N_VDestroy(p); N_VDestroy(z); return(NULL); } /* Get memory for an PcgMemRec containing PCG vectors */ mem = NULL; mem = (PcgMem) malloc(sizeof(PcgMemRec)); if (mem == NULL) { N_VDestroy(r); N_VDestroy(p); N_VDestroy(z); N_VDestroy(Ap); return(NULL); } /* Set the structure fields */ mem->l_max = l_max; mem->r = r; mem->p = p; mem->z = z; mem->Ap = Ap; /* Return the pointer to PCG memory */ return(mem); } /*--------------------------------------------------------------- Function : PcgSolve --------------------------------------------------------------*/ int PcgSolve(PcgMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector w, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps) { realtype alpha, beta, r0_norm, rho, rz, rz_old; N_Vector r, p, z, Ap; booleantype UsePrec, converged; int l, l_max, ier; if (mem == NULL) return(PCG_MEM_NULL); /* Make local copies of mem variables */ l_max = mem->l_max; r = mem->r; p = mem->p; z = mem->z; Ap = mem->Ap; /* Initialize counters and converged flag */ *nli = *nps = 0; converged = SUNFALSE; /* Set preconditioning flag */ UsePrec = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT) || (pretype == PREC_RIGHT)); /* Set r to initial residual r_0 = b - A*x_0 */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r); else { ier = atimes(A_data, x, r); if (ier != 0) return((ier < 0) ? PCG_ATIMES_FAIL_UNREC : PCG_ATIMES_FAIL_REC); N_VLinearSum(ONE, b, -ONE, r, r); } /* Set rho to L2 norm of r, and return if small */ *res_norm = r0_norm = rho = N_VWrmsNorm(r,w); if (rho <= delta) return(PCG_SUCCESS); /* Apply preconditioner and b-scaling to r = r_0 */ if (UsePrec) { ier = psolve(P_data, r, z, delta, PREC_LEFT); /* z = P^{-1}r */ (*nps)++; if (ier != 0) return((ier < 0) ? PCG_PSOLVE_FAIL_UNREC : PCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, r, z); /* Initialize rz to */ rz = N_VDotProd(r, z); /* Copy z to p */ N_VScale(ONE, z, p); /* Begin main iteration loop */ for(l=0; l / */ alpha = rz / N_VDotProd(Ap, p); /* Update x = x + alpha*p */ N_VLinearSum(ONE, x, alpha, p, x); /* Update r = r - alpha*Ap */ N_VLinearSum(ONE, r, -alpha, Ap, r); /* Set rho and check convergence */ *res_norm = rho = N_VWrmsNorm(r, w); if (rho <= delta) { converged = SUNTRUE; break; } /* Apply preconditioner: z = P^{-1}*r */ if (UsePrec) { ier = psolve(P_data, r, z, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? PCG_PSOLVE_FAIL_UNREC : PCG_PSOLVE_FAIL_REC); } else N_VScale(ONE, r, z); /* update rz */ rz_old = rz; rz = N_VDotProd(r, z); /* Calculate beta = / */ beta = rz / rz_old; /* Update p = z + beta*p */ N_VLinearSum(ONE, z, beta, p, p); } /* Main loop finished, return with result */ if (converged == SUNTRUE) return(PCG_SUCCESS); if (rho < r0_norm) return(PCG_RES_REDUCED); return(PCG_CONV_FAIL); } /*--------------------------------------------------------------- Function : PcgFree --------------------------------------------------------------*/ void PcgFree(PcgMem mem) { if (mem == NULL) return; N_VDestroy(mem->r); N_VDestroy(mem->p); N_VDestroy(mem->z); N_VDestroy(mem->Ap); free(mem); mem = NULL; } /*=============================================================== EOF ===============================================================*/ StanHeaders/src/sundials/sundials_sptfqmr.c0000644000176200001440000003514713766554457020666 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for the scaled preconditioned * Transpose-Free Quasi-Minimal Residual (SPTFQMR) linear solver. * ----------------------------------------------------------------- */ #include #include #include #include /* * ----------------------------------------------------------------- * private constants * ----------------------------------------------------------------- */ #define ZERO RCONST(0.0) #define ONE RCONST(1.0) /* * ----------------------------------------------------------------- * Function : SptfqmrMalloc * ----------------------------------------------------------------- */ SptfqmrMem SptfqmrMalloc(int l_max, N_Vector vec_tmpl) { SptfqmrMem mem; N_Vector *r; N_Vector q, d, v, p, u; N_Vector r_star, vtemp1, vtemp2, vtemp3; /* Check the input parameters */ if ((l_max <= 0) || (vec_tmpl == NULL)) return(NULL); /* Allocate space for vectors */ r_star = N_VClone(vec_tmpl); if (r_star == NULL) return(NULL); q = N_VClone(vec_tmpl); if (q == NULL) { N_VDestroy(r_star); return(NULL); } d = N_VClone(vec_tmpl); if (d == NULL) { N_VDestroy(r_star); N_VDestroy(q); return(NULL); } v = N_VClone(vec_tmpl); if (v == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); return(NULL); } p = N_VClone(vec_tmpl); if (p == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); return(NULL); } r = N_VCloneVectorArray(2, vec_tmpl); if (r == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); return(NULL); } u = N_VClone(vec_tmpl); if (u == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); return(NULL); } vtemp1 = N_VClone(vec_tmpl); if (vtemp1 == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); return(NULL); } vtemp2 = N_VClone(vec_tmpl); if (vtemp2 == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); N_VDestroy(vtemp1); return(NULL); } vtemp3 = N_VClone(vec_tmpl); if (vtemp3 == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); N_VDestroy(vtemp1); N_VDestroy(vtemp2); return(NULL); } /* Allocate memory for SptfqmrMemRec */ mem = NULL; mem = (SptfqmrMem) malloc(sizeof(SptfqmrMemRec)); if (mem == NULL) { N_VDestroy(r_star); N_VDestroy(q); N_VDestroy(d); N_VDestroy(v); N_VDestroy(p); N_VDestroyVectorArray(r, 2); N_VDestroy(u); N_VDestroy(vtemp1); N_VDestroy(vtemp2); N_VDestroy(vtemp3); return(NULL); } /* Intialize SptfqmrMemRec data structure */ mem->l_max = l_max; mem->r_star = r_star; mem->q = q; mem->d = d; mem->v = v; mem->p = p; mem->r = r; mem->u = u; mem->vtemp1 = vtemp1; mem->vtemp2 = vtemp2; mem->vtemp3 = vtemp3; /* Return pointer to SPTFQMR memory block */ return(mem); } #define l_max (mem->l_max) #define r_star (mem->r_star) #define q_ (mem->q) #define d_ (mem->d) #define v_ (mem->v) #define p_ (mem->p) #define r_ (mem->r) #define u_ (mem->u) #define vtemp1 (mem->vtemp1) #define vtemp2 (mem->vtemp2) #define vtemp3 (mem->vtemp3) /* * ----------------------------------------------------------------- * Function : SptfqmrSolve * ----------------------------------------------------------------- */ int SptfqmrSolve(SptfqmrMem mem, void *A_data, N_Vector x, N_Vector b, int pretype, realtype delta, void *P_data, N_Vector sx, N_Vector sb, ATimesFn atimes, PSolveFn psolve, realtype *res_norm, int *nli, int *nps) { realtype alpha, tau, eta, beta, c, sigma, v_bar, omega; realtype rho[2]; realtype r_init_norm, r_curr_norm; realtype temp_val; booleantype preOnLeft, preOnRight, scale_x, scale_b, converged; booleantype b_ok; int n, m, ier; /* Exit immediately if memory pointer is NULL */ if (mem == NULL) return(SPTFQMR_MEM_NULL); temp_val = r_curr_norm = -ONE; /* Initialize to avoid compiler warnings */ *nli = *nps = 0; /* Initialize counters */ converged = SUNFALSE; /* Initialize convergence flag */ b_ok = SUNFALSE; if ((pretype != PREC_LEFT) && (pretype != PREC_RIGHT) && (pretype != PREC_BOTH)) pretype = PREC_NONE; preOnLeft = ((pretype == PREC_BOTH) || (pretype == PREC_LEFT)); preOnRight = ((pretype == PREC_BOTH) || (pretype == PREC_RIGHT)); scale_x = (sx != NULL); scale_b = (sb != NULL); /* Set r_star to initial (unscaled) residual r_star = r_0 = b - A*x_0 */ /* NOTE: if x == 0 then just set residual to b and continue */ if (N_VDotProd(x, x) == ZERO) N_VScale(ONE, b, r_star); else { ier = atimes(A_data, x, r_star); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); N_VLinearSum(ONE, b, -ONE, r_star, r_star); } /* Apply left preconditioner and b-scaling to r_star (or really just r_0) */ if (preOnLeft) { ier = psolve(P_data, r_star, vtemp1, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, r_star, vtemp1); if (scale_b) N_VProd(sb, vtemp1, r_star); else N_VScale(ONE, vtemp1, r_star); /* Initialize rho[0] */ /* NOTE: initialized here to reduce number of computations - avoid need to compute r_star^T*r_star twice, and avoid needlessly squaring values */ rho[0] = N_VDotProd(r_star, r_star); /* Compute norm of initial residual (r_0) to see if we really need to do anything */ *res_norm = r_init_norm = SUNRsqrt(rho[0]); if (r_init_norm <= delta) return(SPTFQMR_SUCCESS); /* Set v_ = A*r_0 (preconditioned and scaled) */ if (scale_x) N_VDiv(r_star, sx, vtemp1); else N_VScale(ONE, r_star, vtemp1); if (preOnRight) { N_VScale(ONE, vtemp1, v_); ier = psolve(P_data, v_, vtemp1, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } ier = atimes(A_data, vtemp1, v_); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, v_, vtemp1, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, v_, vtemp1); if (scale_b) N_VProd(sb, vtemp1, v_); else N_VScale(ONE, vtemp1, v_); /* Initialize remaining variables */ N_VScale(ONE, r_star, r_[0]); N_VScale(ONE, r_star, u_); N_VScale(ONE, r_star, p_); N_VConst(ZERO, d_); tau = r_init_norm; v_bar = eta = ZERO; /* START outer loop */ for (n = 0; n < l_max; ++n) { /* Increment linear iteration counter */ (*nli)++; /* sigma = r_star^T*v_ */ sigma = N_VDotProd(r_star, v_); /* alpha = rho[0]/sigma */ alpha = rho[0]/sigma; /* q_ = u_-alpha*v_ */ N_VLinearSum(ONE, u_, -alpha, v_, q_); /* r_[1] = r_[0]-alpha*A*(u_+q_) */ N_VLinearSum(ONE, u_, ONE, q_, r_[1]); if (scale_x) N_VDiv(r_[1], sx, r_[1]); if (preOnRight) { N_VScale(ONE, r_[1], vtemp1); ier = psolve(P_data, vtemp1, r_[1], delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } ier = atimes(A_data, r_[1], vtemp1); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, vtemp1, r_[1], delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, vtemp1, r_[1]); if (scale_b) N_VProd(sb, r_[1], vtemp1); else N_VScale(ONE, r_[1], vtemp1); N_VLinearSum(ONE, r_[0], -alpha, vtemp1, r_[1]); /* START inner loop */ for (m = 0; m < 2; ++m) { /* d_ = [*]+(v_bar^2*eta/alpha)*d_ */ /* NOTES: * (1) [*] = u_ if m == 0, and q_ if m == 1 * (2) using temp_val reduces the number of required computations * if the inner loop is executed twice */ if (m == 0) { temp_val = SUNRsqrt(N_VDotProd(r_[1], r_[1])); omega = SUNRsqrt(SUNRsqrt(N_VDotProd(r_[0], r_[0]))*temp_val); N_VLinearSum(ONE, u_, SUNSQR(v_bar)*eta/alpha, d_, d_); } else { omega = temp_val; N_VLinearSum(ONE, q_, SUNSQR(v_bar)*eta/alpha, d_, d_); } /* v_bar = omega/tau */ v_bar = omega/tau; /* c = (1+v_bar^2)^(-1/2) */ c = ONE / SUNRsqrt(ONE+SUNSQR(v_bar)); /* tau = tau*v_bar*c */ tau = tau*v_bar*c; /* eta = c^2*alpha */ eta = SUNSQR(c)*alpha; /* x = x+eta*d_ */ N_VLinearSum(ONE, x, eta, d_, x); /* Check for convergence... */ /* NOTE: just use approximation to norm of residual, if possible */ *res_norm = r_curr_norm = tau*SUNRsqrt(m+1); /* Exit inner loop if iteration has converged based upon approximation to norm of current residual */ if (r_curr_norm <= delta) { converged = SUNTRUE; break; } /* Decide if actual norm of residual vector should be computed */ /* NOTES: * (1) if r_curr_norm > delta, then check if actual residual norm * is OK (recall we first compute an approximation) * (2) if r_curr_norm >= r_init_norm and m == 1 and n == l_max, then * compute actual residual norm to see if the iteration can be * saved * (3) the scaled and preconditioned right-hand side of the given * linear system (denoted by b) is only computed once, and the * result is stored in vtemp3 so it can be reused - reduces the * number of psovles if using left preconditioning */ if ((r_curr_norm > delta) || (r_curr_norm >= r_init_norm && m == 1 && n == l_max)) { /* Compute norm of residual ||b-A*x||_2 (preconditioned and scaled) */ if (scale_x) N_VDiv(x, sx, vtemp1); else N_VScale(ONE, x, vtemp1); if (preOnRight) { ier = psolve(P_data, vtemp1, vtemp2, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); N_VScale(ONE, vtemp2, vtemp1); } ier = atimes(A_data, vtemp1, vtemp2); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, vtemp2, vtemp1, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, vtemp2, vtemp1); if (scale_b) N_VProd(sb, vtemp1, vtemp2); else N_VScale(ONE, vtemp1, vtemp2); /* Only precondition and scale b once (result saved for reuse) */ if (!b_ok) { b_ok = SUNTRUE; if (preOnLeft) { ier = psolve(P_data, b, vtemp3, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, b, vtemp3); if (scale_b) N_VProd(sb, vtemp3, vtemp3); } N_VLinearSum(ONE, vtemp3, -ONE, vtemp2, vtemp1); *res_norm = r_curr_norm = SUNRsqrt(N_VDotProd(vtemp1, vtemp1)); /* Exit inner loop if inequality condition is satisfied (meaning exit if we have converged) */ if (r_curr_norm <= delta) { converged = SUNTRUE; break; } } } /* END inner loop */ /* If converged, then exit outer loop as well */ if (converged == SUNTRUE) break; /* rho[1] = r_star^T*r_[1] */ rho[1] = N_VDotProd(r_star, r_[1]); /* beta = rho[1]/rho[0] */ beta = rho[1]/rho[0]; /* u_ = r_[1]+beta*q_ */ N_VLinearSum(ONE, r_[1], beta, q_, u_); /* p_ = u_+beta*(q_+beta*p_) */ N_VLinearSum(beta, q_, SUNSQR(beta), p_, p_); N_VLinearSum(ONE, u_, ONE, p_, p_); /* v_ = A*p_ */ if (scale_x) N_VDiv(p_, sx, vtemp1); else N_VScale(ONE, p_, vtemp1); if (preOnRight) { N_VScale(ONE, vtemp1, v_); ier = psolve(P_data, v_, vtemp1, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } ier = atimes(A_data, vtemp1, v_); if (ier != 0) return((ier < 0) ? SPTFQMR_ATIMES_FAIL_UNREC : SPTFQMR_ATIMES_FAIL_REC); if (preOnLeft) { ier = psolve(P_data, v_, vtemp1, delta, PREC_LEFT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_REC); } else N_VScale(ONE, v_, vtemp1); if (scale_b) N_VProd(sb, vtemp1, v_); else N_VScale(ONE, vtemp1, v_); /* Shift variable values */ /* NOTE: reduces storage requirements */ N_VScale(ONE, r_[1], r_[0]); rho[0] = rho[1]; } /* END outer loop */ /* Determine return value */ /* If iteration converged or residual was reduced, then return current iterate (x) */ if ((converged == SUNTRUE) || (r_curr_norm < r_init_norm)) { if (scale_x) N_VDiv(x, sx, x); if (preOnRight) { ier = psolve(P_data, x, vtemp1, delta, PREC_RIGHT); (*nps)++; if (ier != 0) return((ier < 0) ? SPTFQMR_PSOLVE_FAIL_UNREC : SPTFQMR_PSOLVE_FAIL_UNREC); N_VScale(ONE, vtemp1, x); } if (converged == SUNTRUE) return(SPTFQMR_SUCCESS); else return(SPTFQMR_RES_REDUCED); } /* Otherwise, return error code */ else return(SPTFQMR_CONV_FAIL); } /* * ----------------------------------------------------------------- * Function : SptfqmrFree * ----------------------------------------------------------------- */ void SptfqmrFree(SptfqmrMem mem) { if (mem == NULL) return; N_VDestroy(r_star); N_VDestroy(q_); N_VDestroy(d_); N_VDestroy(v_); N_VDestroy(p_); N_VDestroyVectorArray(r_, 2); N_VDestroy(u_); N_VDestroy(vtemp1); N_VDestroy(vtemp2); N_VDestroy(vtemp3); free(mem); mem = NULL; } StanHeaders/src/sundials/sundials_matrix.c0000644000176200001440000000366613766554457020477 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner, Carol Woodward, Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a generic SUNMATRIX package. * It contains the implementation of the SUNMatrix operations listed * in sundials_matrix.h * ----------------------------------------------------------------- */ #include #include #include /* * ----------------------------------------------------------------- * Functions in the 'ops' structure * ----------------------------------------------------------------- */ SUNMatrix_ID SUNMatGetID(SUNMatrix A) { SUNMatrix_ID id; id = A->ops->getid(A); return(id); } SUNMatrix SUNMatClone(SUNMatrix A) { SUNMatrix B = NULL; B = A->ops->clone(A); return(B); } void SUNMatDestroy(SUNMatrix A) { if (A==NULL) return; A->ops->destroy(A); return; } int SUNMatZero(SUNMatrix A) { return((int) A->ops->zero(A)); } int SUNMatCopy(SUNMatrix A, SUNMatrix B) { return((int) A->ops->copy(A, B)); } int SUNMatScaleAdd(realtype c, SUNMatrix A, SUNMatrix B) { return((int) A->ops->scaleadd(c, A, B)); } int SUNMatScaleAddI(realtype c, SUNMatrix A) { return((int) A->ops->scaleaddi(c, A)); } int SUNMatMatvec(SUNMatrix A, N_Vector x, N_Vector y) { return((int) A->ops->matvec(A, x, y)); } int SUNMatSpace(SUNMatrix A, long int *lenrw, long int *leniw) { return((int) A->ops->space(A, lenrw, leniw)); } StanHeaders/src/sundials/sundials_nvector_senswrapper.c0000644000176200001440000003223513766554457023276 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This is the implementation file for a vector wrapper for an array of NVECTORS * ---------------------------------------------------------------------------*/ #include #include #include #include #include #include #define ZERO RCONST(0.0) /*============================================================================== Constructors ============================================================================*/ /*------------------------------------------------------------------------------ create a new empty vector wrapper with space for vectors ----------------------------------------------------------------------------*/ N_Vector N_VNewEmpty_SensWrapper(int nvecs) { int i; N_Vector v; N_Vector_Ops ops; N_VectorContent_SensWrapper content; /* return if wrapper is empty */ if (nvecs < 1) return(NULL); /* create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof *ops); if (ops == NULL) {free(v); return(NULL);} ops->nvgetvectorid = NULL; ops->nvclone = N_VClone_SensWrapper; ops->nvcloneempty = N_VCloneEmpty_SensWrapper; ops->nvdestroy = N_VDestroy_SensWrapper; ops->nvspace = NULL; ops->nvgetarraypointer = NULL; ops->nvsetarraypointer = NULL; /* standard vector operations */ ops->nvlinearsum = N_VLinearSum_SensWrapper; ops->nvconst = N_VConst_SensWrapper; ops->nvprod = N_VProd_SensWrapper; ops->nvdiv = N_VDiv_SensWrapper; ops->nvscale = N_VScale_SensWrapper; ops->nvabs = N_VAbs_SensWrapper; ops->nvinv = N_VInv_SensWrapper; ops->nvaddconst = N_VAddConst_SensWrapper; ops->nvdotprod = N_VDotProd_SensWrapper; ops->nvmaxnorm = N_VMaxNorm_SensWrapper; ops->nvwrmsnormmask = N_VWrmsNormMask_SensWrapper; ops->nvwrmsnorm = N_VWrmsNorm_SensWrapper; ops->nvmin = N_VMin_SensWrapper; ops->nvwl2norm = N_VWL2Norm_SensWrapper; ops->nvl1norm = N_VL1Norm_SensWrapper; ops->nvcompare = N_VCompare_SensWrapper; ops->nvinvtest = N_VInvTest_SensWrapper; ops->nvconstrmask = N_VConstrMask_SensWrapper; ops->nvminquotient = N_VMinQuotient_SensWrapper; /* fused vector operations */ ops->nvlinearcombination = NULL; ops->nvscaleaddmulti = NULL; ops->nvdotprodmulti = NULL; /* vector array operations */ ops->nvlinearsumvectorarray = NULL; ops->nvscalevectorarray = NULL; ops->nvconstvectorarray = NULL; ops->nvwrmsnormvectorarray = NULL; ops->nvwrmsnormmaskvectorarray = NULL; ops->nvscaleaddmultivectorarray = NULL; ops->nvlinearcombinationvectorarray = NULL; /* create content */ content = NULL; content = (N_VectorContent_SensWrapper) malloc(sizeof *content); if (content == NULL) {free(ops); free(v); return(NULL);} content->nvecs = nvecs; content->own_vecs = SUNFALSE; content->vecs = NULL; content->vecs = (N_Vector*) malloc(nvecs * sizeof(N_Vector)); if (content->vecs == NULL) {free(ops); free(v); free(content); return(NULL);} /* initialize vector array to null */ for (i=0; i < nvecs; i++) content->vecs[i] = NULL; /* attach content and ops */ v->content = content; v->ops = ops; return(v); } N_Vector N_VNew_SensWrapper(int count, N_Vector w) { N_Vector v; int i; v = NULL; v = N_VNewEmpty_SensWrapper(count); if (v == NULL) return(NULL); for (i=0; i < NV_NVECS_SW(v); i++) { NV_VEC_SW(v,i) = N_VClone(w); if (NV_VEC_SW(v,i) == NULL) { N_VDestroy(v); return(NULL); } } /* update own vectors status */ NV_OWN_VECS_SW(v) = SUNTRUE; return(v); } /*============================================================================== Clone operations ============================================================================*/ /*------------------------------------------------------------------------------ create an empty clone of the vector wrapper w ----------------------------------------------------------------------------*/ N_Vector N_VCloneEmpty_SensWrapper(N_Vector w) { int i; N_Vector v; N_Vector_Ops ops; N_VectorContent_SensWrapper content; if (w == NULL) return(NULL); if (NV_NVECS_SW(w) < 1) return(NULL); /* create vector */ v = NULL; v = (N_Vector) malloc(sizeof *v); if (v == NULL) return(NULL); /* create vector operation structure */ ops = NULL; ops = (N_Vector_Ops) malloc(sizeof *ops); if (ops == NULL) { free(v); return(NULL); } ops->nvgetvectorid = w->ops->nvgetvectorid; ops->nvclone = w->ops->nvclone; ops->nvcloneempty = w->ops->nvcloneempty; ops->nvdestroy = w->ops->nvdestroy; ops->nvspace = w->ops->nvspace; ops->nvgetarraypointer = w->ops->nvgetarraypointer; ops->nvsetarraypointer = w->ops->nvsetarraypointer; /* standard vector operations */ ops->nvlinearsum = w->ops->nvlinearsum; ops->nvconst = w->ops->nvconst; ops->nvprod = w->ops->nvprod; ops->nvdiv = w->ops->nvdiv; ops->nvscale = w->ops->nvscale; ops->nvabs = w->ops->nvabs; ops->nvinv = w->ops->nvinv; ops->nvaddconst = w->ops->nvaddconst; ops->nvdotprod = w->ops->nvdotprod; ops->nvmaxnorm = w->ops->nvmaxnorm; ops->nvwrmsnormmask = w->ops->nvwrmsnormmask; ops->nvwrmsnorm = w->ops->nvwrmsnorm; ops->nvmin = w->ops->nvmin; ops->nvwl2norm = w->ops->nvwl2norm; ops->nvl1norm = w->ops->nvl1norm; ops->nvcompare = w->ops->nvcompare; ops->nvinvtest = w->ops->nvinvtest; ops->nvconstrmask = w->ops->nvconstrmask; ops->nvminquotient = w->ops->nvminquotient; /* fused vector operations */ ops->nvlinearcombination = w->ops->nvlinearcombination; ops->nvscaleaddmulti = w->ops->nvscaleaddmulti; ops->nvdotprodmulti = w->ops->nvdotprodmulti; /* vector array operations */ ops->nvlinearsumvectorarray = w->ops->nvlinearsumvectorarray; ops->nvscalevectorarray = w->ops->nvscalevectorarray; ops->nvconstvectorarray = w->ops->nvconstvectorarray; ops->nvwrmsnormvectorarray = w->ops->nvwrmsnormvectorarray; ops->nvwrmsnormmaskvectorarray = w->ops->nvwrmsnormmaskvectorarray; ops->nvscaleaddmultivectorarray = w->ops->nvscaleaddmultivectorarray; ops->nvlinearcombinationvectorarray = w->ops->nvlinearcombinationvectorarray; /* Create content */ content = NULL; content = (N_VectorContent_SensWrapper) malloc(sizeof *content); if (content == NULL) { free(ops); free(v); return(NULL); } content->nvecs = NV_NVECS_SW(w); content->own_vecs = SUNFALSE; content->vecs = NULL; content->vecs = (N_Vector*) malloc(NV_NVECS_SW(w) * sizeof(N_Vector)); if (content->vecs == NULL) {free(ops); free(v); free(content); return(NULL);} /* initialize vector array to null */ for (i=0; i < NV_NVECS_SW(w); i++) content->vecs[i] = NULL; /* Attach content and ops */ v->content = content; v->ops = ops; return(v); } /*------------------------------------------------------------------------------ create a clone of the vector wrapper w ----------------------------------------------------------------------------*/ N_Vector N_VClone_SensWrapper(N_Vector w) { N_Vector v; int i; /* create empty wrapper */ v = NULL; v = N_VCloneEmpty_SensWrapper(w); if (v == NULL) return(NULL); /* update own vectors status */ NV_OWN_VECS_SW(v) = SUNTRUE; /* allocate arrays */ for (i=0; i < NV_NVECS_SW(v); i++) { NV_VEC_SW(v,i) = N_VClone(NV_VEC_SW(w,i)); if (NV_VEC_SW(v,i) == NULL) { N_VDestroy(v); return(NULL); } } return(v); } /*============================================================================== Destructor ============================================================================*/ void N_VDestroy_SensWrapper(N_Vector v) { int i; if (NV_OWN_VECS_SW(v) == SUNTRUE) { for (i=0; i < NV_NVECS_SW(v); i++) { if (NV_VEC_SW(v,i)) N_VDestroy(NV_VEC_SW(v,i)); NV_VEC_SW(v,i) = NULL; } } free(NV_VECS_SW(v)); NV_VECS_SW(v) = NULL; free(v->content); v->content = NULL; free(v->ops); v->ops = NULL; free(v); v = NULL; return; } /*============================================================================== Standard vector operations ============================================================================*/ void N_VLinearSum_SensWrapper(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VLinearSum(a, NV_VEC_SW(x,i), b, NV_VEC_SW(y,i), NV_VEC_SW(z,i)); return; } void N_VConst_SensWrapper(realtype c, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(z); i++) N_VConst(c, NV_VEC_SW(z,i)); return; } void N_VProd_SensWrapper(N_Vector x, N_Vector y, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VProd(NV_VEC_SW(x,i), NV_VEC_SW(y,i), NV_VEC_SW(z,i)); return; } void N_VDiv_SensWrapper(N_Vector x, N_Vector y, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VDiv(NV_VEC_SW(x,i), NV_VEC_SW(y,i), NV_VEC_SW(z,i)); return; } void N_VScale_SensWrapper(realtype c, N_Vector x, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VScale(c, NV_VEC_SW(x,i), NV_VEC_SW(z,i)); return; } void N_VAbs_SensWrapper(N_Vector x, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VAbs(NV_VEC_SW(x,i), NV_VEC_SW(z,i)); return; } void N_VInv_SensWrapper(N_Vector x, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VInv(NV_VEC_SW(x,i), NV_VEC_SW(z,i)); return; } void N_VAddConst_SensWrapper(N_Vector x, realtype b, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VAddConst(NV_VEC_SW(x,i), b, NV_VEC_SW(z,i)); return; } realtype N_VDotProd_SensWrapper(N_Vector x, N_Vector y) { int i; realtype sum; sum = ZERO; for (i=0; i < NV_NVECS_SW(x); i++) sum += N_VDotProd(NV_VEC_SW(x,i), NV_VEC_SW(y,i)); return(sum); } realtype N_VMaxNorm_SensWrapper(N_Vector x) { int i; realtype max, tmp; max = ZERO; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VMaxNorm(NV_VEC_SW(x,i)); if (tmp > max) max = tmp; } return(max); } realtype N_VWrmsNorm_SensWrapper(N_Vector x, N_Vector w) { int i; realtype nrm, tmp; nrm = ZERO; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VWrmsNorm(NV_VEC_SW(x,i), NV_VEC_SW(w,i)); if (tmp > nrm) nrm = tmp; } return(nrm); } realtype N_VWrmsNormMask_SensWrapper(N_Vector x, N_Vector w, N_Vector id) { int i; realtype nrm, tmp; nrm = ZERO; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VWrmsNormMask(NV_VEC_SW(x,i), NV_VEC_SW(w,i), NV_VEC_SW(id,i)); if (tmp > nrm) nrm = tmp; } return(nrm); } realtype N_VMin_SensWrapper(N_Vector x) { int i; realtype min, tmp; min = N_VMin(NV_VEC_SW(x,0)); for (i=1; i < NV_NVECS_SW(x); i++) { tmp = N_VMin(NV_VEC_SW(x,i)); if (tmp < min) min = tmp; } return(min); } realtype N_VWL2Norm_SensWrapper(N_Vector x, N_Vector w) { int i; realtype nrm, tmp; nrm = ZERO; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VWL2Norm(NV_VEC_SW(x,i), NV_VEC_SW(w,i)); if (tmp > nrm) nrm = tmp; } return(nrm); } realtype N_VL1Norm_SensWrapper(N_Vector x) { int i; realtype nrm, tmp; nrm = ZERO; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VL1Norm(NV_VEC_SW(x,i)); if (tmp > nrm) nrm = tmp; } return(nrm); } void N_VCompare_SensWrapper(realtype c, N_Vector x, N_Vector z) { int i; for (i=0; i < NV_NVECS_SW(x); i++) N_VCompare(c, NV_VEC_SW(x,i), NV_VEC_SW(z,i)); return; } booleantype N_VInvTest_SensWrapper(N_Vector x, N_Vector z) { int i; booleantype no_zero_found, tmp; no_zero_found = SUNTRUE; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VInvTest(NV_VEC_SW(x,i), NV_VEC_SW(z,i)); if (tmp != SUNTRUE) no_zero_found = SUNFALSE; } return(no_zero_found); } booleantype N_VConstrMask_SensWrapper(N_Vector c, N_Vector x, N_Vector m) { int i; booleantype test, tmp; test = SUNTRUE; for (i=0; i < NV_NVECS_SW(x); i++) { tmp = N_VConstrMask(c, NV_VEC_SW(x,i), NV_VEC_SW(m,i)); if (tmp != SUNTRUE) test = SUNFALSE; } return(test); } realtype N_VMinQuotient_SensWrapper(N_Vector num, N_Vector denom) { int i; realtype min, tmp; min = N_VMinQuotient(NV_VEC_SW(num,0), NV_VEC_SW(denom,0)); for (i=1; i < NV_NVECS_SW(num); i++) { tmp = N_VMinQuotient(NV_VEC_SW(num,i), NV_VEC_SW(denom,i)); if (tmp < min) min = tmp; } return(min); } StanHeaders/src/sundials/sundials_math.c0000644000176200001440000000276313766554457020121 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a simple C-language math * library. * -----------------------------------------------------------------*/ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) realtype SUNRpowerI(realtype base, int exponent) { int i, expt; realtype prod; prod = ONE; expt = abs(exponent); for(i = 1; i <= expt; i++) prod *= base; if (exponent < 0) prod = ONE/prod; return(prod); } realtype SUNRpowerR(realtype base, realtype exponent) { if (base <= ZERO) return(ZERO); #if defined(SUNDIALS_USE_GENERIC_MATH) return((realtype) pow((double) base, (double) exponent)); #elif defined(SUNDIALS_DOUBLE_PRECISION) return(pow(base, exponent)); #elif defined(SUNDIALS_SINGLE_PRECISION) return(powf(base, exponent)); #elif defined(SUNDIALS_EXTENDED_PRECISION) return(powl(base, exponent)); #endif } StanHeaders/src/sundials/sundials_band.c0000644000176200001440000001520013766554457020062 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a generic BAND linear * solver package. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define ROW(i,j,smu) (i-j+smu) /* * ----------------------------------------------------- * Functions working on DlsMat * ----------------------------------------------------- */ sunindextype BandGBTRF(DlsMat A, sunindextype *p) { return(bandGBTRF(A->cols, A->M, A->mu, A->ml, A->s_mu, p)); } void BandGBTRS(DlsMat A, sunindextype *p, realtype *b) { bandGBTRS(A->cols, A->M, A->s_mu, A->ml, p, b); } void BandCopy(DlsMat A, DlsMat B, sunindextype copymu, sunindextype copyml) { bandCopy(A->cols, B->cols, A->M, A->s_mu, B->s_mu, copymu, copyml); } void BandScale(realtype c, DlsMat A) { bandScale(c, A->cols, A->M, A->mu, A->ml, A->s_mu); } void BandMatvec(DlsMat A, realtype *x, realtype *y) { bandMatvec(A->cols, x, y, A->M, A->mu, A->ml, A->s_mu); } /* * ----------------------------------------------------- * Functions working on realtype** * ----------------------------------------------------- */ sunindextype bandGBTRF(realtype **a, sunindextype n, sunindextype mu, sunindextype ml, sunindextype smu, sunindextype *p) { sunindextype c, r, num_rows; sunindextype i, j, k, l, storage_l, storage_k, last_col_k, last_row_k; realtype *a_c, *col_k, *diag_k, *sub_diag_k, *col_j, *kptr, *jptr; realtype max, temp, mult, a_kj; booleantype swap; /* zero out the first smu - mu rows of the rectangular array a */ num_rows = smu - mu; if (num_rows > 0) { for (c=0; c < n; c++) { a_c = a[c]; for (r=0; r < num_rows; r++) { a_c[r] = ZERO; } } } /* k = elimination step number */ for (k=0; k < n-1; k++, p++) { col_k = a[k]; diag_k = col_k + smu; sub_diag_k = diag_k + 1; last_row_k = SUNMIN(n-1,k+ml); /* find l = pivot row number */ l=k; max = SUNRabs(*diag_k); for (i=k+1, kptr=sub_diag_k; i <= last_row_k; i++, kptr++) { if (SUNRabs(*kptr) > max) { l=i; max = SUNRabs(*kptr); } } storage_l = ROW(l, k, smu); *p = l; /* check for zero pivot element */ if (col_k[storage_l] == ZERO) return(k+1); /* swap a(l,k) and a(k,k) if necessary */ if ( (swap = (l != k) )) { temp = col_k[storage_l]; col_k[storage_l] = *diag_k; *diag_k = temp; } /* Scale the elements below the diagonal in */ /* column k by -1.0 / a(k,k). After the above swap, */ /* a(k,k) holds the pivot element. This scaling */ /* stores the pivot row multipliers -a(i,k)/a(k,k) */ /* in a(i,k), i=k+1, ..., SUNMIN(n-1,k+ml). */ mult = -ONE / (*diag_k); for (i=k+1, kptr = sub_diag_k; i <= last_row_k; i++, kptr++) (*kptr) *= mult; /* row_i = row_i - [a(i,k)/a(k,k)] row_k, i=k+1, ..., SUNMIN(n-1,k+ml) */ /* row k is the pivot row after swapping with row l. */ /* The computation is done one column at a time, */ /* column j=k+1, ..., SUNMIN(k+smu,n-1). */ last_col_k = SUNMIN(k+smu,n-1); for (j=k+1; j <= last_col_k; j++) { col_j = a[j]; storage_l = ROW(l,j,smu); storage_k = ROW(k,j,smu); a_kj = col_j[storage_l]; /* Swap the elements a(k,j) and a(k,l) if l!=k. */ if (swap) { col_j[storage_l] = col_j[storage_k]; col_j[storage_k] = a_kj; } /* a(i,j) = a(i,j) - [a(i,k)/a(k,k)]*a(k,j) */ /* a_kj = a(k,j), *kptr = - a(i,k)/a(k,k), *jptr = a(i,j) */ if (a_kj != ZERO) { for (i=k+1, kptr=sub_diag_k, jptr=col_j+ROW(k+1,j,smu); i <= last_row_k; i++, kptr++, jptr++) (*jptr) += a_kj * (*kptr); } } } /* set the last pivot row to be n-1 and check for a zero pivot */ *p = n-1; if (a[n-1][smu] == ZERO) return(n); /* return 0 to indicate success */ return(0); } void bandGBTRS(realtype **a, sunindextype n, sunindextype smu, sunindextype ml, sunindextype *p, realtype *b) { sunindextype k, l, i, first_row_k, last_row_k; realtype mult, *diag_k; /* Solve Ly = Pb, store solution y in b */ for (k=0; k < n-1; k++) { l = p[k]; mult = b[l]; if (l != k) { b[l] = b[k]; b[k] = mult; } diag_k = a[k]+smu; last_row_k = SUNMIN(n-1,k+ml); for (i=k+1; i <= last_row_k; i++) b[i] += mult * diag_k[i-k]; } /* Solve Ux = y, store solution x in b */ for (k=n-1; k >= 0; k--) { diag_k = a[k]+smu; first_row_k = SUNMAX(0,k-smu); b[k] /= (*diag_k); mult = -b[k]; for (i=first_row_k; i <= k-1; i++) b[i] += mult*diag_k[i-k]; } } void bandCopy(realtype **a, realtype **b, sunindextype n, sunindextype a_smu, sunindextype b_smu, sunindextype copymu, sunindextype copyml) { sunindextype i, j, copySize; realtype *a_col_j, *b_col_j; copySize = copymu + copyml + 1; for (j=0; j < n; j++) { a_col_j = a[j]+a_smu-copymu; b_col_j = b[j]+b_smu-copymu; for (i=0; i < copySize; i++) b_col_j[i] = a_col_j[i]; } } void bandScale(realtype c, realtype **a, sunindextype n, sunindextype mu, sunindextype ml, sunindextype smu) { sunindextype i, j, colSize; realtype *col_j; colSize = mu + ml + 1; for(j=0; j < n; j++) { col_j = a[j]+smu-mu; for (i=0; i < colSize; i++) col_j[i] *= c; } } void bandAddIdentity(realtype **a, sunindextype n, sunindextype smu) { sunindextype j; for(j=0; j < n; j++) a[j][smu] += ONE; } void bandMatvec(realtype **a, realtype *x, realtype *y, sunindextype n, sunindextype mu, sunindextype ml, sunindextype smu) { sunindextype i, j, is, ie; realtype *col_j; for (i=0; i j-mu) ? 0 : j-mu; ie = (n-1 < j+ml) ? n-1 : j+ml; for (i=is; i<=ie; i++) y[i] += col_j[i-j+mu]*x[j]; } } StanHeaders/src/sundials/sundials_dense.c0000644000176200001440000002161213766554457020260 0ustar liggesusers/* * ----------------------------------------------------------------- * $Revision$ * $Date$ * ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh and * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a generic package of dense * matrix operations. * ----------------------------------------------------------------- */ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) #define TWO RCONST(2.0) /* * ----------------------------------------------------- * Functions working on DlsMat * ----------------------------------------------------- */ sunindextype DenseGETRF(DlsMat A, sunindextype *p) { return(denseGETRF(A->cols, A->M, A->N, p)); } void DenseGETRS(DlsMat A, sunindextype *p, realtype *b) { denseGETRS(A->cols, A->N, p, b); } sunindextype DensePOTRF(DlsMat A) { return(densePOTRF(A->cols, A->M)); } void DensePOTRS(DlsMat A, realtype *b) { densePOTRS(A->cols, A->M, b); } int DenseGEQRF(DlsMat A, realtype *beta, realtype *wrk) { return(denseGEQRF(A->cols, A->M, A->N, beta, wrk)); } int DenseORMQR(DlsMat A, realtype *beta, realtype *vn, realtype *vm, realtype *wrk) { return(denseORMQR(A->cols, A->M, A->N, beta, vn, vm, wrk)); } void DenseCopy(DlsMat A, DlsMat B) { denseCopy(A->cols, B->cols, A->M, A->N); } void DenseScale(realtype c, DlsMat A) { denseScale(c, A->cols, A->M, A->N); } void DenseMatvec(DlsMat A, realtype *x, realtype *y) { denseMatvec(A->cols, x, y, A->M, A->N); } sunindextype denseGETRF(realtype **a, sunindextype m, sunindextype n, sunindextype *p) { sunindextype i, j, k, l; realtype *col_j, *col_k; realtype temp, mult, a_kj; /* k-th elimination step number */ for (k=0; k < n; k++) { col_k = a[k]; /* find l = pivot row number */ l=k; for (i=k+1; i < m; i++) if (SUNRabs(col_k[i]) > SUNRabs(col_k[l])) l=i; p[k] = l; /* check for zero pivot element */ if (col_k[l] == ZERO) return(k+1); /* swap a(k,1:n) and a(l,1:n) if necessary */ if ( l!= k ) { for (i=0; i 0; k--) { col_k = a[k]; b[k] /= col_k[k]; for (i=0; i0) { for(i=j; i=0; i--) { col_i = a[i]; for (j=i+1; j= n) * using Householder reflections. * * On exit, the elements on and above the diagonal of A contain the n by n * upper triangular matrix R; the elements below the diagonal, with the array beta, * represent the orthogonal matrix Q as a product of elementary reflectors . * * v (of length m) must be provided as workspace. * */ int denseGEQRF(realtype **a, sunindextype m, sunindextype n, realtype *beta, realtype *v) { realtype ajj, s, mu, v1, v1_2; realtype *col_j, *col_k; sunindextype i, j, k; /* For each column...*/ for(j=0; j= n. * * v (of length m) must be provided as workspace. */ int denseORMQR(realtype **a, sunindextype m, sunindextype n, realtype *beta, realtype *vn, realtype *vm, realtype *v) { realtype *col_j, s; sunindextype i, j; /* Initialize vm */ for(i=0; i=0; j--) { col_j = a[j]; v[0] = ONE; s = vm[j]; for(i=1; i #include /* * ----------------------------------------------------------------- * Functions in the 'ops' structure * ----------------------------------------------------------------- */ N_Vector_ID N_VGetVectorID(N_Vector w) { N_Vector_ID id; id = w->ops->nvgetvectorid(w); return(id); } N_Vector N_VClone(N_Vector w) { N_Vector v = NULL; v = w->ops->nvclone(w); return(v); } N_Vector N_VCloneEmpty(N_Vector w) { N_Vector v = NULL; v = w->ops->nvcloneempty(w); return(v); } void N_VDestroy(N_Vector v) { if (v==NULL) return; v->ops->nvdestroy(v); return; } void N_VSpace(N_Vector v, sunindextype *lrw, sunindextype *liw) { v->ops->nvspace(v, lrw, liw); return; } realtype *N_VGetArrayPointer(N_Vector v) { return((realtype *) v->ops->nvgetarraypointer(v)); } void N_VSetArrayPointer(realtype *v_data, N_Vector v) { v->ops->nvsetarraypointer(v_data, v); return; } /* ----------------------------------------------------------------- * standard vector operations * ----------------------------------------------------------------- */ void N_VLinearSum(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z) { z->ops->nvlinearsum(a, x, b, y, z); return; } void N_VConst(realtype c, N_Vector z) { z->ops->nvconst(c, z); return; } void N_VProd(N_Vector x, N_Vector y, N_Vector z) { z->ops->nvprod(x, y, z); return; } void N_VDiv(N_Vector x, N_Vector y, N_Vector z) { z->ops->nvdiv(x, y, z); return; } void N_VScale(realtype c, N_Vector x, N_Vector z) { z->ops->nvscale(c, x, z); return; } void N_VAbs(N_Vector x, N_Vector z) { z->ops->nvabs(x, z); return; } void N_VInv(N_Vector x, N_Vector z) { z->ops->nvinv(x, z); return; } void N_VAddConst(N_Vector x, realtype b, N_Vector z) { z->ops->nvaddconst(x, b, z); return; } realtype N_VDotProd(N_Vector x, N_Vector y) { return((realtype) y->ops->nvdotprod(x, y)); } realtype N_VMaxNorm(N_Vector x) { return((realtype) x->ops->nvmaxnorm(x)); } realtype N_VWrmsNorm(N_Vector x, N_Vector w) { return((realtype) x->ops->nvwrmsnorm(x, w)); } realtype N_VWrmsNormMask(N_Vector x, N_Vector w, N_Vector id) { return((realtype) x->ops->nvwrmsnormmask(x, w, id)); } realtype N_VMin(N_Vector x) { return((realtype) x->ops->nvmin(x)); } realtype N_VWL2Norm(N_Vector x, N_Vector w) { return((realtype) x->ops->nvwl2norm(x, w)); } realtype N_VL1Norm(N_Vector x) { return((realtype) x->ops->nvl1norm(x)); } void N_VCompare(realtype c, N_Vector x, N_Vector z) { z->ops->nvcompare(c, x, z); return; } booleantype N_VInvTest(N_Vector x, N_Vector z) { return((booleantype) z->ops->nvinvtest(x, z)); } booleantype N_VConstrMask(N_Vector c, N_Vector x, N_Vector m) { return((booleantype) x->ops->nvconstrmask(c, x, m)); } realtype N_VMinQuotient(N_Vector num, N_Vector denom) { return((realtype) num->ops->nvminquotient(num, denom)); } /* ----------------------------------------------------------------- * fused vector operations * ----------------------------------------------------------------- */ int N_VLinearCombination(int nvec, realtype* c, N_Vector* X, N_Vector z) { int i; realtype ONE=RCONST(1.0); if (z->ops->nvlinearcombination != NULL) { return(z->ops->nvlinearcombination(nvec, c, X, z)); } else { z->ops->nvscale(c[0], X[0], z); for (i=1; iops->nvlinearsum(c[i], X[i], ONE, z, z); } return(0); } } int N_VScaleAddMulti(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z) { int i; realtype ONE=RCONST(1.0); if (x->ops->nvscaleaddmulti != NULL) { return(x->ops->nvscaleaddmulti(nvec, a, x, Y, Z)); } else { for (i=0; iops->nvlinearsum(a[i], x, ONE, Y[i], Z[i]); } return(0); } } int N_VDotProdMulti(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods) { int i; if (x->ops->nvdotprodmulti != NULL) { return(x->ops->nvdotprodmulti(nvec, x, Y, dotprods)); } else { for (i=0; iops->nvdotprod(x, Y[i]); } return(0); } } /* ----------------------------------------------------------------- * vector array operations * ----------------------------------------------------------------- */ int N_VLinearSumVectorArray(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z) { int i; if (Z[0]->ops->nvlinearsumvectorarray != NULL) { return(Z[0]->ops->nvlinearsumvectorarray(nvec, a, X, b, Y, Z)); } else { for (i=0; iops->nvlinearsum(a, X[i], b, Y[i], Z[i]); } return(0); } } int N_VScaleVectorArray(int nvec, realtype* c, N_Vector* X, N_Vector* Z) { int i; if (Z[0]->ops->nvscalevectorarray != NULL) { return(Z[0]->ops->nvscalevectorarray(nvec, c, X, Z)); } else { for (i=0; iops->nvscale(c[i], X[i], Z[i]); } return(0); } } int N_VConstVectorArray(int nvec, realtype c, N_Vector* Z) { int i, ier; if (Z[0]->ops->nvconstvectorarray != NULL) { ier = Z[0]->ops->nvconstvectorarray(nvec, c, Z); return(ier); } else { for (i=0; iops->nvconst(c, Z[i]); } return(0); } } int N_VWrmsNormVectorArray(int nvec, N_Vector* X, N_Vector* W, realtype* nrm) { int i, ier; if (X[0]->ops->nvwrmsnormvectorarray != NULL) { ier = X[0]->ops->nvwrmsnormvectorarray(nvec, X, W, nrm); return(ier); } else { for (i=0; iops->nvwrmsnorm(X[i], W[i]); } return(0); } } int N_VWrmsNormMaskVectorArray(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm) { int i, ier; if (id->ops->nvwrmsnormmaskvectorarray != NULL) { ier = id->ops->nvwrmsnormmaskvectorarray(nvec, X, W, id, nrm); return(ier); } else { for (i=0; iops->nvwrmsnormmask(X[i], W[i], id); } return(0); } } int N_VScaleAddMultiVectorArray(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z) { int i, j, ier; realtype ONE=RCONST(1.0); N_Vector* YY=NULL; N_Vector* ZZ=NULL; if (X[0]->ops->nvscaleaddmultivectorarray != NULL) { ier = X[0]->ops->nvscaleaddmultivectorarray(nvec, nsum, a, X, Y, Z); return(ier); } else if (X[0]->ops->nvscaleaddmulti != NULL ) { /* allocate arrays of vectors */ YY = (N_Vector *) malloc(nsum * sizeof(N_Vector)); ZZ = (N_Vector *) malloc(nsum * sizeof(N_Vector)); for (i=0; iops->nvscaleaddmulti(nsum, a, X[i], YY, ZZ); if (ier != 0) break; } /* free array of vectors */ free(YY); free(ZZ); return(ier); } else { for (i=0; iops->nvlinearsum(a[j], X[i], ONE, Y[j][i], Z[j][i]); } } return(0); } } int N_VLinearCombinationVectorArray(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z) { int i, j, ier; realtype ONE=RCONST(1.0); N_Vector* Y=NULL; if (Z[0]->ops->nvlinearcombinationvectorarray != NULL) { ier = Z[0]->ops->nvlinearcombinationvectorarray(nvec, nsum, c, X, Z); return(ier); } else if (Z[0]->ops->nvlinearcombination != NULL ) { /* allocate array of vectors */ Y = (N_Vector *) malloc(nsum * sizeof(N_Vector)); for (i=0; iops->nvlinearcombination(nsum, c, Y, Z[i]); if (ier != 0) break; } /* free array of vectors */ free(Y); return(ier); } else { for (i=0; iops->nvscale(c[0], X[0][i], Z[i]); for (j=1; jops->nvlinearsum(c[j], X[j][i], ONE, Z[i], Z[i]); } } return(0); } } /* * ----------------------------------------------------------------- * Additional functions exported by the generic NVECTOR: * N_VCloneEmptyVectorArray * N_VCloneVectorArray * N_VDestroyVectorArray * ----------------------------------------------------------------- */ N_Vector *N_VCloneEmptyVectorArray(int count, N_Vector w) { N_Vector *vs = NULL; int j; if (count <= 0) return(NULL); vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = N_VCloneEmpty(w); if (vs[j] == NULL) { N_VDestroyVectorArray(vs, j-1); return(NULL); } } return(vs); } N_Vector *N_VCloneVectorArray(int count, N_Vector w) { N_Vector *vs = NULL; int j; if (count <= 0) return(NULL); vs = (N_Vector *) malloc(count * sizeof(N_Vector)); if(vs == NULL) return(NULL); for (j = 0; j < count; j++) { vs[j] = N_VClone(w); if (vs[j] == NULL) { N_VDestroyVectorArray(vs, j-1); return(NULL); } } return(vs); } void N_VDestroyVectorArray(N_Vector *vs, int count) { int j; if (vs==NULL) return; for (j = 0; j < count; j++) N_VDestroy(vs[j]); free(vs); vs = NULL; return; } StanHeaders/src/sundials/sundials_linearsolver.c0000644000176200001440000000624013766554457021667 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner, Carol Woodward, Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for a generic SUNLINEARSOLVER * package. It contains the implementation of the SUNLinearSolver * operations listed in sundials_linearsolver.h * ----------------------------------------------------------------- */ #include #include /* * ----------------------------------------------------------------- * Functions in the 'ops' structure * ----------------------------------------------------------------- */ SUNLinearSolver_Type SUNLinSolGetType(SUNLinearSolver S) { SUNLinearSolver_Type type; type = S->ops->gettype(S); return(type); } int SUNLinSolSetATimes(SUNLinearSolver S, void* A_data, ATimesFn ATimes) { if (S->ops->setatimes) return ((int) S->ops->setatimes(S, A_data, ATimes)); else return SUNLS_SUCCESS; } int SUNLinSolSetPreconditioner(SUNLinearSolver S, void* P_data, PSetupFn Pset, PSolveFn Psol) { if (S->ops->setpreconditioner) return ((int) S->ops->setpreconditioner(S, P_data, Pset, Psol)); else return SUNLS_SUCCESS; } int SUNLinSolSetScalingVectors(SUNLinearSolver S, N_Vector s1, N_Vector s2) { if (S->ops->setscalingvectors) return ((int) S->ops->setscalingvectors(S, s1, s2)); else return SUNLS_SUCCESS; } int SUNLinSolInitialize(SUNLinearSolver S) { return ((int) S->ops->initialize(S)); } int SUNLinSolSetup(SUNLinearSolver S, SUNMatrix A) { return ((int) S->ops->setup(S, A)); } int SUNLinSolSolve(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol) { return ((int) S->ops->solve(S, A, x, b, tol)); } int SUNLinSolNumIters(SUNLinearSolver S) { if (S->ops->numiters) return ((int) S->ops->numiters(S)); else return 0; } realtype SUNLinSolResNorm(SUNLinearSolver S) { if (S->ops->resnorm) return ((realtype) S->ops->resnorm(S)); else return RCONST(0.0); } N_Vector SUNLinSolResid(SUNLinearSolver S) { if (S->ops->resid) return ((N_Vector) S->ops->resid(S)); else return NULL; } long int SUNLinSolLastFlag(SUNLinearSolver S) { if (S->ops->lastflag) return ((long int) S->ops->lastflag(S)); else return SUNLS_SUCCESS; } int SUNLinSolSpace(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS) { if (S->ops->space) return ((int) S->ops->space(S, lenrwLS, leniwLS)); else { *lenrwLS = 0; *leniwLS = 0; return SUNLS_SUCCESS; } } int SUNLinSolFree(SUNLinearSolver S) { if (S==NULL) return 0; S->ops->free(S); return 0; } StanHeaders/src/sundials/sundials_direct.c0000644000176200001440000001477213766554457020445 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the implementation file for operations to be used by a * generic direct linear solver. * -----------------------------------------------------------------*/ #include #include #include #include #define ZERO RCONST(0.0) #define ONE RCONST(1.0) DlsMat NewDenseMat(sunindextype M, sunindextype N) { DlsMat A; sunindextype j; if ( (M <= 0) || (N <= 0) ) return(NULL); A = NULL; A = (DlsMat) malloc(sizeof *A); if (A==NULL) return (NULL); A->data = (realtype *) malloc(M * N * sizeof(realtype)); if (A->data == NULL) { free(A); A = NULL; return(NULL); } A->cols = (realtype **) malloc(N * sizeof(realtype *)); if (A->cols == NULL) { free(A->data); A->data = NULL; free(A); A = NULL; return(NULL); } for (j=0; j < N; j++) A->cols[j] = A->data + j * M; A->M = M; A->N = N; A->ldim = M; A->ldata = M*N; A->type = SUNDIALS_DENSE; return(A); } realtype **newDenseMat(sunindextype m, sunindextype n) { sunindextype j; realtype **a; if ( (n <= 0) || (m <= 0) ) return(NULL); a = NULL; a = (realtype **) malloc(n * sizeof(realtype *)); if (a == NULL) return(NULL); a[0] = NULL; a[0] = (realtype *) malloc(m * n * sizeof(realtype)); if (a[0] == NULL) { free(a); a = NULL; return(NULL); } for (j=1; j < n; j++) a[j] = a[0] + j * m; return(a); } DlsMat NewBandMat(sunindextype N, sunindextype mu, sunindextype ml, sunindextype smu) { DlsMat A; sunindextype j, colSize; if (N <= 0) return(NULL); A = NULL; A = (DlsMat) malloc(sizeof *A); if (A == NULL) return (NULL); colSize = smu + ml + 1; A->data = NULL; A->data = (realtype *) malloc(N * colSize * sizeof(realtype)); if (A->data == NULL) { free(A); A = NULL; return(NULL); } A->cols = NULL; A->cols = (realtype **) malloc(N * sizeof(realtype *)); if (A->cols == NULL) { free(A->data); free(A); A = NULL; return(NULL); } for (j=0; j < N; j++) A->cols[j] = A->data + j * colSize; A->M = N; A->N = N; A->mu = mu; A->ml = ml; A->s_mu = smu; A->ldim = colSize; A->ldata = N * colSize; A->type = SUNDIALS_BAND; return(A); } realtype **newBandMat(sunindextype n, sunindextype smu, sunindextype ml) { realtype **a; sunindextype j, colSize; if (n <= 0) return(NULL); a = NULL; a = (realtype **) malloc(n * sizeof(realtype *)); if (a == NULL) return(NULL); colSize = smu + ml + 1; a[0] = NULL; a[0] = (realtype *) malloc(n * colSize * sizeof(realtype)); if (a[0] == NULL) { free(a); a = NULL; return(NULL); } for (j=1; j < n; j++) a[j] = a[0] + j * colSize; return(a); } void DestroyMat(DlsMat A) { free(A->data); A->data = NULL; free(A->cols); free(A); A = NULL; } void destroyMat(realtype **a) { free(a[0]); a[0] = NULL; free(a); a = NULL; } int *NewIntArray(int N) { int *vec; if (N <= 0) return(NULL); vec = NULL; vec = (int *) malloc(N * sizeof(int)); return(vec); } int *newIntArray(int n) { int *v; if (n <= 0) return(NULL); v = NULL; v = (int *) malloc(n * sizeof(int)); return(v); } sunindextype *NewIndexArray(sunindextype N) { sunindextype *vec; if (N <= 0) return(NULL); vec = NULL; vec = (sunindextype *) malloc(N * sizeof(sunindextype)); return(vec); } sunindextype *newIndexArray(sunindextype n) { sunindextype *v; if (n <= 0) return(NULL); v = NULL; v = (sunindextype *) malloc(n * sizeof(sunindextype)); return(v); } realtype *NewRealArray(sunindextype N) { realtype *vec; if (N <= 0) return(NULL); vec = NULL; vec = (realtype *) malloc(N * sizeof(realtype)); return(vec); } realtype *newRealArray(sunindextype m) { realtype *v; if (m <= 0) return(NULL); v = NULL; v = (realtype *) malloc(m * sizeof(realtype)); return(v); } void DestroyArray(void *V) { free(V); V = NULL; } void destroyArray(void *v) { free(v); v = NULL; } void AddIdentity(DlsMat A) { sunindextype i; switch (A->type) { case SUNDIALS_DENSE: for (i=0; iN; i++) A->cols[i][i] += ONE; break; case SUNDIALS_BAND: for (i=0; iM; i++) A->cols[i][A->s_mu] += ONE; break; } } void SetToZero(DlsMat A) { sunindextype i, j, colSize; realtype *col_j; switch (A->type) { case SUNDIALS_DENSE: for (j=0; jN; j++) { col_j = A->cols[j]; for (i=0; iM; i++) col_j[i] = ZERO; } break; case SUNDIALS_BAND: colSize = A->mu + A->ml + 1; for (j=0; jM; j++) { col_j = A->cols[j] + A->s_mu - A->mu; for (i=0; itype) { case SUNDIALS_DENSE: STAN_SUNDIALS_FPRINTF(outfile, "\n"); for (i=0; i < A->M; i++) { for (j=0; j < A->N; j++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%12Lg ", DENSE_ELEM(A,i,j)); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%12g ", DENSE_ELEM(A,i,j)); #else STAN_SUNDIALS_FPRINTF(outfile, "%12g ", DENSE_ELEM(A,i,j)); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); } STAN_SUNDIALS_FPRINTF(outfile, "\n"); break; case SUNDIALS_BAND: a = A->cols; STAN_SUNDIALS_FPRINTF(outfile, "\n"); for (i=0; i < A->N; i++) { start = SUNMAX(0,i-A->ml); finish = SUNMIN(A->N-1,i+A->mu); for (j=0; j < start; j++) STAN_SUNDIALS_FPRINTF(outfile, "%12s ",""); for (j=start; j <= finish; j++) { #if defined(SUNDIALS_EXTENDED_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%12Lg ", a[j][i-j+A->s_mu]); #elif defined(SUNDIALS_DOUBLE_PRECISION) STAN_SUNDIALS_FPRINTF(outfile, "%12g ", a[j][i-j+A->s_mu]); #else STAN_SUNDIALS_FPRINTF(outfile, "%12g ", a[j][i-j+A->s_mu]); #endif } STAN_SUNDIALS_FPRINTF(outfile, "\n"); } STAN_SUNDIALS_FPRINTF(outfile, "\n"); break; } } StanHeaders/vignettes/0000755000176200001440000000000013766554455014507 5ustar liggesusersStanHeaders/vignettes/stanmath.Rmd0000644000176200001440000004232713711604070016755 0ustar liggesusers--- title: "Using the Stan Math C++ Library" author: "Stan Development Team" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Using the Stan Math C++ Library} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} editor_options: chunk_output_type: inline --- ```{r setup, include = FALSE} options(width = 100) knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) local({ hook_output <- knitr::knit_hooks$get('output') knitr::knit_hooks$set(output = function(x, options) { if (!is.null(options$max.height)) options$attr.output <- c( options$attr.output, sprintf('style="max-height: %s;"', options$max.height) ) hook_output(x, options) }) }) Sys.setenv(USE_CXX14 = "1") set.seed(12345) ``` # Using the **StanHeaders** Package from Other R Packages The **StanHeaders** package contains no R functions. To use the Stan Math Library in other packages, it is often sufficient to specify ``` LinkingTo: StanHeaders (>= 2.21.0), RcppParallel (>= 5.0.1) ``` in the DESCRIPTION file of another package and put something like ``` CXX_STD = CXX14 PKG_CXXFLAGS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::CxxFlags()") \ $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::CxxFlags()") PKG_LIBS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::RcppParallelLibs()") \ $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::LdFlags()") ``` in the src/Makevars and src/Makevars.win files and put `GNU make` in the `SystemRequirements:` field of the package's DESCRIPTION file. If, in addition, the other package needs to utilize the MCMC, optimization, variational inference, or parsing facilities of the Stan Library, then it is also necessary to include the `src` directory of **StanHeaders** in the other package's `PKG_CXXFLAGS` in the src/Makevars and src/Makevars.win files with something like ``` STANHEADERS_SRC = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "message()" \ -e "cat(system.file('include', 'src', package = 'StanHeaders', mustWork = TRUE))" \ -e "message()" | grep "StanHeaders") PKG_CXXFLAGS += -I"$(STANHEADERS_SRC)" ``` # Calling functions in the **StanHeaders** Package from R The only exposed R function in the in the **StanHeaders** package is `stanFunction`, which can be used to call most functions in the Stan Math Library. ```{r} example(stanFunction, package = "StanHeaders", run.dontrun = TRUE) ``` ```{css, echo=FALSE} .scroll-100 { max-height: 100px; overflow-y: auto; background-color: inherit; } ``` The `functions` object defined in this example lists the many Stan functions that could be called (if all their arguments are numeric, see `help(stanFunction, package = "StanHeaders")` for details) ```{r, echo = FALSE, warning = FALSE, class.output="scroll-100"} if (length(functions) %% 2 == 1) { functions <- c(functions, "") } functions <- matrix(functions, ncol = 2, byrow = TRUE) print(functions) ``` # Using Higher-Order Functions in the **StanHeaders** Package This section will demonstrate how to use some of the C++ functions in the **StanHeaders** package whose first argument is another C++ function, in which case the `stanFunction` in the previous section will not work and you have to write your own C++. ## Derivatives and Minimization The following is a toy example of using the Stan Math library via `Rcpp::sourceCpp`: to minimize the function $$\left(\mathbf{x} - \mathbf{a}\right)^\top \left(\mathbf{x} - \mathbf{a}\right)$$ which has a global minimum when $\mathbf{x} = \mathbf{a}$. To find this minimum with autodifferentiation, we need to define the objective function. Then, its gradient with respect to $\mathbf{x}$, which we know is $2\left(\mathbf{x} - \mathbf{a}\right)$ in this case, can be calculated by autodifferentiation. At the optimum (or on the way to the optimum), we might want to evaluate the Hessian matrix, which we know is $2\mathbf{I}$, but would need an additional function to evaluate it via autodifferentiation. Finally, one could reconceptualize the problem as solving a homogeneous system of equations where the gradient is set equal to a vector of zeros. The `stan::math::algebra_solver` function can solve such a system using autodifferentiation to obtain the Jacobian, which we know to be the identity matrix in this case. ```{r} Sys.setenv(PKG_CXXFLAGS = StanHeaders:::CxxFlags(as_character = TRUE)) SH <- system.file(ifelse(.Platform$OS.type == "windows", "libs", "lib"), .Platform$r_arch, package = "StanHeaders", mustWork = TRUE) Sys.setenv(PKG_LIBS = paste0(StanHeaders:::LdFlags(as_character = TRUE), " -L", shQuote(SH), " -lStanHeaders")) ``` Here is C++ code that does all of the above, except for the part of finding the optimum, which is done using the R function `optim` below. ```{Rcpp} // [[Rcpp::depends(BH)]] // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(StanHeaders)]] #include // stuff from fwd/ must come first #include // then stuff from mix/ must come next #include // finally pull in everything from rev/ & prim/ #include #include // do this AFTER including stan/math // [[Rcpp::plugins(cpp14)]] /* Objective function */ // [[Rcpp::export]] auto f(Eigen::VectorXd x, Eigen::VectorXd a) { // objective function in doubles using stan::math::dot_self; // dot_self() is a dot product with self return dot_self( (x - a).eval() ); // .eval() yields a Eigen::VectorXd } /* Gradient */ // [[Rcpp::export]] auto g(Eigen::VectorXd x, Eigen::VectorXd a) { // gradient by AD using Stan double fx; Eigen::VectorXd grad_fx; using stan::math::dot_self; stan::math::gradient([&a](auto x) { return dot_self( (x - a).eval() ); }, x, fx, grad_fx); return grad_fx; } /* Hessian */ // [[Rcpp::export]] auto H(Eigen::VectorXd x, Eigen::VectorXd a) { // Hessian by AD using Stan double fx; Eigen::VectorXd grad_fx; Eigen::MatrixXd H; using stan::math::dot_self; using stan::math::subtract; // necessary to get the type promotion correct stan::math::hessian([&a](auto x) { return dot_self(subtract(x, a)); }, x, fx, grad_fx, H); return H; } /* Jacobian */ // [[Rcpp::export]] auto J(Eigen::VectorXd x, Eigen::VectorXd a) { // not actually used Eigen::VectorXd fx; Eigen::MatrixXd J; using stan::math::dot_self; stan::math::jacobian([&a](auto x) { return (2 * (x - a)).eval(); }, x, fx, J); return J; } struct equations_functor { template inline Eigen::Matrix operator()(const Eigen::Matrix& x, const Eigen::Matrix& theta, const std::vector& x_r, const std::vector& x_i, std::ostream* pstream__) const { return 2 * (x - stan::math::to_vector(x_r)).eval(); } }; // [[Rcpp::export]] auto solution(Eigen::VectorXd a, Eigen::VectorXd guess) { Eigen::VectorXd theta; auto x_r = stan::math::to_array_1d(a); equations_functor f; auto x = stan::math::algebra_solver(f, guess, theta, x_r, {}); return x; } ``` In this compiled RMarkdown document, the **knitr** package has exported functions `f`, `g`, `H`, `J` and `solution` (but not `equations_functor`) to R's global environment using the `sourceCpp` function in the **Rcpp** package, so that they can now be called from R. Here we find the optimum starting from a random point in three dimensions: ```{r} x <- optim(rnorm(3), fn = f, gr = g, a = 1:3, method = "BFGS", hessian = TRUE) x$par x$hessian H(x$par, a = 1:3) J(x$par, a = 1:3) solution(a = 1:3, guess = rnorm(3)) ``` # Integrals and Ordinary Differential Equations The Stan Math library can do one-dimensional numerical integration and can solve stiff and non-stiff systems of differential equations, such as the harmonic oscillator example below. Solving stiff systems utilizes the CVODES library, which is included in **StanHeaders**. ```{Rcpp} // [[Rcpp::depends(BH)]] // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(StanHeaders)]] #include // pulls in everything from rev/ and prim/ #include #include // do this AFTER including stan/math // [[Rcpp::plugins(cpp14)]] /* Definite integrals */ // [[Rcpp::export]] double Cauchy(double scale) { std::vector theta; auto half = stan::math::integrate_1d([](auto x, auto xc, auto theta, auto x_r, auto x_i, auto msgs) { return exp(stan::math::cauchy_lpdf(x, 0, x_r[0])); }, -scale, scale, theta, {scale}, {}, Rcpp::Rcout, 1e-7); return half * 2; // should equal 1 for any positive scale } /* Ordinary Differential Equations */ // [[Rcpp::export]] auto nonstiff(Eigen::MatrixXd A, Eigen::VectorXd y0) { using stan::math::integrate_ode_rk45; using stan::math::to_vector; using stan::math::to_array_1d; std::vector theta; std::vector times = {1, 2}; auto y = integrate_ode_rk45([&A](auto t, auto y, auto theta, auto x_r, auto x_i, std::ostream *msgs) { return to_array_1d( (A * to_vector(y)).eval() ); }, to_array_1d(y0), 0, times, theta, {}, {}); Eigen::VectorXd truth = stan::math::matrix_exp(A) * y0; return (to_vector(y[0]) - truth).eval(); // should be "zero" } // [[Rcpp::export]] auto stiff(Eigen::MatrixXd A, Eigen::VectorXd y0) { // not actually stiff using stan::math::integrate_ode_bdf; // but use the stiff solver anyways using stan::math::to_vector; using stan::math::to_array_1d; std::vector theta; std::vector times = {1, 2}; auto y = integrate_ode_bdf([&A](auto t, auto y, auto theta, auto x_r, auto x_i, std::ostream *msgs) { return to_array_1d( (A * to_vector(y)).eval() ); }, to_array_1d(y0), 0, times, theta, {}, {}); Eigen::VectorXd truth = stan::math::matrix_exp(A) * y0; return (to_vector(y[0]) - truth).eval(); // should be "zero" } ``` Again, in this compiled RMarkdown document, the **knitr** package has exported the `Cauchy`, `nonstiff` and `stiff` functions to R's global environment using the `sourceCpp` function in the **Rcpp** package so that they can be called from R. First, we numerically integrate the Cauchy PDF over its interquartile range --- which has an area of $\frac{1}{2}$ --- that we then double to verify that it is almost within machine precision of $1$. ```{r} all.equal(1, Cauchy(rexp(1)), tol = 1e-15) ``` Next, we consider the system of differential equations $$\frac{d}{dt}\mathbf{y} = \mathbf{A}\mathbf{y}$$ where $\mathbf{A}$ is a square matrix such as that for a simple harmonic oscillator $$\mathbf{A} = \begin{bmatrix}0 & 1 \\ -1 & -\theta\end{bmatrix}$$ for $\theta \in \left(0,1\right)$. The solution for $\mathbf{y}_t = e^{t\mathbf{A}}\mathbf{y}_0$ can be obtained via the matrix exponential function, which is available in the Stan Math Library, but it can also be obtained numerically using a fourth-order Runge-Kutta solver, which is appropriate for non-stiff systems of ODEs, such as this one. However, it is possible, albeit less efficient in this case, to use the backward-differentiation formula solver for stiff systems of ODEs. In both cases, we calculate the difference between the analytical solution and the numerical one, and the stiff version does produce somewhat better accuracy in this case. ```{r} A <- matrix(c(0, -1, 1, -runif(1)), nrow = 2, ncol = 2) y0 <- rexp(2) all.equal(nonstiff(A, y0), c(0, 0), tol = 1e-5) all.equal( stiff(A, y0), c(0, 0), tol = 1e-8) ``` # Map and Parellelization The Stan Math Library includes the `map_rect` function, which applies a function to each element of rectangular arrays and returns a vector, making it a bit like a restricted version of R's `sapply` function. However, `map_rect` can also be executed in parallel by defining the pre-processor directive `STAN_THREADS` and then setting the `STAN_NUM_THREADS` environmental variable to be the number of threads to use, as in ```{r} Sys.setenv(STAN_NUM_THREADS = 2) # specify -1 to use all available cores ``` Below is C++ code to test whether an integer is prime, using a rather brute-force algorithm and running it in parallel via `map_rect`. ```{Rcpp} // [[Rcpp::depends(BH)]] // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(StanHeaders)]] #include // pulls in everything from rev/ and prim/ #include #include // do this AFTER including stan/math // [[Rcpp::plugins(cpp14)]] // see https://en.wikipedia.org/wiki/Primality_test#Pseudocode struct is_prime { is_prime() {} template auto operator()(const Eigen::Matrix& eta, const Eigen::Matrix& theta, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs = 0) const { Eigen::VectorXd res(1); // can only return double or var vectors int n = x_i[0]; if (n <= 3) { res.coeffRef(0) = n > 1; return res; } else if ( (n % 2 == 0) || (n % 3 == 0) ) { res.coeffRef(0) = false; return res; } int i = 5; while (i * i <= n) { if ( (n % i == 0) || (n % (i + 2) == 0) ) { res.coeffRef(0) = false; return res; } i += 6; } res.coeffRef(0) = true; return res; } }; /* parallelization */ // [[Rcpp::export]] auto psapply(std::vector > n) { std::vector eta(n.size()); // these all have to be the same size Eigen::VectorXd theta; std::vector > x_d(n.size()); return stan::math::map_rect<0, is_prime>(theta, eta, x_d, n, &Rcpp::Rcout); } ``` Since the signature for `n` is a `std::vector >`, we have to pass it from R as a list (which is converted to the outer `std::vector<>`) of integer vectors (which is converted to the inner `std::vector`) that happen to be of size one in this case. ```{r} odd <- seq.int(from = 2^25 - 1, to = 2^26 - 1, by = 2) tail(psapply(n = as.list(odd))) == 1 # check your process manager while this is running ``` Thus, $2^{26} - 5 = 67,108,859$ is a prime number. # Defining a Stan Model in C++ The Stan _language_ does not have much support for sparse matrices for a variety of reasons. Essentially the only applicable function is `csr_matrix_times_vector`, which pre-multiplies a vector by a sparse matrix in compressed row storage by taking as arguments its number of rows, columns, non-zero values, column indices of non-zero values, and locations where the non-zero values start in each row. While the `csr_matrix_times_vector` function could be used to implement the example below, we illustrate how to use the sparse data structures in the **Matrix** and **RcppEigen** packages in a Stan model written in C++, which could easily be extended to more complicated models with sparse data structures. Our C++ file for the log-likelihood of a linear model with a sparse design matrix reads as ```{r, echo = FALSE, comment = ""} cat(readLines("sparselm_stan.hpp"), sep = "\n") ``` To use it from R, we call the `exposeClass` function in the **Rcpp** package with the necessary arguments and then call `sourceCpp` on the file it wrote in the temporary directory: ```{r, message = FALSE} library(Rcpp) tf <- tempfile(fileext = "Module.cpp") exposeClass("sparselm_stan", constructors = list(c("Eigen::Map >", "Eigen::VectorXd")), fields = c("X", "y"), methods = c("log_prob<>", "gradient<>"), rename = c(log_prob = "log_prob<>", gradient = "gradient<>"), header = c("// [[Rcpp::depends(BH)]]", "// [[Rcpp::depends(RcppEigen)]]", "// [[Rcpp::depends(RcppParallel)]", "// [[Rcpp::depends(StanHeaders)]]", "// [[Rcpp::plugins(cpp14)]]", paste0("#include <", file.path(getwd(), "sparselm_stan.hpp"), ">")), file = tf, Rfile = FALSE) Sys.setenv(PKG_CXXFLAGS = paste0(Sys.getenv("PKG_CXXFLAGS"), " -I", system.file("include", "src", package = "StanHeaders", mustWork = TRUE))) sourceCpp(tf) sparselm_stan ``` At this point, we need a sparse design matrix and (dense) outcome vector to pass to the constructor. The former can be created with a variety of functions in the **Matrix** package, such as ```{r} dd <- data.frame(a = gl(3, 4), b = gl(4, 1, 12)) X <- Matrix::sparse.model.matrix(~ a + b, data = dd) X ``` Finally, we call the `new` function in the **methods** package, which essentially calls our C++ constructor and provides an R interface to the instantiated object, which contains the `log_prob` and `gradient` methods we defined and can be called with arbitrary inputs. ```{r} sm <- new(sparselm_stan, X = X, y = rnorm(nrow(X))) sm$log_prob(c(beta = rnorm(ncol(X)), log_sigma = log(pi))) round(sm$gradient(c(beta = rnorm(ncol(X)), log_sigma = log(pi))), digits = 4) ``` StanHeaders/vignettes/sparselm_stan.hpp0000644000176200001440000000400413447465733020065 0ustar liggesusers#include #include #include class sparselm_stan { public: // these would ordinarily be private in the C++ code generated by Stan Eigen::Map > X; Eigen::VectorXd y; sparselm_stan(Eigen::Map > X, Eigen::VectorXd y) : X(X), y(y) {} template // propto__ is usually true but causes log_prob() to return 0 when called from R // jacobian__ is usually true for MCMC but typically is false for optimization T__ log_prob(std::vector& params_r__) const { using namespace stan::math; T__ lp__(0.0); accumulator lp_accum__; // set up model parameters std::vector params_i__; stan::io::reader in__(params_r__, params_i__); auto beta = in__.vector_constrain(X.cols()); T__ sigma; if (jacobian__) sigma = in__.scalar_lb_constrain(0, lp__); else sigma = in__.scalar_lb_constrain(0); // log-likelihood (should add priors) lp_accum__.add(lp__); lp_accum__.add(normal_lpdf(y, (X * beta).eval(), sigma)); return lp_accum__.sum(); } template std::vector gradient(std::vector& params_r__) const { // Calculate gradients using reverse-mode autodiff // although you could do them analytically in this case using std::vector; using stan::math::var; double lp; std::vector gradient; try { vector ad_params_r(params_r__.size()); for (size_t i = 0; i < params_r__.size(); ++i) { var var_i(params_r__[i]); ad_params_r[i] = var_i; } var adLogProb = this->log_prob(ad_params_r); lp = adLogProb.val(); adLogProb.grad(ad_params_r, gradient); } catch (const std::exception &ex) { stan::math::recover_memory(); throw; } stan::math::recover_memory(); return gradient; } }; StanHeaders/vignettes/.install_extras0000644000176200001440000000002313447472267017533 0ustar liggesuserssparselm_stan.hpp StanHeaders/R/0000755000176200001440000000000013766553221012666 5ustar liggesusersStanHeaders/R/stanFunction.R0000644000176200001440000000765513765162636015506 0ustar liggesusersstanFunction <- function(function_name, ..., env = parent.frame(), rebuild = FALSE, cacheDir = getOption("rcpp.cache.dir", tempdir()), showOutput = verbose, verbose = getOption("verbose")) { make_type <- function(x, recursive = FALSE) { is_array <- is.list(x) if (is_array) { base_type <- make_type(x[[1L]], recursive = TRUE) if (recursive) return(base_type) type <- sub("const ", "", base_type) j <- 1L while(j <= length(x) && is.list(x[[j]])) { type <- paste0("std::vector<", type, " >") j <- j + 1L } type <- paste0("const std::vector<", type, " >&") return(type) } Eigen <- FALSE if (is.matrix(x)) { Eigen <- TRUE if (nrow(x) == 1L) type <- "stan::math::row_vector_d" else type <- "stan::math::matrix_d" } else if (length(x) > 1L) { if (is.integer(x)) { type <- "std::vector" } else { Eigen <- TRUE type <- "stan::math::vector_d" } } else if (is.integer(x)) { type <- "int" } else if (is.numeric(x)) { type <- "double" } else stop(paste("all arguments to", function_name, "must be matrices,", "vectors, integers, doubles or lists thereof")) if (Eigen) type <- paste0("const ", type, "&") else type <- paste0("const ", type) return(type) } DOTS <- list(...) types <- sapply(DOTS, FUN = make_type) double_lists <- types == "const std::vector&" if (any(double_lists)) types[double_lists] <- "const List&" int_lists <- types == "const std::vector&" if (any(int_lists)) types[int_lists] <- "const List&" code <- paste0("auto ", function_name, "(", paste(types, names(types), collapse = ", "), ") { return stan::math::", function_name, "(", paste(ifelse(double_lists, paste0("std::vector(", names(types), ".begin(), ", names(types), ".end())"), ifelse(int_lists, paste0("std::vector(", names(types), ".begin(), ", names(types), ".end())"), names(types))), collapse = ", "), "); }") incl <- dir(system.file("include", "stan", "math", "prim", package = "StanHeaders", mustWork = TRUE), pattern = "hpp$") incl <- setdiff(incl, "core.hpp") incl <- paste0("#include ") if (grepl("_rng$", function_name)) { create_rng <- system.file("include", "src", "stan", "services", "util", "create_rng.hpp", package = "StanHeaders", mustWork = TRUE) op <- options("useFancyQuotes") options(useFancyQuotes = FALSE) on.exit(options(useFancyQuotes = op)) incl <- c(incl, paste0('#include ', dQuote(create_rng))) code <- sub(") {", ", const int random_seed = 0) {", code, fixed = TRUE) code <- sub(" return ", "boost::ecuyer1988 base_rng__ = stan::services::util::create_rng(random_seed, 0); return ", code) code <- sub("); }", ", base_rng__); }", code, fixed = TRUE) } old_USE_CXX14 <- Sys.getenv("USE_CXX14") on.exit(Sys.setenv(USE_CXX14 = old_USE_CXX14)) Sys.setenv(USE_CXX14 = "1") Rcpp::cppFunction(code, depends = c("StanHeaders", "RcppEigen", "BH"), includes = incl, env = env, rebuild = rebuild, cacheDir = cacheDir, showOutput = showOutput, verbose = verbose) if (grepl("_rng$", function_name)) { fun <- get(function_name, envir = env, mode = "function") formals(fun)$random_seed <- quote(sample.int(.Machine$integer.max, size = 1L)) assign(function_name, value = fun, envir = env) } return(do.call(function_name, args = DOTS, envir = env)) } StanHeaders/R/Flags.R0000644000176200001440000000114013766553220014040 0ustar liggesusersCxxFlags <- function(as_character = FALSE) { TBB <- system.file("include", package = "RcppParallel", mustWork = TRUE) CXXFLAGS <- paste0("-I", shQuote(TBB), " -D_REENTRANT -DSTAN_THREADS") if (isTRUE(as_character)) return(CXXFLAGS) cat(CXXFLAGS, " ") return(invisible(NULL)) } LdFlags <- function(as_character = FALSE) { TBB <- system.file("lib", .Platform$r_arch, package = "RcppParallel", mustWork = TRUE) PKG_LIBS <- paste0("-L", shQuote(TBB), " -Wl,-rpath,", shQuote(TBB), " -ltbb -ltbbmalloc") if (isTRUE(as_character)) return(PKG_LIBS) cat(PKG_LIBS, " ") return(invisible(NULL)) } StanHeaders/MD50000644000176200001440000057124313766604372013015 0ustar liggesusers055a503b0d99a2ce3f28e639b7e68063 *DESCRIPTION e9654ca8e0359948dffe0bb36f0c0f43 *LICENSE c154f76504a2c135d15e3a5a519e6034 *NAMESPACE 76b04b76663f19ce7ff1a44fad25f892 *R/Flags.R d3b9c840b94ace97f0e25e79587d3468 *R/stanFunction.R 1bef644bc37ebb8b292bcd744defa266 *build/vignette.rds 916f334f1d0f848682950a9322536443 *inst/CITATION d9f299a822d38c4fd8a3eb612ba4bbfd *inst/doc/sparselm_stan.hpp 00d8fe61c284a23b22ecb51e99976aff *inst/doc/stanmath.R d9e4def70bfef3a9124fe4edd9179a2d *inst/doc/stanmath.Rmd 077976d8832748f0f33e3266fb39371f *inst/doc/stanmath.html 62deff229f361611808284733482dc7f *inst/include/cvodes/cvodes.h 9fd560a0e6b868e04325aa420e25ce7b *inst/include/cvodes/cvodes_bandpre.h af6852524cc04a541dedf2cffcb096a9 *inst/include/cvodes/cvodes_bbdpre.h b5d265ac660ac706f02ef14d86fb47b9 *inst/include/cvodes/cvodes_diag.h 9a9c82233b13e61b742983d3e4fe90c0 *inst/include/cvodes/cvodes_direct.h 41e20c8457cf3b3c24349116796e7770 *inst/include/cvodes/cvodes_ls.h 60574a3ce67de9990213449b753a2445 *inst/include/cvodes/cvodes_spils.h 033ab7c3435fb3d8c9a0b7781ef4303d *inst/include/idas/idas.h 21abfab62627aac528f132767c9afb64 *inst/include/idas/idas_bbdpre.h 16b5bfec0300db38707dfbaa20d4c4af *inst/include/idas/idas_direct.h 6ec6d825ce472a05f9417cfcb90c8aee *inst/include/idas/idas_ls.h 1a55a50adb08c9bcf410f5c02a34efb1 *inst/include/idas/idas_spils.h 555622009f640fe783db92439c2ef61b *inst/include/kinsol/kinsol.h 82fabb93696ddfdc4a06cdaaa894434b *inst/include/kinsol/kinsol_bbdpre.h ed3f7da4c5fffe9e18913bd8fad46ed5 *inst/include/kinsol/kinsol_direct.h b0ffac3805cee588d6a73a8cddda7be9 *inst/include/kinsol/kinsol_ls.h 70c8c6ff581a25528bf7a2e8eaa654fa *inst/include/kinsol/kinsol_spils.h ed166351d4605f521db92a7104989ad9 *inst/include/nvector/cuda/ThreadPartitioning.hpp ddd086beec6ef315767412789207b3fa *inst/include/nvector/cuda/Vector.hpp d486fcb97be03207079da0b88a3589fe *inst/include/nvector/cuda/VectorArrayKernels.cuh ba001a757ceac886d79d0aebb64e5381 *inst/include/nvector/cuda/VectorKernels.cuh 777ca73dfd67967c35ee9b090f2b9728 *inst/include/nvector/nvector_cuda.h de562c49c5bf41badeb5517ffa2468ab *inst/include/nvector/nvector_mpicuda.h 602992e3b8fda9c642b26868eb55652a *inst/include/nvector/nvector_mpiraja.h 19bb19b1fa68da0d32dee41c19787485 *inst/include/nvector/nvector_openmp.h 63a2949677eb647da1be64e2877ebe9e *inst/include/nvector/nvector_openmpdev.h 860006208d84d68b97b134dbb39d2979 *inst/include/nvector/nvector_parallel.h 1bafaf198a212499ffe391ed25bbfddf *inst/include/nvector/nvector_parhyp.h 4334ae0252ca1056a76a69b3d446bfd0 *inst/include/nvector/nvector_petsc.h 2f886f8cedaa90db2fbabff93d33d810 *inst/include/nvector/nvector_pthreads.h 75844a14638666bd00bfaca36784ec69 *inst/include/nvector/nvector_raja.h 02e21b2d47561147aed5f9b203dbc650 *inst/include/nvector/nvector_serial.h 25e55bfc8f9fd392480f33b7903147b4 *inst/include/nvector/nvector_trilinos.h 40c782f2b778345af9a7239b225d0b8d *inst/include/nvector/raja/Vector.hpp 46331b2a03df6013e090bfe8a01f0bb3 *inst/include/nvector/trilinos/SundialsTpetraVectorInterface.hpp f4057ede711c359a385abfc88ea15622 *inst/include/nvector/trilinos/SundialsTpetraVectorKernels.hpp e8877c7f9dadca68c9abcf38f385b087 *inst/include/src/stan/analyze/mcmc/autocovariance.hpp c4bbd3f32a6460af6c7d25f38a44df5a *inst/include/src/stan/analyze/mcmc/compute_effective_sample_size.hpp 6882d4bf375739658b77b8d519272a68 *inst/include/src/stan/analyze/mcmc/compute_potential_scale_reduction.hpp ae6b1e4854d0a2751e548533b41dc8e9 *inst/include/src/stan/analyze/mcmc/split_chains.hpp 9a87e19468b45acccecac19ff37a10cf *inst/include/src/stan/callbacks/interrupt.hpp 88bb6c43c26ea8a899c96d9a36124052 *inst/include/src/stan/callbacks/logger.hpp 33bc99738574ffb1793042d37f4b81ff *inst/include/src/stan/callbacks/stream_logger.hpp fdcc3684f6c6481071f716af010426f4 *inst/include/src/stan/callbacks/stream_writer.hpp abda9b6dd77ed3ccb55b1e73088147ed *inst/include/src/stan/callbacks/tee_writer.hpp accc3a07868fa78ddf799034122315bd *inst/include/src/stan/callbacks/writer.hpp 52ae9d65be8853bc70a9a4ec32751eaa *inst/include/src/stan/command/stanc_helper.hpp c6414d76850a3887fb55014f59a41df5 *inst/include/src/stan/io/array_var_context.hpp 1a2348cf7413bcb20826e8114e1299c5 *inst/include/src/stan/io/chained_var_context.hpp 8ee7faa4ce2e4ccf8faead93f806a0b5 *inst/include/src/stan/io/cmd_line.hpp 4b467f77a0f0479708179f85c2a5f244 *inst/include/src/stan/io/dump.hpp 60de63344435c3860a208f620060b5b2 *inst/include/src/stan/io/empty_var_context.hpp 36336f2c4ec3bc29131d73c9486f5d5e *inst/include/src/stan/io/ends_with.hpp bcf8cdbe8aa16b223fac0920b91e5533 *inst/include/src/stan/io/is_whitespace.hpp fa19b3fe8bf6fa4acb751c2c5f0e0b18 *inst/include/src/stan/io/program_reader.hpp c687b2b41b3f083cc7fcc0dc043a49eb *inst/include/src/stan/io/random_var_context.hpp 7bc7a3f51ff9c58bcaf89e79affbff9c *inst/include/src/stan/io/read_line.hpp 18b1b712fbdfdd7316f8075ba2b4b8fc *inst/include/src/stan/io/reader.hpp 357bae3a0d8fb1eedea8b16932461488 *inst/include/src/stan/io/stan_csv_reader.hpp a03332f67b8fdf54ca156d4ebfb4caa3 *inst/include/src/stan/io/starts_with.hpp 642f720efba9a301d1123866c5844a3d *inst/include/src/stan/io/trim_spaces.hpp a1512baa94fe404502fee83c37dec1d6 *inst/include/src/stan/io/util.hpp 8af324e98d1808e0d2e4adb7a88ca81f *inst/include/src/stan/io/validate_zero_buf.hpp 0b72d514c1a9f27ece918663fcae1122 *inst/include/src/stan/io/var_context.hpp 5255fec6d55378855733b3595fa99902 *inst/include/src/stan/io/writer.hpp d238736cc0b2629d3682ac31ff8ce57a *inst/include/src/stan/lang/ast.hpp fb60927a20bc8085e357a52c2260f972 *inst/include/src/stan/lang/ast/fun/bare_type_is_data_vis.hpp 792a39aaef2f0bb9d756ff82e09bb171 *inst/include/src/stan/lang/ast/fun/bare_type_is_data_vis_def.hpp 06f060a9466b2943a677806f09a94693 *inst/include/src/stan/lang/ast/fun/bare_type_order_id_vis.hpp 625ebdcd16893ee2742793c96b1f906e *inst/include/src/stan/lang/ast/fun/bare_type_order_id_vis_def.hpp ff307a7c2fe692cc5af1242a7b94f8f6 *inst/include/src/stan/lang/ast/fun/bare_type_set_is_data_vis.hpp 34bfd4609d9a299718af7937212f0eff *inst/include/src/stan/lang/ast/fun/bare_type_set_is_data_vis_def.hpp 0493a8dc35693425e1a968ee50fdb034 *inst/include/src/stan/lang/ast/fun/bare_type_total_dims_vis.hpp f468d0d832aa0df4f1c4e19aa585469e *inst/include/src/stan/lang/ast/fun/bare_type_total_dims_vis_def.hpp 88a26a0913e88c60f18aa02dac2f2de7 *inst/include/src/stan/lang/ast/fun/bare_type_vis.hpp 19d5cbfd452bb5484c3d115555234ab3 *inst/include/src/stan/lang/ast/fun/bare_type_vis_def.hpp 7b510b0722e52e90bb3d99ab2fe63edb *inst/include/src/stan/lang/ast/fun/block_type_bounds_vis.hpp c3ce05d37bd013788ed0cd1eff084ac5 *inst/include/src/stan/lang/ast/fun/block_type_bounds_vis_def.hpp de6c7524b6408272e721242f08ace23d *inst/include/src/stan/lang/ast/fun/block_type_is_specialized_vis.hpp 96fb2166e34ddfd2d1baa9f089665676 *inst/include/src/stan/lang/ast/fun/block_type_is_specialized_vis_def.hpp 5bbd96ae87d685a4b831b75babbf94b4 *inst/include/src/stan/lang/ast/fun/block_type_offset_multiplier_vis.hpp e18c5124fcf87573fd5614ba8e6fba82 *inst/include/src/stan/lang/ast/fun/block_type_offset_multiplier_vis_def.hpp fbb09bc0cc0a771aa298c35ee60457b7 *inst/include/src/stan/lang/ast/fun/block_type_params_total_vis.hpp b4b5d322d91042f3261dae41193b2685 *inst/include/src/stan/lang/ast/fun/block_type_params_total_vis_def.hpp 97fb195a8760a2445f545b9bb5eb6faa *inst/include/src/stan/lang/ast/fun/ends_with.hpp 4bfff14128895d4343c730ae2c2430da *inst/include/src/stan/lang/ast/fun/ends_with_def.hpp 0b3bbdab16dd45a9776eb58c7572d1c5 *inst/include/src/stan/lang/ast/fun/expression_bare_type_vis.hpp 74c37e0e23e895a7595efe61e928d494 *inst/include/src/stan/lang/ast/fun/expression_bare_type_vis_def.hpp c96b78cc67dec2bac4c8fca5cb5a1ced *inst/include/src/stan/lang/ast/fun/fun_name_exists.hpp d84799bbf205d7596431347b8b5aed71 *inst/include/src/stan/lang/ast/fun/fun_name_exists_def.hpp a16085633c0df5ec5432300e89fc26da *inst/include/src/stan/lang/ast/fun/generate_expression.hpp 2b6f31852efcffa8a17af0211e99b8ba *inst/include/src/stan/lang/ast/fun/get_ccdf.hpp d883287aa9d5502df1209ae3abf591da *inst/include/src/stan/lang/ast/fun/get_ccdf_def.hpp e6cc42d219d7d61dba5d11b96467f648 *inst/include/src/stan/lang/ast/fun/get_cdf.hpp 67c2ed5b339abfd450624f51065b9129 *inst/include/src/stan/lang/ast/fun/get_cdf_def.hpp fc715ee2bb22435113c8d9fdf9e7d988 *inst/include/src/stan/lang/ast/fun/get_prob_fun.hpp 809dea11c33993c17c17fab082a65690 *inst/include/src/stan/lang/ast/fun/get_prob_fun_def.hpp 9de73e88ce096a9c1dcca0d89559b29a *inst/include/src/stan/lang/ast/fun/has_ccdf_suffix.hpp a0fe5d2ad5ad7bf6428e44731678aa06 *inst/include/src/stan/lang/ast/fun/has_ccdf_suffix_def.hpp 3b4ac09819fba972205b604d91f3ae12 *inst/include/src/stan/lang/ast/fun/has_cdf_suffix.hpp 3a69b256d6179ded0a2c762620813f9c *inst/include/src/stan/lang/ast/fun/has_cdf_suffix_def.hpp 9793959298e156a36c22cc2de8b55d2a *inst/include/src/stan/lang/ast/fun/has_lp_suffix.hpp 2794c60f0a7026ee5df66e8eaa4f27dd *inst/include/src/stan/lang/ast/fun/has_lp_suffix_def.hpp 0538537b421cc6b162307dcf4b3e0d52 *inst/include/src/stan/lang/ast/fun/has_non_param_var.hpp 2dc3e10242044e91f3b5d39156c223c2 *inst/include/src/stan/lang/ast/fun/has_non_param_var_def.hpp f89f1a39f318d392e9d3afee1af6b1cc *inst/include/src/stan/lang/ast/fun/has_non_param_var_vis.hpp 21ba026771ec5e9df700a8818a167e43 *inst/include/src/stan/lang/ast/fun/has_non_param_var_vis_def.hpp 0e626e99a0c58d980a1ddf65f4f1de3b *inst/include/src/stan/lang/ast/fun/has_prob_fun_suffix.hpp e0301035fd4d188c4e4e0b8685d7f31e *inst/include/src/stan/lang/ast/fun/has_prob_fun_suffix_def.hpp 50d837a16b7c47e4ac0f1a97441a3f1c *inst/include/src/stan/lang/ast/fun/has_rng_suffix.hpp fb728881ce01bbb6026dbe26b70ec3f1 *inst/include/src/stan/lang/ast/fun/has_rng_suffix_def.hpp 958974f85f116d2b4d0bf4d263b062d3 *inst/include/src/stan/lang/ast/fun/has_var.hpp 28207b66f7eb36e3e02e5f64e7017686 *inst/include/src/stan/lang/ast/fun/has_var_def.hpp 8f12bad2411208e5bf48b148af146a79 *inst/include/src/stan/lang/ast/fun/has_var_vis.hpp 1ea5d98cc4160fd4bf44680ba95ee4a9 *inst/include/src/stan/lang/ast/fun/has_var_vis_def.hpp c174a06136d6263eaf4ddddbf813d4cc *inst/include/src/stan/lang/ast/fun/indexed_type.hpp f331052c3ba82b35f340a535af90c06d *inst/include/src/stan/lang/ast/fun/indexed_type_def.hpp a8d143ae1581dbc1fb3811d31cb0fc88 *inst/include/src/stan/lang/ast/fun/infer_type_indexing.hpp 10a5247ec13afc3bde714e42f240b534 *inst/include/src/stan/lang/ast/fun/infer_type_indexing_def.hpp 5ee77f23e4c602f0609c7b381e5e2a7f *inst/include/src/stan/lang/ast/fun/is_assignable.hpp 5e1888b3199b1fb8435f558c600c50e2 *inst/include/src/stan/lang/ast/fun/is_assignable_def.hpp afdc4b1c4633869cb93d312ee83bef84 *inst/include/src/stan/lang/ast/fun/is_multi_index.hpp 8fccae4822397b62475bf25c0035e5ec *inst/include/src/stan/lang/ast/fun/is_multi_index_def.hpp 83396623ff9e81eb1d43feb755c7b6b5 *inst/include/src/stan/lang/ast/fun/is_multi_index_vis.hpp 1a744a845ee5e209e594417aa98afa8b *inst/include/src/stan/lang/ast/fun/is_multi_index_vis_def.hpp b7ab6480e26dd2c460f669ce95f21e10 *inst/include/src/stan/lang/ast/fun/is_nil.hpp 2dbe2676193b40cecff854958ddf919d *inst/include/src/stan/lang/ast/fun/is_nil_def.hpp 0f6948747f1dbbb5c9363c303c7115c4 *inst/include/src/stan/lang/ast/fun/is_nil_vis.hpp ae2d333f4b839588c53ac984e5b67ce4 *inst/include/src/stan/lang/ast/fun/is_nil_vis_def.hpp b3aedb36eb8bf85d85756c3a8c37972d *inst/include/src/stan/lang/ast/fun/is_no_op_statement_vis.hpp 572519533945b06e40ef56d214d2377c *inst/include/src/stan/lang/ast/fun/is_no_op_statement_vis_def.hpp 271e86ebbd72ff916574fa9b39bf1b9e *inst/include/src/stan/lang/ast/fun/is_nonempty.hpp e3c5d4f770b9ed96f788867b0ce3da16 *inst/include/src/stan/lang/ast/fun/is_nonempty_def.hpp d28cbb579c480daab826496bcef6d9f5 *inst/include/src/stan/lang/ast/fun/is_space.hpp c6bca949ddcd7ce98cb3bf78a7ad73f9 *inst/include/src/stan/lang/ast/fun/is_space_def.hpp 1c72bd06aa2da107fd9a0a8cd7b9aa26 *inst/include/src/stan/lang/ast/fun/is_user_defined.hpp 8b1d6fdba17db7ec3142bd1b00fe9246 *inst/include/src/stan/lang/ast/fun/is_user_defined_def.hpp afb0ba9f2f18080424ac7f960e09e575 *inst/include/src/stan/lang/ast/fun/is_user_defined_prob_function.hpp 74b8d525ded6de394dcd841bb8cf7db6 *inst/include/src/stan/lang/ast/fun/is_user_defined_prob_function_def.hpp 2e6c285d394e0395f1945731082745c4 *inst/include/src/stan/lang/ast/fun/num_index_op_dims.hpp a6cde46addfa57531cce8c29305b8017 *inst/include/src/stan/lang/ast/fun/num_index_op_dims_def.hpp 5cdb7d4172aa8f3f60db7cb4bf6b0aa8 *inst/include/src/stan/lang/ast/fun/print_scope.hpp f0a0515c0fe710716d3f457e4df2054c *inst/include/src/stan/lang/ast/fun/print_scope_def.hpp b7824046940a7643cd6ca4cae2575b48 *inst/include/src/stan/lang/ast/fun/promote_primitive.hpp ba61bbea87151baf2e61055669113baf *inst/include/src/stan/lang/ast/fun/promote_primitive_def.hpp 868230e9da611fd0d36001ffac8df4e9 *inst/include/src/stan/lang/ast/fun/returns_type.hpp 0754da2ce53cdc3b33135889d943acf8 *inst/include/src/stan/lang/ast/fun/returns_type_def.hpp 6a9c211aa8da6719af8cd8624ea68a9d *inst/include/src/stan/lang/ast/fun/returns_type_vis.hpp f941dd622c36c830b75c74168784498b *inst/include/src/stan/lang/ast/fun/returns_type_vis_def.hpp f7dbffec8e5a223f4e76bf2cb3032601 *inst/include/src/stan/lang/ast/fun/strip_ccdf_suffix.hpp 2f5fb26c65da294face0d23510ae5698 *inst/include/src/stan/lang/ast/fun/strip_ccdf_suffix_def.hpp f2c4c87ec061309fe8435e0acb4c5b53 *inst/include/src/stan/lang/ast/fun/strip_cdf_suffix.hpp aaa66d4375229ff2ac66ee2e6f040e5c *inst/include/src/stan/lang/ast/fun/strip_cdf_suffix_def.hpp 7d8949b27cf0a77bb95dba583db9237c *inst/include/src/stan/lang/ast/fun/strip_prob_fun_suffix.hpp 2b7b49804581e1c81ad91c9bfb83e703 *inst/include/src/stan/lang/ast/fun/strip_prob_fun_suffix_def.hpp 74ca59f3d826198e0cb70a463c2e62e3 *inst/include/src/stan/lang/ast/fun/template.hpp cc8a3768f691d38eac03f946df4fdebc *inst/include/src/stan/lang/ast/fun/var_occurs_vis.hpp 542daa959a342a1111f84c1c2eb39a1d *inst/include/src/stan/lang/ast/fun/var_occurs_vis_def.hpp 784ebc838fa11b9ac094c6c706de9963 *inst/include/src/stan/lang/ast/fun/var_type_arg1_vis.hpp a13bb10f8b606f0dce9ad5dc2f705515 *inst/include/src/stan/lang/ast/fun/var_type_arg1_vis_def.hpp 2d126eb29c80aa2784889e61c66c16fb *inst/include/src/stan/lang/ast/fun/var_type_arg2_vis.hpp af5b4ae3504c274c5e1f8a8908ec13f2 *inst/include/src/stan/lang/ast/fun/var_type_arg2_vis_def.hpp d7c84abfc3ea49316b01def8a47e963e *inst/include/src/stan/lang/ast/fun/var_type_name_vis.hpp b996863672dede6cc3cc9eb56deb31c7 *inst/include/src/stan/lang/ast/fun/var_type_name_vis_def.hpp 6e598df7a485727cef1ae253bc367f80 *inst/include/src/stan/lang/ast/fun/write_bare_expr_type.hpp 4989dbb0fbddf6de95de9d2d1f56bddf *inst/include/src/stan/lang/ast/fun/write_bare_expr_type_def.hpp a5a7ca47bd04265d9040ee3238e26141 *inst/include/src/stan/lang/ast/fun/write_block_var_type.hpp 49ed07cf4f9b8ee0bf3fecd332b2cc2b *inst/include/src/stan/lang/ast/fun/write_block_var_type_def.hpp 3299af3f901d6923394f5aa5a7b0fd06 *inst/include/src/stan/lang/ast/fun/write_expression_vis.hpp 87510028d380c6a7c03435cba52ada3a *inst/include/src/stan/lang/ast/fun/write_expression_vis_def.hpp 88068b0bfeabb88bf945af7d50620b80 *inst/include/src/stan/lang/ast/fun/write_idx_vis.hpp e3dc88ec7fccc8a46c44d2e7e72e5821 *inst/include/src/stan/lang/ast/fun/write_idx_vis_def.hpp 5fd1ebd5b7448b839c3db32cfe64b4fd *inst/include/src/stan/lang/ast/nil.hpp 0c5ae596e11d06c534f7d560c93fcc89 *inst/include/src/stan/lang/ast/node/algebra_solver.hpp aa8be177d49fb1f83bcd0325b3806519 *inst/include/src/stan/lang/ast/node/algebra_solver_control.hpp e67319e7d11934d7253bbc1b85131f6a *inst/include/src/stan/lang/ast/node/algebra_solver_control_def.hpp dd53c15a3a61e53ff8a6709f01255bf0 *inst/include/src/stan/lang/ast/node/algebra_solver_def.hpp 97704a02786f52a5553ea90c68a1381b *inst/include/src/stan/lang/ast/node/array_expr.hpp 4e3164bf293366bd6bf0caaf8ae940f8 *inst/include/src/stan/lang/ast/node/array_expr_def.hpp 96450d482a2f86f573366c542e2753a5 *inst/include/src/stan/lang/ast/node/assgn.hpp 461b04c387442a473fd3b0539172f83a *inst/include/src/stan/lang/ast/node/assgn_def.hpp 518ee0779da686bb641143bfbc635bb0 *inst/include/src/stan/lang/ast/node/binary_op.hpp bd62e72205e7fde6aac4bb594d84192c *inst/include/src/stan/lang/ast/node/binary_op_def.hpp ca9c591e10b658dd58a2ed3e3d2d0c19 *inst/include/src/stan/lang/ast/node/block_var_decl.hpp b1aa467416acfae7657a7de34732b9ac *inst/include/src/stan/lang/ast/node/block_var_decl_def.hpp c5abfafb5712ce15ca1abd52b2e605a6 *inst/include/src/stan/lang/ast/node/break_continue_statement.hpp f680cbfbb17c0a452d8fc8e04feecbea *inst/include/src/stan/lang/ast/node/break_continue_statement_def.hpp 7026d35ad04c160cf07af63439f8d807 *inst/include/src/stan/lang/ast/node/conditional_op.hpp 03dec9d2b19eeea44c318ec014671d2a *inst/include/src/stan/lang/ast/node/conditional_op_def.hpp 2e6b75fd17eaa138aae4ca359f58eb7a *inst/include/src/stan/lang/ast/node/conditional_statement.hpp 75a16b71c13356d90e9ecc8d673b53d1 *inst/include/src/stan/lang/ast/node/conditional_statement_def.hpp cef0028056b765217471f95b7dfb93ad *inst/include/src/stan/lang/ast/node/distribution.hpp 997cb5e08f091d4a618fbb62c8090ed7 *inst/include/src/stan/lang/ast/node/double_literal.hpp 5f6154e223775400b01da656fe9c5b1e *inst/include/src/stan/lang/ast/node/double_literal_def.hpp 27e9ce1a3af9aacf523e11cf9413db8e *inst/include/src/stan/lang/ast/node/expression.hpp 3776a7cbe84c73ddb3f6c72d85f56fc3 *inst/include/src/stan/lang/ast/node/expression_def.hpp 98c0481c0ae201e7bceaaaa959dce7d9 *inst/include/src/stan/lang/ast/node/for_array_statement.hpp 811a31dc0c2ec7a65845a384a506cf36 *inst/include/src/stan/lang/ast/node/for_array_statement_def.hpp 327f1f30dfe39230a58db737f34b6526 *inst/include/src/stan/lang/ast/node/for_matrix_statement.hpp da3e29fee0e56c7ab179cf1d0c2f4a2d *inst/include/src/stan/lang/ast/node/for_matrix_statement_def.hpp 6bc047fe16bc8230ccb6c8455810bfc9 *inst/include/src/stan/lang/ast/node/for_statement.hpp 22bcfea2143444a8924213be3eae7c77 *inst/include/src/stan/lang/ast/node/for_statement_def.hpp 7530d99a8bd52435911607f14011aa15 *inst/include/src/stan/lang/ast/node/fun.hpp 6fc7bcce03050c9eb1a2f16692aedfa0 *inst/include/src/stan/lang/ast/node/fun_def.hpp 562ec9f32f7c27447432885794a91bdb *inst/include/src/stan/lang/ast/node/function_decl_def.hpp 371329e41863ef8b21ba05d97a83a967 *inst/include/src/stan/lang/ast/node/function_decl_def_def.hpp 44277e6172ea529f23d8c4a92ef727e8 *inst/include/src/stan/lang/ast/node/function_decl_defs.hpp 44f18c63cffc968499a351769e8d5f12 *inst/include/src/stan/lang/ast/node/function_decl_defs_def.hpp 912296fd908de31f5bc56952c3b0a859 *inst/include/src/stan/lang/ast/node/idx.hpp e162d6f8fc933446c2632d4aad947bb7 *inst/include/src/stan/lang/ast/node/idx_def.hpp dbb6b40f760284a083790c4ba49d5e62 *inst/include/src/stan/lang/ast/node/increment_log_prob_statement.hpp 7079f80942a86bcb4d41fad038c5049d *inst/include/src/stan/lang/ast/node/increment_log_prob_statement_def.hpp cec85dbed922546c32fb2c29280e19b2 *inst/include/src/stan/lang/ast/node/index_op.hpp a3d2be41e50d3352d2d5f6dfcf5fddcf *inst/include/src/stan/lang/ast/node/index_op_def.hpp ce119cb39ac278ed88e21347590ac421 *inst/include/src/stan/lang/ast/node/index_op_sliced.hpp 3221706e322f71677155ccc9fb5a3024 *inst/include/src/stan/lang/ast/node/index_op_sliced_def.hpp b18700d129d07f0b3de77282aed899f0 *inst/include/src/stan/lang/ast/node/int_literal.hpp 7e9fcf8687296d56f5d5a8bfcc3f0dfc *inst/include/src/stan/lang/ast/node/int_literal_def.hpp 9ea647ef15a458c2d9a56ef466bcf903 *inst/include/src/stan/lang/ast/node/integrate_1d.hpp 272bcf1d325eb50ab19150c7b99b7b1c *inst/include/src/stan/lang/ast/node/integrate_1d_def.hpp 0a46d7f139fce2a4e204e95cba214313 *inst/include/src/stan/lang/ast/node/integrate_ode.hpp da5766dcfb27d93ced7f3766991e2acf *inst/include/src/stan/lang/ast/node/integrate_ode_control.hpp 014d3bc1861a9bab8a1bd0d0b36de025 *inst/include/src/stan/lang/ast/node/integrate_ode_control_def.hpp 58de786733422c5e399d59b942bc7dc1 *inst/include/src/stan/lang/ast/node/integrate_ode_def.hpp 97a521533a8bdef5fad33f00a6b6a36a *inst/include/src/stan/lang/ast/node/lb_idx.hpp d9078f8559170c45baadfdc254486b6e *inst/include/src/stan/lang/ast/node/lb_idx_def.hpp 70daae05ebca207bc97d9f75ac0491a2 *inst/include/src/stan/lang/ast/node/local_var_decl.hpp eadf09dbf8142dd130c85af26b19779c *inst/include/src/stan/lang/ast/node/local_var_decl_def.hpp a389153320738eaa7466a756aee63975 *inst/include/src/stan/lang/ast/node/lub_idx.hpp 3f596d355fda0b73a2dcc0103f23a003 *inst/include/src/stan/lang/ast/node/lub_idx_def.hpp e990ed9901fa3bfa06825149a0cd5f3a *inst/include/src/stan/lang/ast/node/map_rect.hpp f0007a2a7d410acf5828ed7def8713dd *inst/include/src/stan/lang/ast/node/map_rect_def.hpp 12b59eb31ed2cfc6100a043121b0f426 *inst/include/src/stan/lang/ast/node/matrix_expr.hpp 03a11c98169cd3a009915bb8900c87c0 *inst/include/src/stan/lang/ast/node/matrix_expr_def.hpp bb486fba27f8972d3cb385a04f608be8 *inst/include/src/stan/lang/ast/node/multi_idx.hpp 1b43553ba497b6071bc63b5d6d9994d0 *inst/include/src/stan/lang/ast/node/multi_idx_def.hpp 38fddae0f5563715df0d25c308a0f06e *inst/include/src/stan/lang/ast/node/no_op_statement.hpp eb2330f46bbc91385489ff972fce46bf *inst/include/src/stan/lang/ast/node/offset_multiplier.hpp 97fb141fab42319b829989b9bd455476 *inst/include/src/stan/lang/ast/node/offset_multiplier_def.hpp 7db6d782fa3827ef3d758896e3a5cd51 *inst/include/src/stan/lang/ast/node/omni_idx.hpp d7cc634ba8201d44b3c1dbd227576284 *inst/include/src/stan/lang/ast/node/omni_idx_def.hpp bcec94eb7b546e58a65758f01e7e5520 *inst/include/src/stan/lang/ast/node/print_statement.hpp f7418d6d11e36767bb247c0c984bb7fb *inst/include/src/stan/lang/ast/node/print_statement_def.hpp 9f22ea7754d6fa3eb65939edc1af715c *inst/include/src/stan/lang/ast/node/printable.hpp a6ab4867f41a9fb042e1e426b95a6549 *inst/include/src/stan/lang/ast/node/printable_def.hpp 100126bfaaaf9362b8b4f300cc698568 *inst/include/src/stan/lang/ast/node/program.hpp a4afe645da24d7a98a77686b150e462b *inst/include/src/stan/lang/ast/node/program_def.hpp d9a5a0b0c7758ee77f3c7d88ca69861a *inst/include/src/stan/lang/ast/node/range.hpp 8721092638a5e2723c1121110b3e7393 *inst/include/src/stan/lang/ast/node/range_def.hpp 1aacd9a7bb2b9239308461d2161063a6 *inst/include/src/stan/lang/ast/node/reject_statement.hpp c5262e667583c85c88e25549a53dd55a *inst/include/src/stan/lang/ast/node/reject_statement_def.hpp f692c9e76e1b0a7de390d9cfbe042e2d *inst/include/src/stan/lang/ast/node/return_statement.hpp 74e06c96e2bfe427f80e5ed63c61cc5e *inst/include/src/stan/lang/ast/node/return_statement_def.hpp 6420643979ac21b32ace3853c48987fe *inst/include/src/stan/lang/ast/node/row_vector_expr.hpp 2ddf646d7a030332c08e679b90f0db96 *inst/include/src/stan/lang/ast/node/row_vector_expr_def.hpp ecd9d206839667bbe42e242d2b0435dc *inst/include/src/stan/lang/ast/node/sample.hpp ea93ada460a4c8af64b4bb90effaa0fc *inst/include/src/stan/lang/ast/node/sample_def.hpp 394216f27b6f13aabeaaad2b143980f0 *inst/include/src/stan/lang/ast/node/statement.hpp 6b5f9869088b6d720b8ca1bcae54299b *inst/include/src/stan/lang/ast/node/statement_def.hpp a3cca45d592f38851ea90f0d1bfb83b8 *inst/include/src/stan/lang/ast/node/statements.hpp 6eda526b3e9dba66e14aec6ad7e972e2 *inst/include/src/stan/lang/ast/node/statements_def.hpp 7c408a212a4b1efc893a61c39ef01d29 *inst/include/src/stan/lang/ast/node/ub_idx.hpp 499a2099c1ce1cab69eeb919df2aeb13 *inst/include/src/stan/lang/ast/node/ub_idx_def.hpp 711558af675ec96fae027fef4ccd9b70 *inst/include/src/stan/lang/ast/node/unary_op.hpp a55811f9345cd8f97fda7ad4a28ec1c5 *inst/include/src/stan/lang/ast/node/unary_op_def.hpp d58e70319228f19c0311fee107929576 *inst/include/src/stan/lang/ast/node/uni_idx.hpp 9a2d091362f34be1a7583ea7ab528713 *inst/include/src/stan/lang/ast/node/uni_idx_def.hpp 7918241a24b91c9a27564b46b31dd977 *inst/include/src/stan/lang/ast/node/var_decl.hpp e6028e51749984b0db40678f95fd2009 *inst/include/src/stan/lang/ast/node/var_decl_def.hpp 4a3e913d385d7503f1bb4151bf466ce0 *inst/include/src/stan/lang/ast/node/variable.hpp f5109bd7d87efe93137a508c39e51f68 *inst/include/src/stan/lang/ast/node/variable_def.hpp fbbf663c2cd0a5ad19899b7832c9a3e4 *inst/include/src/stan/lang/ast/node/variable_dims.hpp ca11d2bcf0002c194e02a76e265487fc *inst/include/src/stan/lang/ast/node/variable_dims_def.hpp 1b8727b925f16b54df3c1bee736ad7f3 *inst/include/src/stan/lang/ast/node/while_statement.hpp 2aa4f3e2a402803e2b04f139c9e2b9cd *inst/include/src/stan/lang/ast/node/while_statement_def.hpp b7dbc38cc43673892bccbb3082e79fd9 *inst/include/src/stan/lang/ast/origin_block.hpp cbe0f80a19d55182012e1488249db54c *inst/include/src/stan/lang/ast/scope.hpp 63350d9720730e2d05c02cfa7e62f6a1 *inst/include/src/stan/lang/ast/scope_def.hpp 843e8027ade28b8259d68db7d0778c75 *inst/include/src/stan/lang/ast/sigs/function_signature_t.hpp f194258b6bb0e2883cc5bca792bd1333 *inst/include/src/stan/lang/ast/sigs/function_signatures.hpp 5cf0ca60999ccee45d2d47058f63cadd *inst/include/src/stan/lang/ast/sigs/function_signatures_def.hpp fea02352f35e89fbb731bd5cabccda4d *inst/include/src/stan/lang/ast/type/bare_array_type.hpp dd9f0697848d9b774e281161d4422e7e *inst/include/src/stan/lang/ast/type/bare_array_type_def.hpp ca65eaf86e9820bd7b265abcd6fb1f89 *inst/include/src/stan/lang/ast/type/bare_expr_type.hpp 9f3ab01b2e5f08c9a3404d1e8609e754 *inst/include/src/stan/lang/ast/type/bare_expr_type_def.hpp e80d258de33e51c60a2db1c08551fb01 *inst/include/src/stan/lang/ast/type/block_array_type.hpp 749221e1f1c037c648a99fd2719835f7 *inst/include/src/stan/lang/ast/type/block_array_type_def.hpp 413e8837b9df4d88f1263491dedd3a64 *inst/include/src/stan/lang/ast/type/block_var_type.hpp 08e038af16f31aceb4da5b8a5872ca6b *inst/include/src/stan/lang/ast/type/block_var_type_def.hpp e7113acc53bfb90a45eec82fc6dfb03a *inst/include/src/stan/lang/ast/type/cholesky_factor_corr_block_type.hpp 52670610076c4a6e8549a9d164a23d32 *inst/include/src/stan/lang/ast/type/cholesky_factor_corr_block_type_def.hpp 3c488533c8f370fcda670a711b196979 *inst/include/src/stan/lang/ast/type/cholesky_factor_cov_block_type.hpp 1ab7dc1c2b7057ae449a524a22cdcc66 *inst/include/src/stan/lang/ast/type/cholesky_factor_cov_block_type_def.hpp 4a3d41484cb03e14668e9f0e00ae169d *inst/include/src/stan/lang/ast/type/corr_matrix_block_type.hpp 72dbe152c4f8ba716ce270abd83a4092 *inst/include/src/stan/lang/ast/type/corr_matrix_block_type_def.hpp dae662b6a17e0d7a9e9ecdfbd35195e4 *inst/include/src/stan/lang/ast/type/cov_matrix_block_type.hpp f198910ba0da4b4d83ae872bd9da85e3 *inst/include/src/stan/lang/ast/type/cov_matrix_block_type_def.hpp fa4a4f042d7cfbd475eb24aac59f22d5 *inst/include/src/stan/lang/ast/type/double_block_type.hpp 93936891383b2acb1f797017fd429f21 *inst/include/src/stan/lang/ast/type/double_block_type_def.hpp b08bd9074499fc557df4267cbe92f623 *inst/include/src/stan/lang/ast/type/double_type.hpp add233648a4d5fe0cb61aaff7a1153c6 *inst/include/src/stan/lang/ast/type/double_type_def.hpp a3305fecae84c2f6a02ce802588be60d *inst/include/src/stan/lang/ast/type/ill_formed_type.hpp bbc9d0451e7dd5b6dad248b23c82d0f8 *inst/include/src/stan/lang/ast/type/ill_formed_type_def.hpp 459d87b7ac5e6fab14570b5dc6d3982e *inst/include/src/stan/lang/ast/type/int_block_type.hpp a4aa8b304a55aab5de1ec7605f45f175 *inst/include/src/stan/lang/ast/type/int_block_type_def.hpp 40b0e913544ef4179d7a3ba3a347f252 *inst/include/src/stan/lang/ast/type/int_type.hpp 83e5fc325bafce174d6783dd058e4c61 *inst/include/src/stan/lang/ast/type/int_type_def.hpp 374ced4e2f14e85fe784a37f83d8a9b2 *inst/include/src/stan/lang/ast/type/local_array_type.hpp 74809575d00147252d3019692088d3b4 *inst/include/src/stan/lang/ast/type/local_array_type_def.hpp 84002c452adb213bd50f3ea6cb5dd0ec *inst/include/src/stan/lang/ast/type/local_var_type.hpp cd88b2aaa18515bc537a34ea3177262d *inst/include/src/stan/lang/ast/type/local_var_type_def.hpp 96b84610aaed3516bf4bda8898910860 *inst/include/src/stan/lang/ast/type/matrix_block_type.hpp 91797192950511487b3c925426c2670a *inst/include/src/stan/lang/ast/type/matrix_block_type_def.hpp 852c729117f0db7e3f19c26da8305acf *inst/include/src/stan/lang/ast/type/matrix_local_type.hpp 82e483d2addf0a20467b253d136531a9 *inst/include/src/stan/lang/ast/type/matrix_local_type_def.hpp bfef1159a4bcb364fcd3a5e840f61ce0 *inst/include/src/stan/lang/ast/type/matrix_type.hpp 9caacca43fcb72bb3df5c15558b894d0 *inst/include/src/stan/lang/ast/type/matrix_type_def.hpp 1e352b3e4c4bbb295173639aaeb67349 *inst/include/src/stan/lang/ast/type/order_id.hpp 53e88ef5c17ca1e2222d2bcf7c60945c *inst/include/src/stan/lang/ast/type/ordered_block_type.hpp 2db0329fa86b4cf1de64e559d469641a *inst/include/src/stan/lang/ast/type/ordered_block_type_def.hpp e068a10594c56eddda32505417fabe12 *inst/include/src/stan/lang/ast/type/positive_ordered_block_type.hpp 356d8fae27bcff7aaa70cf0206309d60 *inst/include/src/stan/lang/ast/type/positive_ordered_block_type_def.hpp 628be7371ef88b4028fe31e875dd29d7 *inst/include/src/stan/lang/ast/type/row_vector_block_type.hpp 27a459d9a8d6a5a5dc55d4baf91b4cfd *inst/include/src/stan/lang/ast/type/row_vector_block_type_def.hpp 5527c7d47160cff94e26affda9dc1728 *inst/include/src/stan/lang/ast/type/row_vector_local_type.hpp 967e8f13511cbc2b03dae25125e81f3f *inst/include/src/stan/lang/ast/type/row_vector_local_type_def.hpp d77e864c5b31006e529e9cdf6e7e32db *inst/include/src/stan/lang/ast/type/row_vector_type.hpp ee8430baa587200a9333c3d0f52cb912 *inst/include/src/stan/lang/ast/type/row_vector_type_def.hpp b595a5e1594a34ca52ca177c048630ef *inst/include/src/stan/lang/ast/type/simplex_block_type.hpp b2bb51b2dfaf04e3eff560219d37004d *inst/include/src/stan/lang/ast/type/simplex_block_type_def.hpp 07cd57d7a746917580d601c023a5ff9c *inst/include/src/stan/lang/ast/type/unit_vector_block_type.hpp 8308e07b190cca535ad35989365fa9d3 *inst/include/src/stan/lang/ast/type/unit_vector_block_type_def.hpp df94178d763b149cfb8ea7008e07d656 *inst/include/src/stan/lang/ast/type/vector_block_type.hpp 0e031f3d989fa52b4ff969daf8531a92 *inst/include/src/stan/lang/ast/type/vector_block_type_def.hpp 6a0ca0e5ba1341826d2073990feee73a *inst/include/src/stan/lang/ast/type/vector_local_type.hpp ad7c4893af750aa7417b22ed016c153b *inst/include/src/stan/lang/ast/type/vector_local_type_def.hpp 81304f464ebe5d695d08821ebfc17989 *inst/include/src/stan/lang/ast/type/vector_type.hpp bb35858909050eb2000cc4b8f347f551 *inst/include/src/stan/lang/ast/type/vector_type_def.hpp 82e3481e4c827a92ad2f475e12a7099e *inst/include/src/stan/lang/ast/type/void_type.hpp 5c715b59d7dc319ef3824c4adb935237 *inst/include/src/stan/lang/ast/type/void_type_def.hpp 980297ad668f362693a25ab08eda9f4c *inst/include/src/stan/lang/ast/variable_map.hpp ee85df6c6599b955c0d58e6465a69023 *inst/include/src/stan/lang/ast/variable_map_def.hpp 8d5eac595383183c98e5594661c7a9d1 *inst/include/src/stan/lang/ast_def.cpp 915cdafc6dcc8a77b7f24cf30907bce2 *inst/include/src/stan/lang/compile_functions.hpp 79fa530e206f1b0c9a28b42fab642612 *inst/include/src/stan/lang/compiler.hpp 45a9c04ac9cefaa25828d7cf67881fad *inst/include/src/stan/lang/function_signatures.h fc6a3de6850a783883df1224c7bf46da *inst/include/src/stan/lang/generator.hpp de40e4ae5abb61fbaba5ffb5ef3e0d88 *inst/include/src/stan/lang/generator/constants.hpp 2fbb0204f48a6e19e437f1af527b3bdc *inst/include/src/stan/lang/generator/expression_visgen.hpp e20571e651e72a5ebf538093ad9d31fe *inst/include/src/stan/lang/generator/fun_scalar_type.hpp aba6824df86f56fc9c39ef4a0668261b *inst/include/src/stan/lang/generator/generate_arg_decl.hpp 583068391c2c722c9708e9e2303bf064 *inst/include/src/stan/lang/generator/generate_array_builder_adds.hpp fb424093c7be56ff6e045c4f1f69e521 *inst/include/src/stan/lang/generator/generate_bare_type.hpp 22a37fa56878541d268f5b25c2d43ddf *inst/include/src/stan/lang/generator/generate_block_var.hpp 3ab54e52e2753273ee59e9dfba6416b7 *inst/include/src/stan/lang/generator/generate_catch_throw_located.hpp 8371c867ee568acb5f488bd0e67e5cf6 *inst/include/src/stan/lang/generator/generate_class_decl.hpp 37616572f4b4d9fcb13eb2c1d46142c5 *inst/include/src/stan/lang/generator/generate_class_decl_end.hpp 70dee8ff0bda530d83fc4d82d9ab403f *inst/include/src/stan/lang/generator/generate_comment.hpp fc4c4b141d743e75ab1b439be1d99ee2 *inst/include/src/stan/lang/generator/generate_constrained_param_names_method.hpp dce136aa090d7e36a34cdd63c133766f *inst/include/src/stan/lang/generator/generate_constructor.hpp 7df7f0c7def74706e634533faa42841c *inst/include/src/stan/lang/generator/generate_cpp.hpp d98cb6a1a8d8dbae9032985aa8db29bf *inst/include/src/stan/lang/generator/generate_data_var_ctor.hpp a8961a9b3f4e7e6ba380e7bd1f167bc9 *inst/include/src/stan/lang/generator/generate_data_var_init.hpp d5b1d615d8dfaa8563a28495c7223edf *inst/include/src/stan/lang/generator/generate_destructor.hpp 69c4e4f848f485e3760b59a7abb67a23 *inst/include/src/stan/lang/generator/generate_dims_method.hpp 905000f2b3a185f2c2ecb8e4b48e2b98 *inst/include/src/stan/lang/generator/generate_expression.hpp 33febd478a7d180a626e10335ad7f196 *inst/include/src/stan/lang/generator/generate_fun_inst_templ_params.hpp a25aa3889bda4d61287fcc6732c0a5bc *inst/include/src/stan/lang/generator/generate_function.hpp 330e2335088032f9666c285c2911dbb7 *inst/include/src/stan/lang/generator/generate_function_arguments.hpp f718465e04e5f08afb3289a3ad1239c4 *inst/include/src/stan/lang/generator/generate_function_body.hpp 28c1b6b3ac55734d53e5f5e86a843528 *inst/include/src/stan/lang/generator/generate_function_functor.hpp 0c0640b7d00926f5cba6d91a77e1dc9a *inst/include/src/stan/lang/generator/generate_function_inline_return_type.hpp f8d94ffa40a0d031ead26e97eb1818da *inst/include/src/stan/lang/generator/generate_function_instantiation.hpp f851e59fe56077d69e4d484df07a34bb *inst/include/src/stan/lang/generator/generate_function_instantiation_body.hpp 34cd6af214fd2dc909e70491eb820676 *inst/include/src/stan/lang/generator/generate_function_instantiation_name.hpp 8154475c2bf8943f73565cbae6990629 *inst/include/src/stan/lang/generator/generate_function_instantiations.hpp afe2537020f5cd589debd73d041f37ef *inst/include/src/stan/lang/generator/generate_function_name.hpp dda7fe2c7b1840b1e76a96bc7d6e142d *inst/include/src/stan/lang/generator/generate_function_template_parameters.hpp 1447f37aa4a8cb1babff79be9a2b2c8c *inst/include/src/stan/lang/generator/generate_functions.hpp 3ecce69606b6ef8f85a278f2a3a03e4f *inst/include/src/stan/lang/generator/generate_functor_arguments.hpp 34778644160c03004358b18d4726f412 *inst/include/src/stan/lang/generator/generate_globals.hpp 3b35cc52e6cb3818af7d557c40bcff89 *inst/include/src/stan/lang/generator/generate_idx.hpp 40c9cf05999cbc0524a29db3a44b57e5 *inst/include/src/stan/lang/generator/generate_idx_user.hpp 2362080089ac5fd7c38d8ca664b4d8e9 *inst/include/src/stan/lang/generator/generate_idxs.hpp 00f855739be470da82e147ef34d1aafd *inst/include/src/stan/lang/generator/generate_idxs_user.hpp 6981f3a6809b04124231ee328f9d879a *inst/include/src/stan/lang/generator/generate_include.hpp fa98cb78f8ba6f46b871a9ca37758951 *inst/include/src/stan/lang/generator/generate_includes.hpp 87843360e1507d427872c73b4e893bda *inst/include/src/stan/lang/generator/generate_indent.hpp ae8f7cc0e50cc4d593e3f2650422e81f *inst/include/src/stan/lang/generator/generate_indexed_expr.hpp cf6e687afedd53124d8c0bf5ec0a7403 *inst/include/src/stan/lang/generator/generate_indexed_expr_user.hpp 411a17e636ea771516d6a3f66f0e8467 *inst/include/src/stan/lang/generator/generate_initializer.hpp fb8ea7c54a5c1391462eb321ceb1fdc8 *inst/include/src/stan/lang/generator/generate_line_number.hpp 449f32ff044cd347fd9fe5c43c3dae6a *inst/include/src/stan/lang/generator/generate_local_var_decl_inits.hpp e73421651acbb7ffc2dd59fcfdc1e726 *inst/include/src/stan/lang/generator/generate_log_prob.hpp 52cf717c71eb904c481049cc13f13157 *inst/include/src/stan/lang/generator/generate_member_var_decls.hpp 251397d6946da5d0e7bb5eb2ed851f88 *inst/include/src/stan/lang/generator/generate_member_var_decls_all.hpp b8e4705a53a8ca6a10103c8328d7d853 *inst/include/src/stan/lang/generator/generate_model_name_method.hpp b7580b476dcb85ac023a977ad80b90cb *inst/include/src/stan/lang/generator/generate_model_typedef.hpp c619799f28291c7f80d19cc2d63c9254 *inst/include/src/stan/lang/generator/generate_namespace_end.hpp 6216239fcd88266dae9438fc69a04e2c *inst/include/src/stan/lang/generator/generate_namespace_start.hpp 6f3a690763cdcb2c649abf457a8e2788 *inst/include/src/stan/lang/generator/generate_param_names_array.hpp ff76b1829d53dd5700dc4cf36d6e9375 *inst/include/src/stan/lang/generator/generate_param_names_method.hpp 977a21cb0d156d1b21f536a91669955b *inst/include/src/stan/lang/generator/generate_param_var.hpp 3360410e7884270f5bb4635043b6a756 *inst/include/src/stan/lang/generator/generate_printable.hpp f98564cb7b3a370938f64a1cfa8eaa79 *inst/include/src/stan/lang/generator/generate_private_decl.hpp 635390bf4992031aec97639b70d994b7 *inst/include/src/stan/lang/generator/generate_program_reader_fun.hpp b714a3e3d91524f12949c9432394bff9 *inst/include/src/stan/lang/generator/generate_propto_default_function.hpp d3df2e88a01a7043aa767bf3fb5fc0a7 *inst/include/src/stan/lang/generator/generate_propto_default_function_body.hpp ab83e5ca9aa83bc87a489b5de7d4ae93 *inst/include/src/stan/lang/generator/generate_public_decl.hpp 6e0392082488cd694158572de32e25dc *inst/include/src/stan/lang/generator/generate_quoted_expression.hpp 8b893ba6e5706ddbd71619f2afcd227c *inst/include/src/stan/lang/generator/generate_quoted_string.hpp ed39f5a0f2c430989194818d30b61b1a *inst/include/src/stan/lang/generator/generate_read_transform_params.hpp 8fb8ebeee5c86d6b2ddb94c213894b0d *inst/include/src/stan/lang/generator/generate_real_var_type.hpp a720f2f48a485a828684cc5ceef9ecfe *inst/include/src/stan/lang/generator/generate_register_mpi.hpp 7c7edd3aa4ed6f3da1205d3a33b7ac78 *inst/include/src/stan/lang/generator/generate_set_param_ranges.hpp 9be0bce7498fa70c86a691163b4bedbe *inst/include/src/stan/lang/generator/generate_standalone_functions.hpp 3cfcaef84f6c51c7dbde359d7bd433bb *inst/include/src/stan/lang/generator/generate_statement.hpp 4375b226ef9d81bb51962e3148c4c799 *inst/include/src/stan/lang/generator/generate_statements.hpp 965bee6f85f854a909293edf9c77436f *inst/include/src/stan/lang/generator/generate_transform_inits_method.hpp 91d45423325e484b8328dcf7f828a7ad *inst/include/src/stan/lang/generator/generate_try.hpp c2e4a2973a4218e04fde03ec052d9349 *inst/include/src/stan/lang/generator/generate_typedef.hpp e8731e65f6df14d8a14d406c519fe150 *inst/include/src/stan/lang/generator/generate_typedefs.hpp 48ebc51fda69c4db9c7fe5131b9c99b8 *inst/include/src/stan/lang/generator/generate_unconstrained_param_names_array.hpp a21fd7e351a6922d74a11212df1cd98d *inst/include/src/stan/lang/generator/generate_unconstrained_param_names_method.hpp 2ad5375cac0e2c74b661cc4ae08f3538 *inst/include/src/stan/lang/generator/generate_using.hpp e2975a223eb0eba50f84967d8b47865f *inst/include/src/stan/lang/generator/generate_using_namespace.hpp 4a4e435a136a62ef388ffc546eae3628 *inst/include/src/stan/lang/generator/generate_usings.hpp 252e649127d2481a8eaa5f5397e17006 *inst/include/src/stan/lang/generator/generate_usings_standalone_functions.hpp 2c2b54eebed679d63bf59fc6f5f7263d *inst/include/src/stan/lang/generator/generate_validate_block_var.hpp 2cf2ba8aa7152aa0777a86bb020878ab *inst/include/src/stan/lang/generator/generate_validate_context_size.hpp 586323b1239a7d3a7d51de9dd40af682 *inst/include/src/stan/lang/generator/generate_validate_nonnegative.hpp 0ab5eca7ba94ba7a4b663ade233e7698 *inst/include/src/stan/lang/generator/generate_validate_tparam_inits.hpp 56877f869f1329948558748be64ba4e7 *inst/include/src/stan/lang/generator/generate_validate_var_decl.hpp 59a63aa181c559f30db17040a7d9c3c1 *inst/include/src/stan/lang/generator/generate_validate_var_dims.hpp 60addd675627669370cb5f71b024a119 *inst/include/src/stan/lang/generator/generate_var_constructor.hpp 5c5a697f4384e73b300a8b08a013ee60 *inst/include/src/stan/lang/generator/generate_var_fill_define.hpp 81fde569c4917f3cc1955f0a9b61fa3e *inst/include/src/stan/lang/generator/generate_version_comment.hpp 1407111c86d843394733436ba3b68af6 *inst/include/src/stan/lang/generator/generate_void_statement.hpp 605b0b67d96bee38804b4b4cd3177533 *inst/include/src/stan/lang/generator/generate_write_array_method.hpp 2c009fbd1c6c9918f6f011a436b5674a *inst/include/src/stan/lang/generator/generate_write_block_var.hpp 1653c7b686778d2a9acf4b4889fbd200 *inst/include/src/stan/lang/generator/get_block_var_dims.hpp 8f69abb156abd15df2860a2ea9a4e341 *inst/include/src/stan/lang/generator/get_typedef_var_type.hpp e15ab452aa638b19d3895b807f32ff71 *inst/include/src/stan/lang/generator/get_verbose_var_type.hpp f3df57314061908bc1e0cbbd60609a5c *inst/include/src/stan/lang/generator/idx_user_visgen.hpp fa4d282923626ada5dc37a8b2a969a80 *inst/include/src/stan/lang/generator/idx_visgen.hpp 505d69b156e41a68b49c3a31772463f2 *inst/include/src/stan/lang/generator/is_numbered_statement_vis.hpp 3cc117381a3af8ccc44daaba4b2c5ea2 *inst/include/src/stan/lang/generator/printable_visgen.hpp d5ca118a5cd2e63a728c74f6125b8d76 *inst/include/src/stan/lang/generator/statement_visgen.hpp a822f975d7334cc25e4f6382a02b3b24 *inst/include/src/stan/lang/generator/visgen.hpp 19cf4e520e1718b5d8b021aa38e7c3bb *inst/include/src/stan/lang/generator/write_begin_all_dims_col_maj_loop.hpp ddcf31b0e413cc1530289b904671c9a2 *inst/include/src/stan/lang/generator/write_begin_all_dims_row_maj_loop.hpp 7b9dfe0daf7b36cb14b1f4011679d3cf *inst/include/src/stan/lang/generator/write_begin_array_dims_loop.hpp f28d45f55eff9009f266e8007a7a645c *inst/include/src/stan/lang/generator/write_begin_param_elements_loop.hpp d8d7eaffde23860493a4dc12f87417af *inst/include/src/stan/lang/generator/write_constraints_fn.hpp 5952ff833bcfa945c9390718a9f1bd46 *inst/include/src/stan/lang/generator/write_end_loop.hpp 378b7b667667efb24acc2d70892d0932 *inst/include/src/stan/lang/generator/write_nested_resize_loop_begin.hpp db2039fd0f5ea41909043a62d27b1b85 *inst/include/src/stan/lang/generator/write_resize_var_idx.hpp 8cf5f6739d54e2a57f49c7730d41f1a2 *inst/include/src/stan/lang/generator/write_var_decl_arg.hpp 81c2746e1d12c0c78f7c3cc268f5142b *inst/include/src/stan/lang/generator/write_var_decl_type.hpp 31bf36cec6078a5a088ea727c989a716 *inst/include/src/stan/lang/generator/write_var_idx_all_dims.hpp 849ef24eab8588e1b7925a1f9f4d7e34 *inst/include/src/stan/lang/generator/write_var_idx_all_dims_msg.hpp 752c6c45f08669d3392d2fa94df5e1ae *inst/include/src/stan/lang/generator/write_var_idx_array_dims.hpp 1522ebce787148d43a73bdb5cf399c5f *inst/include/src/stan/lang/grammars/bare_type_grammar.hpp 01357a18f988dea8fe81a71b7d7da69b *inst/include/src/stan/lang/grammars/bare_type_grammar_def.hpp ed2dadf1c2857c378fd74e5972fe8697 *inst/include/src/stan/lang/grammars/bare_type_grammar_inst.cpp d9068c6d4e5f05ce7099edd202f9fc39 *inst/include/src/stan/lang/grammars/block_var_decls_grammar.hpp fc3e58f77172a220175f86e9909dc293 *inst/include/src/stan/lang/grammars/block_var_decls_grammar_def.hpp ac27aeba6ad7b3742ce3d34672750d3c *inst/include/src/stan/lang/grammars/block_var_decls_grammar_inst.cpp 329b9cfa10db9d42137b0e61e89207d4 *inst/include/src/stan/lang/grammars/common_adaptors_def.hpp f9f6cfd2d6f8767d78a4c499ffe92a05 *inst/include/src/stan/lang/grammars/expression07_grammar.hpp ee8a6f5c18216a1f823ea959eba9dee0 *inst/include/src/stan/lang/grammars/expression07_grammar_def.hpp 2cc346c011fa8d60f14ce20a89905845 *inst/include/src/stan/lang/grammars/expression07_grammar_inst.cpp 04a6cc9b89007b573ae02e344bce187a *inst/include/src/stan/lang/grammars/expression_grammar.hpp cc45c05113d4b27292d01232d7aa89bc *inst/include/src/stan/lang/grammars/expression_grammar_def.hpp d8678274d346e99fae4484d2d21a0f11 *inst/include/src/stan/lang/grammars/expression_grammar_inst.cpp fd6d04a9fdcd534ccea6d161c53a8218 *inst/include/src/stan/lang/grammars/functions_grammar.hpp 352af6b701a8c7d697cc7d0b62adf2cf *inst/include/src/stan/lang/grammars/functions_grammar_def.hpp 6784fe1874d76031f1e85160716756ca *inst/include/src/stan/lang/grammars/functions_grammar_inst.cpp 7cee9657c03e73557fcf3144460ea52c *inst/include/src/stan/lang/grammars/indexes_grammar.hpp a97cb4ef18e69dec4214929462a116fd *inst/include/src/stan/lang/grammars/indexes_grammar_def.hpp b8e25ebc527cd753372bb1123258d905 *inst/include/src/stan/lang/grammars/indexes_grammar_inst.cpp ea516753851cd92ffc03229999b746fc *inst/include/src/stan/lang/grammars/iterator_typedefs.hpp 75d36476f211c8a2b70c6f2f5ecb635a *inst/include/src/stan/lang/grammars/local_var_decls_grammar.hpp 4ea5341a207b5e756a079c1ea3eae01f *inst/include/src/stan/lang/grammars/local_var_decls_grammar_def.hpp 32d6f758782ef05605bba572436f45d3 *inst/include/src/stan/lang/grammars/local_var_decls_grammar_inst.cpp 7e2af2e9f4443e1450ce8b28b7ab246f *inst/include/src/stan/lang/grammars/program_grammar.hpp 5267922eb2c528c22bb43e0a33bd7c41 *inst/include/src/stan/lang/grammars/program_grammar_def.hpp e0bc9ce81f10724390bd82b63a1f9e00 *inst/include/src/stan/lang/grammars/program_grammar_inst.cpp 9368e2245059fd741375ce2f04761bd1 *inst/include/src/stan/lang/grammars/semantic_actions.hpp 3f5c71cc9b0dc75ab1dd755ef6459b51 *inst/include/src/stan/lang/grammars/semantic_actions_def.cpp 602b1ab25c6d08c7fcff28bab5f99549 *inst/include/src/stan/lang/grammars/statement_2_grammar.hpp a78b9d57c337840a26c1a1b131fe3fa1 *inst/include/src/stan/lang/grammars/statement_2_grammar_def.hpp 93630b9485d069f483825dca415222b7 *inst/include/src/stan/lang/grammars/statement_2_grammar_inst.cpp 74b3009979ec236b75061bcad771fb46 *inst/include/src/stan/lang/grammars/statement_grammar.hpp 40e5d9964acde118ff746836ba966b27 *inst/include/src/stan/lang/grammars/statement_grammar_def.hpp 108125bf70ae3b2794904fb8b4ecc3b0 *inst/include/src/stan/lang/grammars/statement_grammar_inst.cpp 5174fb627a67ef81232fde8a064c2b46 *inst/include/src/stan/lang/grammars/term_grammar.hpp c0cc3ed844c78b6226a6a006b6055031 *inst/include/src/stan/lang/grammars/term_grammar_def.hpp 27d2ad77296b40cabbcef82794ac1073 *inst/include/src/stan/lang/grammars/term_grammar_inst.cpp d513acd0b54b0f2175fe98ae19caeb53 *inst/include/src/stan/lang/grammars/whitespace_grammar.hpp 44cce94f6fd3a6ca594882d7de933a43 *inst/include/src/stan/lang/grammars/whitespace_grammar_def.hpp 937b0e8b9101246400f313e17f96e27e *inst/include/src/stan/lang/grammars/whitespace_grammar_inst.cpp 2df6c593423c40136d766e31944a36c1 *inst/include/src/stan/lang/parser.hpp 730a3de6643c99971b8012723e9d4860 *inst/include/src/stan/lang/rethrow_located.hpp c10d85a634ab4c8810aba1164e4b9409 *inst/include/src/stan/mcmc/base_adaptation.hpp b11082dc86382ac1c5a09fb3e476ab07 *inst/include/src/stan/mcmc/base_adapter.hpp 0502d5666299980aea11fab4138b34f1 *inst/include/src/stan/mcmc/base_mcmc.hpp ceb4b9159022a18c75d40b82ade6cb7b *inst/include/src/stan/mcmc/chains.hpp 3fc08cefd9934a3f0f42dcaf0bc4384e *inst/include/src/stan/mcmc/covar_adaptation.hpp 433d713a915c4e5f648cc453029d02aa *inst/include/src/stan/mcmc/fixed_param_sampler.hpp 8a31e5b3e4b0aaf94ae3d282865dd80a *inst/include/src/stan/mcmc/hmc/base_hmc.hpp f90f58b3e8cb1931714878aa05898aa3 *inst/include/src/stan/mcmc/hmc/hamiltonians/base_hamiltonian.hpp c4e393ec48dc408bbb45130809a5cf78 *inst/include/src/stan/mcmc/hmc/hamiltonians/dense_e_metric.hpp ecd9cba40b07807eae2dddfc8bad9954 *inst/include/src/stan/mcmc/hmc/hamiltonians/dense_e_point.hpp 2bdbc330a4645987fb90b03695fe01d6 *inst/include/src/stan/mcmc/hmc/hamiltonians/diag_e_metric.hpp 35d3681be9f9a66faa8e5075661fe166 *inst/include/src/stan/mcmc/hmc/hamiltonians/diag_e_point.hpp ec25866d0af83590b4ee28b6f710b860 *inst/include/src/stan/mcmc/hmc/hamiltonians/ps_point.hpp 3f3f54ca5609bee4c1b7c0bf3f089032 *inst/include/src/stan/mcmc/hmc/hamiltonians/softabs_metric.hpp 0a110456c9c654a42002212e2481e44d *inst/include/src/stan/mcmc/hmc/hamiltonians/softabs_point.hpp 4023d4ab7d1d6adae30b4009d1d723c1 *inst/include/src/stan/mcmc/hmc/hamiltonians/unit_e_metric.hpp 3f5a2f18114a5008485df95c44edb837 *inst/include/src/stan/mcmc/hmc/hamiltonians/unit_e_point.hpp fae768906314938a69e038811c1599a0 *inst/include/src/stan/mcmc/hmc/integrators/base_integrator.hpp c90cad3a1b800b02b9d9f26c645ea518 *inst/include/src/stan/mcmc/hmc/integrators/base_leapfrog.hpp f590bc51abf76a389fea3a2309502fe1 *inst/include/src/stan/mcmc/hmc/integrators/expl_leapfrog.hpp bc60aca062c3e60d77b5649d3ac20e4d *inst/include/src/stan/mcmc/hmc/integrators/impl_leapfrog.hpp 120280620e2e26d9e511bb1fc17d16ee *inst/include/src/stan/mcmc/hmc/nuts/adapt_dense_e_nuts.hpp 5757c3349d0e68c6c4ccf191a354dba8 *inst/include/src/stan/mcmc/hmc/nuts/adapt_diag_e_nuts.hpp b764a564765ba8e6fd5aa465314b93a3 *inst/include/src/stan/mcmc/hmc/nuts/adapt_softabs_nuts.hpp 174a1ac2fb4f7ac459e49a151ed88fb4 *inst/include/src/stan/mcmc/hmc/nuts/adapt_unit_e_nuts.hpp 2fbf578917dc668d16157ed53ff815b9 *inst/include/src/stan/mcmc/hmc/nuts/base_nuts.hpp 7c0041b1ed401cb09b1af88e5c5d825b *inst/include/src/stan/mcmc/hmc/nuts/dense_e_nuts.hpp 5758356af7355f907ac2a3be1bbe019e *inst/include/src/stan/mcmc/hmc/nuts/diag_e_nuts.hpp b3a427bb83a57c8b71b9b2a8596b20c9 *inst/include/src/stan/mcmc/hmc/nuts/softabs_nuts.hpp c108c834f3003f41fea8c2916733aef1 *inst/include/src/stan/mcmc/hmc/nuts/unit_e_nuts.hpp 9764eab397400de386bb0376353812e7 *inst/include/src/stan/mcmc/hmc/nuts_classic/adapt_dense_e_nuts_classic.hpp d0896871230ac3708c143ccef4567178 *inst/include/src/stan/mcmc/hmc/nuts_classic/adapt_diag_e_nuts_classic.hpp 7f1bb5ee3f0eb6776ec8d4b2707ee1f8 *inst/include/src/stan/mcmc/hmc/nuts_classic/adapt_unit_e_nuts_classic.hpp 036a81d775b7c8fcf64e78797798a09c *inst/include/src/stan/mcmc/hmc/nuts_classic/base_nuts_classic.hpp b00808cefbc72cebf5c38bd2fea7ca69 *inst/include/src/stan/mcmc/hmc/nuts_classic/dense_e_nuts_classic.hpp ee11d39d53250367b5260223a688a95b *inst/include/src/stan/mcmc/hmc/nuts_classic/diag_e_nuts_classic.hpp 28abcbee705ca57acf3de8093dd27061 *inst/include/src/stan/mcmc/hmc/nuts_classic/unit_e_nuts_classic.hpp 06b6d25275b97d76c920f2c2659528d6 *inst/include/src/stan/mcmc/hmc/static/adapt_dense_e_static_hmc.hpp 4a50bc8495da52b435d0ce87934af61a *inst/include/src/stan/mcmc/hmc/static/adapt_diag_e_static_hmc.hpp 5b7ced6ccffb6009568e8fd8a87d48f4 *inst/include/src/stan/mcmc/hmc/static/adapt_softabs_static_hmc.hpp c5004000ac83cf04a05e9ef550ae450a *inst/include/src/stan/mcmc/hmc/static/adapt_unit_e_static_hmc.hpp 63ce442578c7c2b069bb15d691b06fa6 *inst/include/src/stan/mcmc/hmc/static/base_static_hmc.hpp 086dd35078d569fa6f06d00720e0e4fd *inst/include/src/stan/mcmc/hmc/static/dense_e_static_hmc.hpp b77bb0267e82ab56d0e1f7e0a550e39e *inst/include/src/stan/mcmc/hmc/static/diag_e_static_hmc.hpp a724a6939cd662e47d3a96fd9c13f1b7 *inst/include/src/stan/mcmc/hmc/static/softabs_static_hmc.hpp fe0e4e863469266e1fc82359a2bb4b90 *inst/include/src/stan/mcmc/hmc/static/unit_e_static_hmc.hpp a90aad32c8a8b2c929065b1e6a249faf *inst/include/src/stan/mcmc/hmc/static_uniform/adapt_dense_e_static_uniform.hpp efcda4b6b2a90f435684db0f892fe353 *inst/include/src/stan/mcmc/hmc/static_uniform/adapt_diag_e_static_uniform.hpp dbf52302d8de561e67d1ff971f778a9c *inst/include/src/stan/mcmc/hmc/static_uniform/adapt_softabs_static_uniform.hpp 560476a41ec4149478b3c442cafab71e *inst/include/src/stan/mcmc/hmc/static_uniform/adapt_unit_e_static_uniform.hpp b82acfe4c6795f41fe47248bee3680d5 *inst/include/src/stan/mcmc/hmc/static_uniform/base_static_uniform.hpp afb880a0d034ed7db889556205c6c290 *inst/include/src/stan/mcmc/hmc/static_uniform/dense_e_static_uniform.hpp 99ca8daa44b418889c5c6648b6aba757 *inst/include/src/stan/mcmc/hmc/static_uniform/diag_e_static_uniform.hpp a304dddb2f5e94d6b2e21b073b17d3f7 *inst/include/src/stan/mcmc/hmc/static_uniform/softabs_static_uniform.hpp ad4baffdff08b2fe45ec0d6f352b7856 *inst/include/src/stan/mcmc/hmc/static_uniform/unit_e_static_uniform.hpp 3d5bec75eb28fb6346fbfa5444950985 *inst/include/src/stan/mcmc/hmc/xhmc/adapt_dense_e_xhmc.hpp ebae16dd6f7df685cf98a499a9fb5bca *inst/include/src/stan/mcmc/hmc/xhmc/adapt_diag_e_xhmc.hpp 686c7314cc4b4d789d6725f83c4f307f *inst/include/src/stan/mcmc/hmc/xhmc/adapt_softabs_xhmc.hpp b9971572869ef94f953a52c04be1c715 *inst/include/src/stan/mcmc/hmc/xhmc/adapt_unit_e_xhmc.hpp a762f7cae8514d35b62ab9e820b9fd8b *inst/include/src/stan/mcmc/hmc/xhmc/base_xhmc.hpp b6153507d4a5a0ce05af5a49680fde12 *inst/include/src/stan/mcmc/hmc/xhmc/dense_e_xhmc.hpp 70b173c63b94771e33f0103ec7561534 *inst/include/src/stan/mcmc/hmc/xhmc/diag_e_xhmc.hpp 62e0897195c150de29148fd4ed94bef3 *inst/include/src/stan/mcmc/hmc/xhmc/softabs_xhmc.hpp ae195655021d3e38346c6da4f7475ba5 *inst/include/src/stan/mcmc/hmc/xhmc/unit_e_xhmc.hpp 3339cf85e004137462ea94c7a60c0fb2 *inst/include/src/stan/mcmc/sample.hpp 457105d750d7f4cce5e3969372c10d93 *inst/include/src/stan/mcmc/stepsize_adaptation.hpp 232192a90174f5812c1a6b4c8f023e44 *inst/include/src/stan/mcmc/stepsize_adapter.hpp a2a92889cf850f86740be71c06efa15b *inst/include/src/stan/mcmc/stepsize_covar_adapter.hpp d52cfd6d92f268afd77b2371a2c6ce21 *inst/include/src/stan/mcmc/stepsize_var_adapter.hpp d7d3ee86dd7caf51f6609b0e056b3ab2 *inst/include/src/stan/mcmc/var_adaptation.hpp 7f77a3b25f415468bb0a101114931c67 *inst/include/src/stan/mcmc/windowed_adaptation.hpp 8e578b24882d76175a2db72092651308 *inst/include/src/stan/model/finite_diff_grad.hpp ca20fa31c3fab30c5dbeeed2c76e02b2 *inst/include/src/stan/model/grad_hess_log_prob.hpp 9a7b5cc9656cc495709ee445054d6a31 *inst/include/src/stan/model/grad_tr_mat_times_hessian.hpp 608037332cf4f4ccdb6fb38d1f3c9a9f *inst/include/src/stan/model/gradient.hpp 359ab01930de98348fd794b1e6ee3bf3 *inst/include/src/stan/model/gradient_dot_vector.hpp 402d814120bf1323772948183b49bd05 *inst/include/src/stan/model/hessian.hpp bc4eb8aa6ba8f84fa98728dcd4318e9e *inst/include/src/stan/model/hessian_times_vector.hpp 2fe7c5ba1225d82cff29569b465b1c57 *inst/include/src/stan/model/indexing.hpp ffbdde29332c90980aa1da740d0cb369 *inst/include/src/stan/model/indexing/deep_copy.hpp bb8559fb066b3a5da638fc4beb5ad2ce *inst/include/src/stan/model/indexing/index.hpp b1a99900cd9979901ea14bec9c78d98f *inst/include/src/stan/model/indexing/index_list.hpp 5632a790337d5617df2bce3d81aabe8b *inst/include/src/stan/model/indexing/lvalue.hpp 0d53fe6abe13aabe0d1d18db74e07810 *inst/include/src/stan/model/indexing/rvalue.hpp 37a48f7813f2ce92cf3af60258531bdd *inst/include/src/stan/model/indexing/rvalue_at.hpp e375ebc059242201e813907f4f8746db *inst/include/src/stan/model/indexing/rvalue_index_size.hpp e33220e4d81de915a22ce2a21ce14ac6 *inst/include/src/stan/model/indexing/rvalue_return.hpp ec4359724170543ce11f3215001da00b *inst/include/src/stan/model/log_prob_grad.hpp 1647f18f77ec748d489dac64693dd43e *inst/include/src/stan/model/log_prob_propto.hpp 6036afb25af1aa5aba5ef7133f48134f *inst/include/src/stan/model/model_base.hpp 2a0231c4307ed63fa71e57b4fd524942 *inst/include/src/stan/model/model_base_crtp.hpp c120faa5d54db20b00fc35e6ec61fb58 *inst/include/src/stan/model/model_functional.hpp ae90861e3d64c824cee888cabc9710e1 *inst/include/src/stan/model/model_header.hpp fee82dbb12c55f5027f343e41adea235 *inst/include/src/stan/model/prob_grad.hpp e6a2e778f127c1520807be3d6e984a19 *inst/include/src/stan/model/standalone_functions_header.hpp eb0b3a812da4ca9650ac9e9cb9b31b1e *inst/include/src/stan/model/test_gradients.hpp 9d1dae79915c260f4078d61aeb4e1025 *inst/include/src/stan/optimization/bfgs.hpp a5abb83d3abbe793ab98b2cf7980eaf3 *inst/include/src/stan/optimization/bfgs_linesearch.hpp 884a21f816a41bb86bfd42658d39438f *inst/include/src/stan/optimization/bfgs_update.hpp 89eced00e547116c58d69308fa424a82 *inst/include/src/stan/optimization/lbfgs_update.hpp 4bd3219fe2a6ecdcaf84c1238f26a221 *inst/include/src/stan/optimization/newton.hpp 07f58c482804180bd5a54576fc7ff4ea *inst/include/src/stan/services/diagnose/defaults.hpp 4215b5231afe791a0bef04152722d29b *inst/include/src/stan/services/diagnose/diagnose.hpp 679e252f18e8dd28cf327e0afd4f01e8 *inst/include/src/stan/services/error_codes.hpp 765e2aa579eaa65ba1dccb3f6bfe84a3 *inst/include/src/stan/services/experimental/advi/defaults.hpp c7a4d75047425f44294fb1a64b09056e *inst/include/src/stan/services/experimental/advi/fullrank.hpp fe917a948bf4e43832e7079c3ae2537d *inst/include/src/stan/services/experimental/advi/meanfield.hpp 573967f9599bd73124e7f432e3602baf *inst/include/src/stan/services/optimize/bfgs.hpp 06be68d266dcb0cd701939dd1d4750b9 *inst/include/src/stan/services/optimize/defaults.hpp 60793fbf0d4b4411040bbd465f38d2ed *inst/include/src/stan/services/optimize/lbfgs.hpp cfd5f76cdfc5e223dc0499ef307aad51 *inst/include/src/stan/services/optimize/newton.hpp b0d26d3f90d9bceb7f4468c25fd2e57f *inst/include/src/stan/services/sample/defaults.hpp a3f1504ca424d68e22836e24645d3124 *inst/include/src/stan/services/sample/fixed_param.hpp 70a163428566b1dcd850d74660a55f5a *inst/include/src/stan/services/sample/hmc_nuts_dense_e.hpp f651cf7c1a932b9c3484da19fdeae3ed *inst/include/src/stan/services/sample/hmc_nuts_dense_e_adapt.hpp baa25cb625ce8500747a63d852f0b05e *inst/include/src/stan/services/sample/hmc_nuts_diag_e.hpp 203295479d0d69a04f064c5fa7e54dd3 *inst/include/src/stan/services/sample/hmc_nuts_diag_e_adapt.hpp 9f5fc27622414a1eeaff1192f53b91b1 *inst/include/src/stan/services/sample/hmc_nuts_unit_e.hpp 0ee80b66b367f9b8e958de9fa9ab4fec *inst/include/src/stan/services/sample/hmc_nuts_unit_e_adapt.hpp ed0b186487e4e1563b3e41e8eadbe0c6 *inst/include/src/stan/services/sample/hmc_static_dense_e.hpp 75bc271e77078a7e04aefd0cc8a15f9a *inst/include/src/stan/services/sample/hmc_static_dense_e_adapt.hpp f995d0171618ea45c22a42e1b3c2e1e3 *inst/include/src/stan/services/sample/hmc_static_diag_e.hpp 19fab185f5734ae2f1083dab370d6de1 *inst/include/src/stan/services/sample/hmc_static_diag_e_adapt.hpp 10779e0db5609d7635111ea9eaff8e92 *inst/include/src/stan/services/sample/hmc_static_unit_e.hpp a7f49ed362d1c5ecd34f1911555e2146 *inst/include/src/stan/services/sample/hmc_static_unit_e_adapt.hpp 45b3c64ee50e19a4af2e86acc55f0d4a *inst/include/src/stan/services/sample/standalone_gqs.hpp 6c96312fbffaa620c0ef23c15deccfff *inst/include/src/stan/services/util/create_rng.hpp 8233d403562f793e2a75c054d00b0651 *inst/include/src/stan/services/util/create_unit_e_dense_inv_metric.hpp a468032f85897e36284add30821390b6 *inst/include/src/stan/services/util/create_unit_e_diag_inv_metric.hpp 20711f9dcb58405998e370fd065b3e96 *inst/include/src/stan/services/util/experimental_message.hpp 705d87b36a4780a0a8b054b2ded21d34 *inst/include/src/stan/services/util/generate_transitions.hpp d2c0d8b4f737dbb8c0982205dbba0081 *inst/include/src/stan/services/util/gq_writer.hpp ca35b8a387a1788731e98e9842bb8204 *inst/include/src/stan/services/util/initialize.hpp 8d87e4604687fda54f54ab452eb0d858 *inst/include/src/stan/services/util/inv_metric.hpp cfcc693252c2041b9c154cf02e3463f7 *inst/include/src/stan/services/util/mcmc_writer.hpp ba31cf71af8a1b33fca3c2b38ae6f8bc *inst/include/src/stan/services/util/read_dense_inv_metric.hpp 3517f423ea225534503e311f65e1f817 *inst/include/src/stan/services/util/read_diag_inv_metric.hpp 624b8a446a388296a182fc19eff44e3e *inst/include/src/stan/services/util/run_adaptive_sampler.hpp d9d46152f5e3fa91bc9dc6075cbb0ef3 *inst/include/src/stan/services/util/run_sampler.hpp 171b54b20f17658c82425964a9c85667 *inst/include/src/stan/services/util/validate_dense_inv_metric.hpp a14c30be4383ce2534a84a7bc3b1cfa0 *inst/include/src/stan/services/util/validate_diag_inv_metric.hpp d913752093ed19d750f0c521c2e9175c *inst/include/src/stan/variational/advi.hpp 787e82454ffdd39728adf6f07e5b128c *inst/include/src/stan/variational/base_family.hpp d6f1e0cd652d207ff17cca5990975530 *inst/include/src/stan/variational/families/normal_fullrank.hpp 92c05bc9bc186942135fe6af04a13b13 *inst/include/src/stan/variational/families/normal_meanfield.hpp b970cf229338407cada488b9ee3d0b57 *inst/include/src/stan/variational/print_progress.hpp 673d4d9e5f4d3e1509f0e75f6b55440e *inst/include/src/stan/version.hpp f4b3c635b658faed84e43bc7337a7ffc *inst/include/stan/math.hpp eee7cd13587959cea4ee9b450c89005f *inst/include/stan/math/fwd/arr.hpp 0ce06dc2664b1a2bde309bba74cebd72 *inst/include/stan/math/fwd/arr/fun/log_sum_exp.hpp 569585a0e2623e74b7b88ce83376bc7e *inst/include/stan/math/fwd/arr/fun/sum.hpp 95581b6686c01434e7d92c920e12228a *inst/include/stan/math/fwd/arr/fun/to_fvar.hpp af770c18f67d5628b92d4076905c495e *inst/include/stan/math/fwd/core.hpp fd8a4027b3a3ddb13b798cef071aa6f4 *inst/include/stan/math/fwd/core/fvar.hpp 238ed927083f1385452973094e5c70ec *inst/include/stan/math/fwd/core/operator_addition.hpp 28f62b2768504b90d42dc6832fc9bc73 *inst/include/stan/math/fwd/core/operator_division.hpp de8b4e221175c599cffee1d0fac92866 *inst/include/stan/math/fwd/core/operator_equal.hpp 6073f5cd560b66b298c906651ed9f940 *inst/include/stan/math/fwd/core/operator_greater_than.hpp 3178d1238173c1e18e1f75a3d1d99bc2 *inst/include/stan/math/fwd/core/operator_greater_than_or_equal.hpp 94d720ade2715fc43b975cade37bd5b0 *inst/include/stan/math/fwd/core/operator_less_than.hpp 081697396be9892848a9572c8b5abfdd *inst/include/stan/math/fwd/core/operator_less_than_or_equal.hpp 18e4fc9a6a6e1e0588cb7a5ef341f324 *inst/include/stan/math/fwd/core/operator_logical_and.hpp b88686e7944d1d38cc62912daa01eca1 *inst/include/stan/math/fwd/core/operator_logical_or.hpp 9bd08b0d02f78f309c22197189a1dbc9 *inst/include/stan/math/fwd/core/operator_multiplication.hpp d777c6aa41767afb3d37ac692516c15f *inst/include/stan/math/fwd/core/operator_not_equal.hpp 3a7967b4ce2bed0c0d5c9468cd010fe5 *inst/include/stan/math/fwd/core/operator_subtraction.hpp 4b3dd1ad5ea5dd83b7222df07d2ec49f *inst/include/stan/math/fwd/core/operator_unary_minus.hpp db17781dd2497d31145a31957a750799 *inst/include/stan/math/fwd/core/operator_unary_not.hpp 04d03ec668034c80189078c39293153c *inst/include/stan/math/fwd/core/operator_unary_plus.hpp 70907dea441d76660917ee8aaeed5831 *inst/include/stan/math/fwd/core/std_numeric_limits.hpp 725a4dea459c9c254872a50628e67183 *inst/include/stan/math/fwd/mat.hpp 6c22b88045fdbde05651c137b517ad2d *inst/include/stan/math/fwd/mat/fun/Eigen_NumTraits.hpp e0c723ed0f33e4c7cbd80a7ea355868a *inst/include/stan/math/fwd/mat/fun/columns_dot_product.hpp 2afe15d984dc9f72927c474ff6da9274 *inst/include/stan/math/fwd/mat/fun/columns_dot_self.hpp abdeb6c1c085d73439908ae8613061d0 *inst/include/stan/math/fwd/mat/fun/crossprod.hpp 486756525a0226a688810e0beb7f2679 *inst/include/stan/math/fwd/mat/fun/determinant.hpp d8cd3336904f0271fd525d137498f885 *inst/include/stan/math/fwd/mat/fun/divide.hpp 7c395a0a3eb6166538e37428f006e4f0 *inst/include/stan/math/fwd/mat/fun/dot_product.hpp 24d5556c90ce647c84f8330e2ba5d1c4 *inst/include/stan/math/fwd/mat/fun/dot_self.hpp 157901c29ae36041acdd4aedb0f7963e *inst/include/stan/math/fwd/mat/fun/inverse.hpp 49f8155d35702e2d9cb35d1affd2819e *inst/include/stan/math/fwd/mat/fun/log_determinant.hpp 5f2bcfae098734bc903ff717821efc0d *inst/include/stan/math/fwd/mat/fun/log_softmax.hpp 46427c0346a5d710edd97b1dc5e8f13a *inst/include/stan/math/fwd/mat/fun/log_sum_exp.hpp 19248a56ba295dc3b64a6a12523c0070 *inst/include/stan/math/fwd/mat/fun/mdivide_left.hpp 36a44222a051fc7da7aa5921d3cd3c02 *inst/include/stan/math/fwd/mat/fun/mdivide_left_ldlt.hpp 993f67234a6cb97c768a7d0a401df5fe *inst/include/stan/math/fwd/mat/fun/mdivide_left_tri_low.hpp 473681efe7d33d1c4a5d6635e4599c0e *inst/include/stan/math/fwd/mat/fun/mdivide_right.hpp 8380da4cfe893cd04cb9a7e26dee6f28 *inst/include/stan/math/fwd/mat/fun/mdivide_right_tri_low.hpp 4892011b2315f1838662d5d0929bcc45 *inst/include/stan/math/fwd/mat/fun/multiply.hpp 7f54e7162281590f38ce74c2cffdd13b *inst/include/stan/math/fwd/mat/fun/multiply_lower_tri_self_transpose.hpp a77adf9a043225c822b38506f2399aa5 *inst/include/stan/math/fwd/mat/fun/qr_Q.hpp 3dab67b5c545a1d35ec6e69c82055dbf *inst/include/stan/math/fwd/mat/fun/qr_R.hpp ca3b42e8b98fd1c51205d409db7d1859 *inst/include/stan/math/fwd/mat/fun/quad_form_sym.hpp 464411fd2bd09d73eb79682d31f3f07f *inst/include/stan/math/fwd/mat/fun/rows_dot_product.hpp 08902f7fab64026c56f87739942daea6 *inst/include/stan/math/fwd/mat/fun/rows_dot_self.hpp de0fca5779c0774ac6ce2fb6dbb0ccd6 *inst/include/stan/math/fwd/mat/fun/softmax.hpp 444703e921320314938e578044e83221 *inst/include/stan/math/fwd/mat/fun/squared_distance.hpp b031fa84da71e94c7468c06a4941716c *inst/include/stan/math/fwd/mat/fun/sum.hpp b8a68ef5e39ff47464e2b02d9f0ba271 *inst/include/stan/math/fwd/mat/fun/tcrossprod.hpp eb52fe6b08857dee2c240361eed65ae0 *inst/include/stan/math/fwd/mat/fun/to_fvar.hpp d064e10c6dce09599d5a492a678b41c7 *inst/include/stan/math/fwd/mat/fun/trace_gen_quad_form.hpp 3db75b6a9212229a49041a00577bb705 *inst/include/stan/math/fwd/mat/fun/trace_quad_form.hpp 44adaccef273da05652d345019bc9aa8 *inst/include/stan/math/fwd/mat/fun/typedefs.hpp 753db2ab0f156478111e201748d6ee7f *inst/include/stan/math/fwd/mat/fun/unit_vector_constrain.hpp f5650ee0d3dc1e4b581f14c737dea11d *inst/include/stan/math/fwd/mat/functor/gradient.hpp d2a45866b107676ce553254015c49df9 *inst/include/stan/math/fwd/mat/functor/hessian.hpp dca57a9d9ea17788c22d835fdcfdee1a *inst/include/stan/math/fwd/mat/functor/jacobian.hpp 8d6ab5d5ced75150b49b2854b65b2025 *inst/include/stan/math/fwd/mat/meta/operands_and_partials.hpp 378f5e62d245251bf36965b8bc8d92a5 *inst/include/stan/math/fwd/mat/vectorize/apply_scalar_unary.hpp dbe3a6a63bf75d5fdd28b084e15cb41e *inst/include/stan/math/fwd/meta.hpp b4e14d67f055b3139541c54b18d019c4 *inst/include/stan/math/fwd/scal.hpp e85cf4f2fb3082046f29df91f1fe9560 *inst/include/stan/math/fwd/scal/fun/Phi.hpp aabc63ee8bc7844bfbf78cfd923fd7e2 *inst/include/stan/math/fwd/scal/fun/Phi_approx.hpp 21e5c80bb3fb7f5c939f6c6c3914121a *inst/include/stan/math/fwd/scal/fun/abs.hpp 9111dce6891a34f8a5869f3b7143287e *inst/include/stan/math/fwd/scal/fun/acos.hpp 23596efcac76f84eeaeb1087b9a2c4d2 *inst/include/stan/math/fwd/scal/fun/acosh.hpp 8d101f5d57437a85a4c9cd3a484a43f1 *inst/include/stan/math/fwd/scal/fun/asin.hpp 5706a41cc6d21e8a99b390f94bb00fcb *inst/include/stan/math/fwd/scal/fun/asinh.hpp a55853c69636e507075f274ea7ab30b2 *inst/include/stan/math/fwd/scal/fun/atan.hpp 4f83b428bf7d2299dd0dfdacd73b207d *inst/include/stan/math/fwd/scal/fun/atan2.hpp d6b3bf2b5921879c78e6e386d23fe37b *inst/include/stan/math/fwd/scal/fun/atanh.hpp fe2f8ff152fa6d2cd77c2b6bdd6c32c1 *inst/include/stan/math/fwd/scal/fun/bessel_first_kind.hpp e425b40ba8578ced8afb3ecfe2ef9692 *inst/include/stan/math/fwd/scal/fun/bessel_second_kind.hpp 9b91ca8cdc572a542ac26baf0c802f84 *inst/include/stan/math/fwd/scal/fun/beta.hpp 6215bba95bf6f3a409268d7998affd9f *inst/include/stan/math/fwd/scal/fun/binary_log_loss.hpp 5efaf8746a40ce9e0faec2b34d9dfc3c *inst/include/stan/math/fwd/scal/fun/binomial_coefficient_log.hpp b703c0b4eca8c0c09b88281257faa597 *inst/include/stan/math/fwd/scal/fun/cbrt.hpp a11ebe50c21c5d80f0aa3f66e9eb54b9 *inst/include/stan/math/fwd/scal/fun/ceil.hpp 8b56de404e0b542a2f2234cb76247acd *inst/include/stan/math/fwd/scal/fun/cos.hpp 5f6a1c1945b01cb370d39c26e11bc40e *inst/include/stan/math/fwd/scal/fun/cosh.hpp 3e467901ff237ef670cf4ef3a0962f78 *inst/include/stan/math/fwd/scal/fun/digamma.hpp e3bd9102eb6457857fa741a7783f2bf2 *inst/include/stan/math/fwd/scal/fun/erf.hpp f30e77d6d214d4f111bdd6c79fbccb88 *inst/include/stan/math/fwd/scal/fun/erfc.hpp 8e2aa798b935f45510ea3701fbfdd377 *inst/include/stan/math/fwd/scal/fun/exp.hpp 6deee242bc775aff530ab47f55fdb237 *inst/include/stan/math/fwd/scal/fun/exp2.hpp f1fdbdb041c3e82f8e30451f24016b01 *inst/include/stan/math/fwd/scal/fun/expm1.hpp e0c64e5613b8ec64c356b55c914e5fdb *inst/include/stan/math/fwd/scal/fun/fabs.hpp 98b7525058f149ba941600f9414a04cd *inst/include/stan/math/fwd/scal/fun/falling_factorial.hpp b1629eb50df0a0674991621f139debb4 *inst/include/stan/math/fwd/scal/fun/fdim.hpp bf86560b4ac63e121e180492e4c645ff *inst/include/stan/math/fwd/scal/fun/floor.hpp d6ef0a63636995369d6e8ef6bf8033de *inst/include/stan/math/fwd/scal/fun/fma.hpp 556d22950132591396325c538bf6a540 *inst/include/stan/math/fwd/scal/fun/fmax.hpp 4eb4a299ad0a3f887592679b546dcea1 *inst/include/stan/math/fwd/scal/fun/fmin.hpp ec73f44056ca87ed803de2713e0baa64 *inst/include/stan/math/fwd/scal/fun/fmod.hpp 3d60bf4f945efcd56a93c3813fe46102 *inst/include/stan/math/fwd/scal/fun/gamma_p.hpp cd9e6f1e7e655650506dcea7cdb52a67 *inst/include/stan/math/fwd/scal/fun/gamma_q.hpp 4b4b92eeb9e509bb5caf6fe5a051e311 *inst/include/stan/math/fwd/scal/fun/grad_inc_beta.hpp 6931514ad175cd5bb6789d5cca40d2b1 *inst/include/stan/math/fwd/scal/fun/hypot.hpp 88f6881db7184a2962fc02f76218fe91 *inst/include/stan/math/fwd/scal/fun/inc_beta.hpp 1e1d49f0aa4142190ca3f384525264b7 *inst/include/stan/math/fwd/scal/fun/inv.hpp 0ac5e3256dffbcd29f894f4ef61c11af *inst/include/stan/math/fwd/scal/fun/inv_Phi.hpp 3103bdc87aa103785c0b750112008449 *inst/include/stan/math/fwd/scal/fun/inv_cloglog.hpp 60db9f8714b79fb7371b3e1a161336c7 *inst/include/stan/math/fwd/scal/fun/inv_logit.hpp 5f746305b5b340bb246d292b11f5f2ef *inst/include/stan/math/fwd/scal/fun/inv_sqrt.hpp 99fea58eb8c7b02feaf1b5cdd847f39f *inst/include/stan/math/fwd/scal/fun/inv_square.hpp 9de40328ddacd79c2395cec2cc36a3c9 *inst/include/stan/math/fwd/scal/fun/is_inf.hpp 572d3dad97772d892304b4c1953eaacc *inst/include/stan/math/fwd/scal/fun/is_nan.hpp 1dee3dd88181ac3c0ebb9347b40fec06 *inst/include/stan/math/fwd/scal/fun/lbeta.hpp 3cfc17880edec42c4939d92cb8df16eb *inst/include/stan/math/fwd/scal/fun/ldexp.hpp b9d9b8a8951c8b293438eaab032ece0c *inst/include/stan/math/fwd/scal/fun/lgamma.hpp 528846fe713571f782425d86cb591e77 *inst/include/stan/math/fwd/scal/fun/lmgamma.hpp 006ffe9c33026bad62f286934b0caf1f *inst/include/stan/math/fwd/scal/fun/log.hpp 2a8ad19e2478ee630313aa26e182da94 *inst/include/stan/math/fwd/scal/fun/log10.hpp e55728338b67d650eb333688c19a4127 *inst/include/stan/math/fwd/scal/fun/log1m.hpp 20e33c5e993b99c8d82e87a9ff9f18bd *inst/include/stan/math/fwd/scal/fun/log1m_exp.hpp ddf9c599530034a07ea901a6a0300404 *inst/include/stan/math/fwd/scal/fun/log1m_inv_logit.hpp 6b377a1aff1726d04653e35ba574b600 *inst/include/stan/math/fwd/scal/fun/log1p.hpp 6b4fe7b357406772da5cf11b94048480 *inst/include/stan/math/fwd/scal/fun/log1p_exp.hpp 34cb6b19c9830850659b56089bcc8028 *inst/include/stan/math/fwd/scal/fun/log2.hpp 730fd23d362f7f5dc3798ebf55f7574b *inst/include/stan/math/fwd/scal/fun/log_diff_exp.hpp b787d7bd7fbc73108a25f7e316533da8 *inst/include/stan/math/fwd/scal/fun/log_falling_factorial.hpp 35e12ce25f2ff21670a6708598a66b28 *inst/include/stan/math/fwd/scal/fun/log_inv_logit.hpp f024c8938734243e7341e0d6bd7dab06 *inst/include/stan/math/fwd/scal/fun/log_inv_logit_diff.hpp 5d27f7a0915d111c298cf05679693248 *inst/include/stan/math/fwd/scal/fun/log_mix.hpp 83b287e509e67f74aaa0261ae8262126 *inst/include/stan/math/fwd/scal/fun/log_rising_factorial.hpp 6143e36a5a8ed7c724b00e976bb42c82 *inst/include/stan/math/fwd/scal/fun/log_sum_exp.hpp 515d76b26e1746d759a4ac1fc01285b9 *inst/include/stan/math/fwd/scal/fun/logit.hpp f95250568aa9b9ed7aa5b86a1c2b6fae *inst/include/stan/math/fwd/scal/fun/modified_bessel_first_kind.hpp b911ce1ca636cae44f0f12c0c845e766 *inst/include/stan/math/fwd/scal/fun/modified_bessel_second_kind.hpp 438566049764f07ebd090b625edf13d4 *inst/include/stan/math/fwd/scal/fun/multiply_log.hpp 563589864afd61c0f402f2bc52cd57d9 *inst/include/stan/math/fwd/scal/fun/owens_t.hpp 38dfef9bfbbb6591442af1ad7aeb44b5 *inst/include/stan/math/fwd/scal/fun/pow.hpp 03921d6ec3055f5a60f802f37968ca8e *inst/include/stan/math/fwd/scal/fun/primitive_value.hpp 807417584829a8b68ec8cefe511062a9 *inst/include/stan/math/fwd/scal/fun/rising_factorial.hpp 90d3a532f168999812d09a962d813505 *inst/include/stan/math/fwd/scal/fun/round.hpp c4f722766e831d81f9559efbfa5794fe *inst/include/stan/math/fwd/scal/fun/sin.hpp 02889550df8bbdecdea51fd4289f7d4a *inst/include/stan/math/fwd/scal/fun/sinh.hpp e1b25e6cb50cd59a68f8483267f03534 *inst/include/stan/math/fwd/scal/fun/sqrt.hpp 88b22abed35f906ab3b56e2a1702e4bc *inst/include/stan/math/fwd/scal/fun/square.hpp 48b170a75dcb70d31dbe055d4482ae61 *inst/include/stan/math/fwd/scal/fun/tan.hpp 934bf5302112df92ccc744f09098b764 *inst/include/stan/math/fwd/scal/fun/tanh.hpp 66e0c0fbcfee141a8df9365f021c0367 *inst/include/stan/math/fwd/scal/fun/tgamma.hpp 5a439e8839a2b5c4e670aee5e29e851b *inst/include/stan/math/fwd/scal/fun/to_fvar.hpp 0edbe6f1a1c749a1aad0adf843c8528b *inst/include/stan/math/fwd/scal/fun/trigamma.hpp 8bfc41c0df100fed01290088b9102cdc *inst/include/stan/math/fwd/scal/fun/trunc.hpp 05fce6f8fa7321ee64f9e69fef5d18be *inst/include/stan/math/fwd/scal/fun/value_of.hpp 2590fb7d5d041d36fb252b6f7f8acd7d *inst/include/stan/math/fwd/scal/fun/value_of_rec.hpp 64be2cec01d03ad691dddc6926399e6a *inst/include/stan/math/fwd/scal/meta/is_fvar.hpp d54417e569ff7e8848d0de715363db62 *inst/include/stan/math/fwd/scal/meta/operands_and_partials.hpp e80bc75291279c3f3abb6e0747a9c56c *inst/include/stan/math/fwd/scal/meta/partials_type.hpp dda210c25b81a5079ad12e99d98d8939 *inst/include/stan/math/memory/stack_alloc.hpp 9d01aac729aea8a7e8b70ffb6fffc3af *inst/include/stan/math/mix/arr.hpp 6bfb309555ebf0a925af8dad6e04293f *inst/include/stan/math/mix/mat.hpp 78c63b40147ef613cff91bf8f1d5b9b5 *inst/include/stan/math/mix/mat/fun/typedefs.hpp dcd7924488d714b81f32b909c6275916 *inst/include/stan/math/mix/mat/functor/derivative.hpp a159fde96e90408fc38c3d7e075829a9 *inst/include/stan/math/mix/mat/functor/finite_diff_grad_hessian.hpp 32ea55c8cd483c7c33c4916384ffd0e0 *inst/include/stan/math/mix/mat/functor/finite_diff_grad_hessian_auto.hpp ecaac66f8d057ca1abccedda00da3f37 *inst/include/stan/math/mix/mat/functor/grad_hessian.hpp 098db35c9242b8dd9050e7e057c3af9c *inst/include/stan/math/mix/mat/functor/grad_tr_mat_times_hessian.hpp bf5a42592306fd54c4e1fa740fd36e33 *inst/include/stan/math/mix/mat/functor/gradient_dot_vector.hpp 2c16f24f3b5df6288d3c0fb2dc017bfe *inst/include/stan/math/mix/mat/functor/hessian.hpp a126b1c8059758d04b27f46bcdbc48b1 *inst/include/stan/math/mix/mat/functor/hessian_times_vector.hpp ea73683bf7c39d78a9027c8dc69ffa0b *inst/include/stan/math/mix/mat/functor/partial_derivative.hpp d9e0914cb4cfca7938f0641c329183ef *inst/include/stan/math/mix/meta.hpp 7a28032d6c19abd13dbddd50bcdf0b67 *inst/include/stan/math/mix/scal.hpp 6d7c1169681bb2ec09ba745d1b2e321e *inst/include/stan/math/opencl/buffer_types.hpp 48e5e2af7708967da4708cbdec9ae264 *inst/include/stan/math/opencl/cholesky_decompose.hpp a87c017025837b2739c79c86a85797f1 *inst/include/stan/math/opencl/copy.hpp 4807dc1de27227fcf4b6ff263e6b68d6 *inst/include/stan/math/opencl/copy_triangular.hpp 68156d2633f813753c52c68e7028bc5a *inst/include/stan/math/opencl/diagonal_multiply.hpp b0fa5399a969202e8dd4ad6024341441 *inst/include/stan/math/opencl/err/check_diagonal_zeros.hpp 29608e0df9f1cc5ebc8ce15afdbea34e *inst/include/stan/math/opencl/err/check_invalid_matrix_view.hpp 111778d58144e0fdca56ce45027c918d *inst/include/stan/math/opencl/err/check_mat_size_one.hpp 17facc9ea9785af11e753823df9414fc *inst/include/stan/math/opencl/err/check_matching_dims.hpp 500e31a200abdeeb0b27b142381a605f *inst/include/stan/math/opencl/err/check_nan.hpp a5fcdd118a160eb643d719e8d8197e81 *inst/include/stan/math/opencl/err/check_opencl.hpp 57389ce2f59bb474d70c043fda5f558c *inst/include/stan/math/opencl/err/check_square.hpp 0016429c43cb4e8bc6da061171e6ff6d *inst/include/stan/math/opencl/err/check_symmetric.hpp d8bd11020b121bc5ff35143957d93834 *inst/include/stan/math/opencl/err/check_triangular.hpp e496daabd8798bf2a5aaf667f1896b4f *inst/include/stan/math/opencl/err/check_vector.hpp 449b764dec25f34668002f5985ce873d *inst/include/stan/math/opencl/identity.hpp f0053559d4f3e1b7fe53031b5209fce2 *inst/include/stan/math/opencl/is_matrix_cl.hpp ce38589f2ae34eb274e25fc2d3d000af *inst/include/stan/math/opencl/kernel_cl.hpp 08669e96458637323cf23863a99cfd43 *inst/include/stan/math/opencl/kernels/add.hpp f04f4d067cc3e0911032695a30a2ec25 *inst/include/stan/math/opencl/kernels/bernoulli_logit_glm_lpmf.hpp a8c70ed4967cf40c634e13e106ba9dbf *inst/include/stan/math/opencl/kernels/categorical_logit_glm_lpmf.hpp 52e3ed6d3cc40497cf90c7bca3a4a52b *inst/include/stan/math/opencl/kernels/check_diagonal_zeros.hpp 74270c327f8ecbb35c2192902da72ee2 *inst/include/stan/math/opencl/kernels/check_nan.hpp 29002f32c6af27f4150bf467ac15e419 *inst/include/stan/math/opencl/kernels/check_symmetric.hpp c15215e3e7c8532334042bc24751fd7a *inst/include/stan/math/opencl/kernels/cholesky_decompose.hpp 1c6aa789c15b10d6addc7021664e0206 *inst/include/stan/math/opencl/kernels/copy.hpp 4229402101d6802dba954065fd79c467 *inst/include/stan/math/opencl/kernels/copy_triangular.hpp 66826cf6caa425650b60e46cda610bee *inst/include/stan/math/opencl/kernels/device_functions/digamma.hpp 349edb8e371938c456f26ed21e95f7a3 *inst/include/stan/math/opencl/kernels/device_functions/log1m_exp.hpp c75f935241135e5444c27816609b0a2e *inst/include/stan/math/opencl/kernels/device_functions/log1p_exp.hpp 61d4791062c3566619f99948a86e1939 *inst/include/stan/math/opencl/kernels/diag_inv.hpp 432f74c28f29d2cfdade0652d2a9160d *inst/include/stan/math/opencl/kernels/divide_columns.hpp e0e6dac1c6fa4fe5180cd39be835014f *inst/include/stan/math/opencl/kernels/fill.hpp f367c14305954a443c492848ebd8a261 *inst/include/stan/math/opencl/kernels/gp_exp_quad_cov.hpp 51b7b0b0c3ecd976b878831b580e93b6 *inst/include/stan/math/opencl/kernels/helpers.hpp 843210bad60d75a55952528754d57317 *inst/include/stan/math/opencl/kernels/identity.hpp 9853cb7387b9807d028496f84a1e772e *inst/include/stan/math/opencl/kernels/inv_lower_tri_multiply.hpp d31170902f3f4da78e4cedb5d1ded34e *inst/include/stan/math/opencl/kernels/matrix_multiply.hpp 0bc787bb2025e0770a9762ed6b0f7738 *inst/include/stan/math/opencl/kernels/multiply_transpose.hpp 24e3126214c55fec0e7421787d2cb31b *inst/include/stan/math/opencl/kernels/neg_binomial_2_log_glm_lpmf.hpp 255990e33cd6c7dfa7af25feeea6560a *inst/include/stan/math/opencl/kernels/neg_rect_lower_tri_multiply.hpp 71108b71cecf91732d0322c051d765ca *inst/include/stan/math/opencl/kernels/normal_id_glm_lpdf.hpp c07fc8f7db1f98767cd00e1cd57429e3 *inst/include/stan/math/opencl/kernels/ordered_logistic_glm_lpmf.hpp 7a3dd255b7953dade707436a550afd24 *inst/include/stan/math/opencl/kernels/pack.hpp d61801af3619b90edd4292f5ca920442 *inst/include/stan/math/opencl/kernels/poisson_log_glm_lpmf.hpp a6dd0ed0e46ae52857f1a6108d9d0868 *inst/include/stan/math/opencl/kernels/rep_matrix.hpp 686c9e8fb6be66999573c326f62cf38a *inst/include/stan/math/opencl/kernels/scalar_mul.hpp a1c509fdf63598cf32601ec8af1956fb *inst/include/stan/math/opencl/kernels/scalar_mul_diagonal.hpp ac409406a5003c22352e5a1443063f86 *inst/include/stan/math/opencl/kernels/sub_block.hpp da1aa04400ca432f166447d5008542f0 *inst/include/stan/math/opencl/kernels/subtract.hpp ecf58bc164292d53d93120e2a8503171 *inst/include/stan/math/opencl/kernels/transpose.hpp b0eef24db2b91310512a1b2d8bc0b47e *inst/include/stan/math/opencl/kernels/triangular_transpose.hpp 2c5ad4a69671cdc5f814b1c79871e279 *inst/include/stan/math/opencl/kernels/unpack.hpp 58a89f0abcfdebe66ffed5f8e5401bc3 *inst/include/stan/math/opencl/matrix_cl.hpp d4ede379bba943bfd7280ef559d1b235 *inst/include/stan/math/opencl/matrix_cl_view.hpp 1b70170d0f2ff8442fbd633dadf53435 *inst/include/stan/math/opencl/multiply.hpp 28bcadafc65d51f4debfa1f4d0278667 *inst/include/stan/math/opencl/multiply_transpose.hpp 414c6e7f2dfde70c43e6000aeca57830 *inst/include/stan/math/opencl/opencl.hpp c415646809feb02bfcd8e63b7fcbe2e2 *inst/include/stan/math/opencl/opencl_context.hpp 8c1f5136d1b83ef0be3015cc318a3d54 *inst/include/stan/math/opencl/prim/add.hpp c2fedc73fbee3a5fe80f4ed9a30e7d6c *inst/include/stan/math/opencl/prim/bernoulli_logit_glm_lpmf.hpp bf26adc468f8bedf01b85cd6163e7d5e *inst/include/stan/math/opencl/prim/categorical_logit_glm_lpmf.hpp 82ec2651030e8f847545cad0b71c382a *inst/include/stan/math/opencl/prim/cholesky_decompose.hpp 662c26a6f442d10e47dc135a2e1da36f *inst/include/stan/math/opencl/prim/divide_columns.hpp de47eba7ba7fae331f760bbd346404cf *inst/include/stan/math/opencl/prim/gp_exp_quad_cov.hpp 42a213fe62f5fa99fa1e4dfa6bc7e204 *inst/include/stan/math/opencl/prim/mdivide_left_tri_low.hpp 83e9d5e7f73cbd02cd41199898c1e268 *inst/include/stan/math/opencl/prim/mdivide_right_tri_low.hpp 082f8303a4a5d89b3078b0028420b113 *inst/include/stan/math/opencl/prim/multiply.hpp 145c0841777eb72696a11c384f5a78a4 *inst/include/stan/math/opencl/prim/neg_binomial_2_log_glm_lpmf.hpp 119551747dfaa9c8184063288e8502ca *inst/include/stan/math/opencl/prim/normal_id_glm_lpdf.hpp 57dd801896cb8d15706dadbd400087b6 *inst/include/stan/math/opencl/prim/ordered_logistic_glm_lpmf.hpp 277dc7ce406a431bb1da46eced0ba598 *inst/include/stan/math/opencl/prim/poisson_log_glm_lpmf.hpp b13b99afee234fae046bacaebb355eab *inst/include/stan/math/opencl/prim/rep_matrix.hpp e7966344783f704915aa54ac9f4ade49 *inst/include/stan/math/opencl/prim/rep_row_vector.hpp b6e90b8becf515bf2bdf2f712b7b7f70 *inst/include/stan/math/opencl/prim/rep_vector.hpp b19cb11cd965948342273557890af5cf *inst/include/stan/math/opencl/prim/subtract.hpp 9972505737ae7a0d3449f2af84592485 *inst/include/stan/math/opencl/prim/transpose.hpp f83ac47935e94e6c227f12569a096066 *inst/include/stan/math/opencl/scalar_type.hpp da12936da4b3cc00d079228cc0b7613f *inst/include/stan/math/opencl/stringify.hpp a8374a631ea339b9e931abe0bee6a119 *inst/include/stan/math/opencl/sub_block.hpp b02e173e185c2f0b597660bcad25c83a *inst/include/stan/math/opencl/tri_inverse.hpp 113dd18c2f3d4bbc38956b67510638ec *inst/include/stan/math/opencl/triangular_transpose.hpp 629eeb3b919e2dd0fe7733ab27583e02 *inst/include/stan/math/opencl/value_type.hpp a8572e991f0965985fbe2c68a185baa8 *inst/include/stan/math/opencl/zeros.hpp 37d960977e9f9c871cf9975996633b70 *inst/include/stan/math/prim/arr.hpp 178b542bf482261f12f20363a298a82a *inst/include/stan/math/prim/arr/err/check_matching_sizes.hpp ff34afc637ec103ea2bea0fd99985711 *inst/include/stan/math/prim/arr/err/check_nonzero_size.hpp 75f66982740c16662bbbb1a80427064e *inst/include/stan/math/prim/arr/err/check_ordered.hpp 2da9e810b60d86908913ec231eac38f7 *inst/include/stan/math/prim/arr/err/is_matching_size.hpp 220f36e8542aafaa2718c39d456f21ab *inst/include/stan/math/prim/arr/err/is_nonzero_size.hpp a864eb1c0e9e097c51c9f4aafd891a3f *inst/include/stan/math/prim/arr/err/is_ordered.hpp a7bd348e824c102d9b4457120cbb02c7 *inst/include/stan/math/prim/arr/fun/array_builder.hpp e2d2168cfdb5b51341bc9969ee18b829 *inst/include/stan/math/prim/arr/fun/common_type.hpp 400c97b0d5ac5bc78f19c7490df1bc61 *inst/include/stan/math/prim/arr/fun/dot.hpp 907f3af8083bcfc8ab82828f8b6ee16c *inst/include/stan/math/prim/arr/fun/dot_self.hpp 4134292ba39a38f9b645f1f50216f8ed *inst/include/stan/math/prim/arr/fun/fill.hpp 2af513ac2e3110e0e05ea97062210221 *inst/include/stan/math/prim/arr/fun/inverse_softmax.hpp b631b0e0ac294222f37adf914ca15874 *inst/include/stan/math/prim/arr/fun/log_sum_exp.hpp 54ae68d9c99afd173534028d35815e6d *inst/include/stan/math/prim/arr/fun/promote_elements.hpp e61d4e4abde7a68337d722d6dc0ffc87 *inst/include/stan/math/prim/arr/fun/promote_scalar.hpp dffaccd858373d83d7ab6037e7528b6b *inst/include/stan/math/prim/arr/fun/promote_scalar_type.hpp 69b0ebedf9e1cf8d5fb733f8e599564a *inst/include/stan/math/prim/arr/fun/rep_array.hpp d5cfc6225cfb81dea420b2f9faeefae5 *inst/include/stan/math/prim/arr/fun/scaled_add.hpp 41a3bda717dc1686e5df406e3566f1c0 *inst/include/stan/math/prim/arr/fun/sort_asc.hpp 6e4dda0567203a65edc4b805e602f7ae *inst/include/stan/math/prim/arr/fun/sort_desc.hpp 497f8145480ef70fd5c8922d34414bcf *inst/include/stan/math/prim/arr/fun/sub.hpp 79f26170b060490888018c91f1a806a4 *inst/include/stan/math/prim/arr/fun/sum.hpp 3683c6abfb50c801627ced33a8f2e86a *inst/include/stan/math/prim/arr/fun/value_of.hpp 6e737aeab10ce72468dbe7fd04322f5b *inst/include/stan/math/prim/arr/fun/value_of_rec.hpp 24910786a8c6de36a05078871c21e1ca *inst/include/stan/math/prim/arr/fun/vec_concat.hpp c514c0127c482c8531618b62a8655ea2 *inst/include/stan/math/prim/arr/functor/coupled_ode_observer.hpp 2b24b2ae7f9f10c08d005e3edffa5ef6 *inst/include/stan/math/prim/arr/functor/coupled_ode_system.hpp 7fefa531652066ddb82a009c02ebe531 *inst/include/stan/math/prim/arr/functor/integrate_1d.hpp 22a19bb7a231d280cdd24e0c3138ee10 *inst/include/stan/math/prim/arr/functor/integrate_ode_rk45.hpp 1c2966c7ba08f4f33d1aefb24fab053d *inst/include/stan/math/prim/arr/functor/mpi_cluster.hpp e8780290b1552836154456d292b25659 *inst/include/stan/math/prim/arr/functor/mpi_cluster_inst.cpp df691ed8f0ac1c555e48d8ea51d5994d *inst/include/stan/math/prim/arr/functor/mpi_command.hpp c1b53535f8b9734c4a50057ed6e8109f *inst/include/stan/math/prim/arr/functor/mpi_distributed_apply.hpp 387ad1e01bfb36934a103d180f4322e5 *inst/include/stan/math/prim/arr/meta/VectorBuilderHelper.hpp 69b0d5522843a3d342f9c4f0cf85df07 *inst/include/stan/math/prim/arr/meta/as_scalar.hpp 78372169db6ae9e970cffd47b313e183 *inst/include/stan/math/prim/arr/meta/get.hpp 6d90196d2a8fe128c340dd81f07d2506 *inst/include/stan/math/prim/arr/meta/index_type.hpp 7b08b5d12ff04cd81366313f9b89dcf2 *inst/include/stan/math/prim/arr/meta/is_constant.hpp 78c5300b40f46b06fcba88ed19b7a531 *inst/include/stan/math/prim/arr/meta/is_vector.hpp fa49ca6b8b55a56751c2f3e3bdf5d5cc *inst/include/stan/math/prim/arr/meta/length.hpp a023a1f94dd611479db07a5ada9e1412 *inst/include/stan/math/prim/arr/meta/scalar_type.hpp 88a59cf5620c314a1c8163364157dce9 *inst/include/stan/math/prim/arr/meta/value_type.hpp 38eb60d5801228c1542cebed20d75439 *inst/include/stan/math/prim/core.hpp 91db4f811beeefb5eca64946a0e02c12 *inst/include/stan/math/prim/core/init_threadpool_tbb.hpp 78c30ca3488e20035900804b63f84376 *inst/include/stan/math/prim/mat.hpp b8500629eb74c4350365fc919142205d *inst/include/stan/math/prim/mat/eigen_plugins.h 659c59b0d2ea8fa9f26d67404c474185 *inst/include/stan/math/prim/mat/err/check_cholesky_factor.hpp 453a6f46489c79a8f72fda4f1d686629 *inst/include/stan/math/prim/mat/err/check_cholesky_factor_corr.hpp 63c7a06ea203b1ae1fefcd17aff9eeab *inst/include/stan/math/prim/mat/err/check_column_index.hpp 3d65f63cbc88867cf2e6053c60324ecd *inst/include/stan/math/prim/mat/err/check_consistent_size_mvt.hpp 47553d64b1379fc42404d35a31364031 *inst/include/stan/math/prim/mat/err/check_consistent_sizes_mvt.hpp abd2051f5e56f9017da9d184e51e2f70 *inst/include/stan/math/prim/mat/err/check_corr_matrix.hpp 8e0a0f2307a133c07d1ebbb665cb0b44 *inst/include/stan/math/prim/mat/err/check_cov_matrix.hpp 498933b4eb34bb391b3387d70c289e0f *inst/include/stan/math/prim/mat/err/check_finite.hpp bf4b412cd5ab97476fbfe9d816e2bc45 *inst/include/stan/math/prim/mat/err/check_flag_sundials.hpp 1f39457902e4300499196d2748d12f6d *inst/include/stan/math/prim/mat/err/check_ldlt_factor.hpp 1f3fb44d7fac0dbc38818c88d483f648 *inst/include/stan/math/prim/mat/err/check_lower_triangular.hpp 13b806405cb82a06f78839b1db99b776 *inst/include/stan/math/prim/mat/err/check_matching_dims.hpp 5b7a39eaa28371c3a1749b70f1af9f54 *inst/include/stan/math/prim/mat/err/check_multiplicable.hpp 9cf0fc1a0dbbc4971468b6174ce48038 *inst/include/stan/math/prim/mat/err/check_nonempty.hpp aad62a57f7e694c4a7e250be7ced991c *inst/include/stan/math/prim/mat/err/check_ordered.hpp 84d935fa9774947543f3512d6cf94082 *inst/include/stan/math/prim/mat/err/check_pos_definite.hpp 91633042537189e8b39f1f63da60a07b *inst/include/stan/math/prim/mat/err/check_pos_semidefinite.hpp 565788542e4910531c39ca526bdb41f1 *inst/include/stan/math/prim/mat/err/check_positive_ordered.hpp c3123aa68e6e149bf4c58b10e994033a *inst/include/stan/math/prim/mat/err/check_range.hpp 3b4e415c6017f8cdca5d8dc78ce590cf *inst/include/stan/math/prim/mat/err/check_row_index.hpp b029a601ad7f2fc51ae9742725c2c203 *inst/include/stan/math/prim/mat/err/check_simplex.hpp 7436f9adf0d003bf3ba9d7defb06ff94 *inst/include/stan/math/prim/mat/err/check_spsd_matrix.hpp 4aba9e9014828bc5a5f1791e9c7f7351 *inst/include/stan/math/prim/mat/err/check_square.hpp 0e39af89e829f6caeb63888d713397ce *inst/include/stan/math/prim/mat/err/check_std_vector_index.hpp 3471143336293dbf09a8f8a3cbd72866 *inst/include/stan/math/prim/mat/err/check_symmetric.hpp 76d02619f3996fda855e99a9e3425625 *inst/include/stan/math/prim/mat/err/check_unit_vector.hpp f48bbda4045db468313e3cf0bc4b8763 *inst/include/stan/math/prim/mat/err/check_vector.hpp 2d6a43657c29081e7445eed5763f4003 *inst/include/stan/math/prim/mat/err/constraint_tolerance.hpp 353ed5cd11526ceaeac2e3cc14ce7ad4 *inst/include/stan/math/prim/mat/err/is_cholesky_factor.hpp 6dd723172e0b2ced8ff9cdf8e230ac87 *inst/include/stan/math/prim/mat/err/is_cholesky_factor_corr.hpp 5c488abcf2fae38d57ced1d2b80a78ed *inst/include/stan/math/prim/mat/err/is_column_index.hpp f3ea0ea1fd1c19e2275c04af80f81743 *inst/include/stan/math/prim/mat/err/is_corr_matrix.hpp 5d52eed196ab44d15313609b0f2646d2 *inst/include/stan/math/prim/mat/err/is_ldlt_factor.hpp 4ed279d06c98a9ff21e50e7aa0b166ac *inst/include/stan/math/prim/mat/err/is_lower_triangular.hpp 6147ec1caf8fb8ee2718ccf41778fe32 *inst/include/stan/math/prim/mat/err/is_mat_finite.hpp b5343a500d3f1f9f3ab19a74a759f83d *inst/include/stan/math/prim/mat/err/is_matching_dims.hpp c9aed8edb83632c9773683478c92fe24 *inst/include/stan/math/prim/mat/err/is_pos_definite.hpp b0ab4ae308b20ec561b8b1cc2e68b41c *inst/include/stan/math/prim/mat/err/is_square.hpp 28e6e4352aa8a1a4e493eab8799f6c94 *inst/include/stan/math/prim/mat/err/is_symmetric.hpp 9edba08d4d587d58153026c23955c96c *inst/include/stan/math/prim/mat/err/is_unit_vector.hpp f05c81adf0f34b7659a67e3636a8b7ee *inst/include/stan/math/prim/mat/err/validate_non_negative_index.hpp d4d062f4532a479a980b499a01d207a1 *inst/include/stan/math/prim/mat/fun/Eigen.hpp 5269d3d48a3e1da85651f6834e42b2f5 *inst/include/stan/math/prim/mat/fun/LDLT_factor.hpp fb0d8f7c4bc55d150dc192fc0f0a22a7 *inst/include/stan/math/prim/mat/fun/MatrixExponential.h 01072497b634618940fd3518de4d276d *inst/include/stan/math/prim/mat/fun/Phi.hpp 4088efa1f28c09b4c1ab2dd10f79ad9a *inst/include/stan/math/prim/mat/fun/Phi_approx.hpp 4fd384a179f6f78f274721a7e5229497 *inst/include/stan/math/prim/mat/fun/accumulator.hpp c22b4036b84c792cf35bd7cacf490b28 *inst/include/stan/math/prim/mat/fun/acos.hpp 9ac32ff1750c2a1e1b9797174d92c783 *inst/include/stan/math/prim/mat/fun/acosh.hpp e339fbdf476be1c351acfefdfba21faa *inst/include/stan/math/prim/mat/fun/add.hpp dc85abf64b1a4e20700cf96365eb7680 *inst/include/stan/math/prim/mat/fun/add_diag.hpp c79a948af988727ff7508f7c47b5b0b8 *inst/include/stan/math/prim/mat/fun/append_array.hpp da772516f62bfa540c447e9a09a73d91 *inst/include/stan/math/prim/mat/fun/append_col.hpp 106cb973a54faaa54243b25eae1937a4 *inst/include/stan/math/prim/mat/fun/append_row.hpp cb89706712aba31c4643172c2386d210 *inst/include/stan/math/prim/mat/fun/asin.hpp 1168d0aad5b2c09b20af4dee97ca25e3 *inst/include/stan/math/prim/mat/fun/asinh.hpp 7363365212bd35909bad4e4f62265630 *inst/include/stan/math/prim/mat/fun/assign.hpp ddf8846621460a19b0089d71a0553776 *inst/include/stan/math/prim/mat/fun/atan.hpp d242820d3d1af73cdce7a6de64fe4626 *inst/include/stan/math/prim/mat/fun/atanh.hpp 099e58f8ce540c0f36a72c10a9509dc4 *inst/include/stan/math/prim/mat/fun/autocorrelation.hpp 540841cef45ac628f12a1e13d9fa27f6 *inst/include/stan/math/prim/mat/fun/autocovariance.hpp e1b6c26a047c9ec5fad532418a311628 *inst/include/stan/math/prim/mat/fun/block.hpp dcc9b223e1f615efe0f002ee1a8b7336 *inst/include/stan/math/prim/mat/fun/cbrt.hpp 240ee972a1350efbcb012267e7559ce9 *inst/include/stan/math/prim/mat/fun/ceil.hpp 7778595b1bb394237bfacc208c50cfc1 *inst/include/stan/math/prim/mat/fun/chol2inv.hpp b57c128f3deee72b024b4258f7f1d2ab *inst/include/stan/math/prim/mat/fun/cholesky_corr_constrain.hpp 355c2438f5913a93f2004cdb6a1bd5bb *inst/include/stan/math/prim/mat/fun/cholesky_corr_free.hpp 8faf005a45d2f517330b4d7144c0adc7 *inst/include/stan/math/prim/mat/fun/cholesky_decompose.hpp 32add5cf746cecef94e86ea0a8f208f1 *inst/include/stan/math/prim/mat/fun/cholesky_factor_constrain.hpp c5ba65862e60ecbbbde57123f1f1cbff *inst/include/stan/math/prim/mat/fun/cholesky_factor_free.hpp 0abb45cbc740bcbe26e920d0971c968c *inst/include/stan/math/prim/mat/fun/col.hpp d907f34fc1cd09b6b1bcdbd4c75fab6a *inst/include/stan/math/prim/mat/fun/cols.hpp e06669acacc1fa9d0ccd3a656755b714 *inst/include/stan/math/prim/mat/fun/columns_dot_product.hpp e1c2614a2cb6177129f977a62e2ec79e *inst/include/stan/math/prim/mat/fun/columns_dot_self.hpp 2278511905e36961809364c209d6b57b *inst/include/stan/math/prim/mat/fun/common_type.hpp 15e3f850c8a86d3cd15bdaea0136d20e *inst/include/stan/math/prim/mat/fun/corr_matrix_constrain.hpp 7b01b9e8c0a61ab3ece588a931ae3cec *inst/include/stan/math/prim/mat/fun/corr_matrix_free.hpp 10896968863fb8597f8809ee08dbd35c *inst/include/stan/math/prim/mat/fun/cos.hpp e1043e5f65913b63e33eea172d41d251 *inst/include/stan/math/prim/mat/fun/cosh.hpp 19ca3757484977443707d8a65466e6fb *inst/include/stan/math/prim/mat/fun/cov_exp_quad.hpp f7fae2a7ec20d6ad773388bfe929ee42 *inst/include/stan/math/prim/mat/fun/cov_matrix_constrain.hpp 32f3b1022d0fb45f2d056aba74389eea *inst/include/stan/math/prim/mat/fun/cov_matrix_constrain_lkj.hpp 200140ccd600f3da6298298ac71b2549 *inst/include/stan/math/prim/mat/fun/cov_matrix_free.hpp 55a325187148e3c6b0d0a6d246bcd568 *inst/include/stan/math/prim/mat/fun/cov_matrix_free_lkj.hpp 5c02bbe795d95ae55c4a655470aede86 *inst/include/stan/math/prim/mat/fun/crossprod.hpp aa8b6a84753cf1cf4b8cb91ad0faa247 *inst/include/stan/math/prim/mat/fun/csr_extract_u.hpp 0d873318740ea0e959a8951a1ff4d819 *inst/include/stan/math/prim/mat/fun/csr_extract_v.hpp 11020d50d3a77ba698179eedcd95ff4b *inst/include/stan/math/prim/mat/fun/csr_extract_w.hpp a5d8f69993df0d22cbe5c6c5ac118703 *inst/include/stan/math/prim/mat/fun/csr_matrix_times_vector.hpp c9215a855d7b2b170f39839fd6200edd *inst/include/stan/math/prim/mat/fun/csr_to_dense_matrix.hpp 1145b3930a20e7d9bc86193e93728d52 *inst/include/stan/math/prim/mat/fun/csr_u_to_z.hpp ed077edcb6270856b702c23b5cc551d9 *inst/include/stan/math/prim/mat/fun/cumulative_sum.hpp c59da37786cc2b3be19a86c1d1053083 *inst/include/stan/math/prim/mat/fun/determinant.hpp 400bc8017e45dc5ed1b60084d054890a *inst/include/stan/math/prim/mat/fun/diag_matrix.hpp 40d129baf91b1d1afc3a546c048964ab *inst/include/stan/math/prim/mat/fun/diag_post_multiply.hpp 60bfba5ed6156e0321ffc39e6db75df3 *inst/include/stan/math/prim/mat/fun/diag_pre_multiply.hpp 301b9503a343ab0dfbd848a4b2945b0d *inst/include/stan/math/prim/mat/fun/diagonal.hpp 5fa001dd4e90e70d0a1f38c279470ef7 *inst/include/stan/math/prim/mat/fun/digamma.hpp 278b951210734457590328ec303c2f06 *inst/include/stan/math/prim/mat/fun/dims.hpp 5e920b59d47c043aa16787468ef66625 *inst/include/stan/math/prim/mat/fun/distance.hpp ef5428ebee2edd5dd5835c1ab6d7e794 *inst/include/stan/math/prim/mat/fun/divide.hpp c911c7be9e955a9fd8256a649eaddf28 *inst/include/stan/math/prim/mat/fun/divide_columns.hpp 3cce25ff4f4f97e3eae870477961ea2c *inst/include/stan/math/prim/mat/fun/dot_product.hpp 64354d374ab3a289aed56a28866c646d *inst/include/stan/math/prim/mat/fun/dot_self.hpp 2c6e3f2532ba2b27a8f480398d44650b *inst/include/stan/math/prim/mat/fun/eigenvalues_sym.hpp b1ae2b67f9041ad5bf4a8c2f27b0c4b8 *inst/include/stan/math/prim/mat/fun/eigenvectors_sym.hpp f6d4a63cf8a591fda98f8eaa483ba327 *inst/include/stan/math/prim/mat/fun/elt_divide.hpp 2bac8fa2394d9f018ad9a3b44bb3b14b *inst/include/stan/math/prim/mat/fun/elt_multiply.hpp c78f90e6f10a32a540b54eb737b6cdfd *inst/include/stan/math/prim/mat/fun/erf.hpp 32cae6265e13abd4867c0462a98f6d19 *inst/include/stan/math/prim/mat/fun/erfc.hpp 36de0112cfc3bdf381e926220008af8d *inst/include/stan/math/prim/mat/fun/exp.hpp 05a0a04fe24850aedfe341bd35c9818b *inst/include/stan/math/prim/mat/fun/exp2.hpp a649b3310430e343d10e7c865384f13e *inst/include/stan/math/prim/mat/fun/expm1.hpp 6733666076d05e1a039b8d77f068ee4b *inst/include/stan/math/prim/mat/fun/fabs.hpp 3f91db9a4970c6ee00a625778521c323 *inst/include/stan/math/prim/mat/fun/factor_U.hpp d53d7132127696b65a750d2a27744667 *inst/include/stan/math/prim/mat/fun/factor_cov_matrix.hpp 3c99bf78ab26ead72d63db4b9cc4600f *inst/include/stan/math/prim/mat/fun/fill.hpp b20f119bb7fdd82e79cbd58c01d334c9 *inst/include/stan/math/prim/mat/fun/floor.hpp 693961b927f1f783f6a233d7e8018363 *inst/include/stan/math/prim/mat/fun/get_base1.hpp e2684a9faea5ba9fb9cad4d92c3cefbc *inst/include/stan/math/prim/mat/fun/get_base1_lhs.hpp 939109bbbbcc6702d9b446c63a0f4ef3 *inst/include/stan/math/prim/mat/fun/get_lp.hpp d9bc2aaed19664f90bb8b9ac457720aa *inst/include/stan/math/prim/mat/fun/gp_dot_prod_cov.hpp a790d5d6dd6c1e49a86c1d75d397740c *inst/include/stan/math/prim/mat/fun/gp_exp_quad_cov.hpp 1f293b75a3614314618c65f0bbdb0f37 *inst/include/stan/math/prim/mat/fun/gp_exponential_cov.hpp bc0e5a449309895c2305c96ab843d642 *inst/include/stan/math/prim/mat/fun/gp_matern32_cov.hpp bbfa70f8e67d98723796cdf330638a52 *inst/include/stan/math/prim/mat/fun/gp_matern52_cov.hpp 9f0f6a7d117192f5b938ce00cee573d9 *inst/include/stan/math/prim/mat/fun/gp_periodic_cov.hpp 5897a0f41b7ad229191af1f95390ac2f *inst/include/stan/math/prim/mat/fun/head.hpp 16d61b45048c9ad2b819ed79379cea0b *inst/include/stan/math/prim/mat/fun/initialize.hpp 239a90e9f90ac0edbdcc116dcdb8df24 *inst/include/stan/math/prim/mat/fun/inv.hpp 850e43bd30f1949c47a8a7aa530dbf9f *inst/include/stan/math/prim/mat/fun/inv_Phi.hpp dd052c6e4e349d137a2dda4bfe34db9a *inst/include/stan/math/prim/mat/fun/inv_cloglog.hpp b086d359d79eae123f30f7ea8bdaa567 *inst/include/stan/math/prim/mat/fun/inv_logit.hpp 3dcb75f7345c9273a225044bd0b5f7b1 *inst/include/stan/math/prim/mat/fun/inv_sqrt.hpp 3182e5345f78543caa845cc7ae2d893e *inst/include/stan/math/prim/mat/fun/inv_square.hpp 620f8d00f42fccf04a3580819e8c5f1b *inst/include/stan/math/prim/mat/fun/inverse.hpp e8908c20a3ba5757894b8ae29e7f7477 *inst/include/stan/math/prim/mat/fun/inverse_spd.hpp 9ddbe9423fced78a9ba029559633de49 *inst/include/stan/math/prim/mat/fun/lgamma.hpp 2a20a4d9a9bd91b731ad236a3f4abfde *inst/include/stan/math/prim/mat/fun/log.hpp 48aa1793ba4802dc84610abc21497f8b *inst/include/stan/math/prim/mat/fun/log10.hpp 83fec1fce1231e162b93dcbcb8b730b4 *inst/include/stan/math/prim/mat/fun/log1m.hpp f4d4acada93ea3ce2a058711c869d0a1 *inst/include/stan/math/prim/mat/fun/log1m_exp.hpp 02b2f8b997b9ddbae4d81f0fb17df423 *inst/include/stan/math/prim/mat/fun/log1m_inv_logit.hpp c9b2edb243bdabbda38b89217b3eb19d *inst/include/stan/math/prim/mat/fun/log1p.hpp c4ebca89b2dfca8fcad42e6df57853e8 *inst/include/stan/math/prim/mat/fun/log1p_exp.hpp 0656a574fcff011ab6da40db461f9e15 *inst/include/stan/math/prim/mat/fun/log2.hpp 6f3d20edc55e3a1007523c708515ba4a *inst/include/stan/math/prim/mat/fun/log_determinant.hpp 7f85915d98491a4f10cbad7b0395b631 *inst/include/stan/math/prim/mat/fun/log_determinant_ldlt.hpp 35d5f93ff115f88d8af49bee5d09c137 *inst/include/stan/math/prim/mat/fun/log_determinant_spd.hpp a3a4ea302f1efe65f35f0bdf874c116e *inst/include/stan/math/prim/mat/fun/log_inv_logit.hpp 71dbbd3dd359d9656b070b7c9170c650 *inst/include/stan/math/prim/mat/fun/log_mix.hpp 650f808b03f437becfda80fd66fe5805 *inst/include/stan/math/prim/mat/fun/log_softmax.hpp 25775b2e7e46592981dbc4e0827d1f6c *inst/include/stan/math/prim/mat/fun/log_sum_exp.hpp eccfb35c716b5e3bb471b19fcfb025d8 *inst/include/stan/math/prim/mat/fun/logit.hpp a0fbd388f46c7a3f7d7f9d633ee40367 *inst/include/stan/math/prim/mat/fun/make_nu.hpp 50967fdbeda99a4efe58279caad2b692 *inst/include/stan/math/prim/mat/fun/matrix_exp.hpp 838266b659b89e931c54f2ebe15685ed *inst/include/stan/math/prim/mat/fun/matrix_exp_2x2.hpp 7f1e58f5f9c22a88907f4f9112e910bf *inst/include/stan/math/prim/mat/fun/matrix_exp_action_handler.hpp 279e520cf54286084e0081a9a42b3591 *inst/include/stan/math/prim/mat/fun/matrix_exp_multiply.hpp 891f80757a266114dfcc75be56576bad *inst/include/stan/math/prim/mat/fun/matrix_exp_pade.hpp fc77766ca7fac6d13159051985469005 *inst/include/stan/math/prim/mat/fun/max.hpp 640678fc4db71336334ebc6cccbade4a *inst/include/stan/math/prim/mat/fun/mdivide_left.hpp e3768977aa9c18d8c4fa3ac052fbd754 *inst/include/stan/math/prim/mat/fun/mdivide_left_ldlt.hpp 15332a923e7ac803b6067da41901b1f1 *inst/include/stan/math/prim/mat/fun/mdivide_left_spd.hpp fbe316bfbb81f92cb9a0dc0ce320d37e *inst/include/stan/math/prim/mat/fun/mdivide_left_tri.hpp 12d8deef04dddb72b3f43b5220c5bb95 *inst/include/stan/math/prim/mat/fun/mdivide_left_tri_low.hpp 1cea87f381204b0a50fc88e522514fb7 *inst/include/stan/math/prim/mat/fun/mdivide_right.hpp 41be977d5fb69a1cfaa66e9b858714d5 *inst/include/stan/math/prim/mat/fun/mdivide_right_ldlt.hpp cd608a467cf3d96393d23ac3181c1d33 *inst/include/stan/math/prim/mat/fun/mdivide_right_spd.hpp a62ac5adf36de64e17eafe5e4cc1f2c3 *inst/include/stan/math/prim/mat/fun/mdivide_right_tri.hpp 019189bf5a1bdcd8c2c27dd8b0b73586 *inst/include/stan/math/prim/mat/fun/mdivide_right_tri_low.hpp 82584c9582dfc944e4a4c76f2dd3a6ab *inst/include/stan/math/prim/mat/fun/mean.hpp db07effbd778d8aa15ec97bbbaa675ab *inst/include/stan/math/prim/mat/fun/min.hpp a8764bfcf401800fc0e4e7ff9b779b99 *inst/include/stan/math/prim/mat/fun/minus.hpp 9d8a44c4439b7fb38134c981d0f620d4 *inst/include/stan/math/prim/mat/fun/multiply.hpp ff6fa1fc2ea18ffe90e41bc29e059dd2 *inst/include/stan/math/prim/mat/fun/multiply_lower_tri_self_transpose.hpp d7e9dbe2baaa01f2e8b8fa530f872e85 *inst/include/stan/math/prim/mat/fun/num_elements.hpp d3cf4b4b42fc262b24f7f8cee1db4640 *inst/include/stan/math/prim/mat/fun/ordered_constrain.hpp a915ad3413f88e60d177275e6235df09 *inst/include/stan/math/prim/mat/fun/ordered_free.hpp 4f9ae1ab56851f97d3777f725f6d5c1a *inst/include/stan/math/prim/mat/fun/positive_ordered_constrain.hpp b7cfae1e3092bab58752699fb1d29cf6 *inst/include/stan/math/prim/mat/fun/positive_ordered_free.hpp 352a4da0718ced64363b3d21560177c4 *inst/include/stan/math/prim/mat/fun/prod.hpp b4e2642d0d35d2c5b27db1a3bf1e1d3f *inst/include/stan/math/prim/mat/fun/promote_common.hpp 3757f84369f199ee4cdfd22644f780dc *inst/include/stan/math/prim/mat/fun/promote_elements.hpp 01b0e2ac3fdd1b5cfe9f51915c02a01a *inst/include/stan/math/prim/mat/fun/promote_scalar.hpp 3134bb43c1a8ef4217af21c01dd1aa06 *inst/include/stan/math/prim/mat/fun/promote_scalar_type.hpp c1be990a7aa8abf2a3b120c146864436 *inst/include/stan/math/prim/mat/fun/qr_Q.hpp eb7f53da6ddc4a470e1b2aaa233c634f *inst/include/stan/math/prim/mat/fun/qr_R.hpp 46a57fda3a04c61eeb4860a48870af8f *inst/include/stan/math/prim/mat/fun/qr_thin_Q.hpp a833fc580d81ae38c1b817c21e413323 *inst/include/stan/math/prim/mat/fun/qr_thin_R.hpp eae5fc33f47037e8051ed82137ef2d61 *inst/include/stan/math/prim/mat/fun/quad_form.hpp 94adbc94e7a367adf9730b3080a142c5 *inst/include/stan/math/prim/mat/fun/quad_form_diag.hpp 8c1608dcf9dfbc6536462debeb941168 *inst/include/stan/math/prim/mat/fun/quad_form_sym.hpp cec9d51f47dda4d13029c23e5df47b22 *inst/include/stan/math/prim/mat/fun/rank.hpp aabade997f511cdef484d950d77d1388 *inst/include/stan/math/prim/mat/fun/read_corr_L.hpp 818e79f0931ac19489fc193365eeb99b *inst/include/stan/math/prim/mat/fun/read_corr_matrix.hpp d9b4babbc1de52f7cfc0fe80f1c2beba *inst/include/stan/math/prim/mat/fun/read_cov_L.hpp d25e87adcf555cd64230b7aa5309f052 *inst/include/stan/math/prim/mat/fun/read_cov_matrix.hpp ae7d0ffdea8732480d8ee64081e136bf *inst/include/stan/math/prim/mat/fun/rep_matrix.hpp 84119ceb2e8b080c3798d38e0154ea83 *inst/include/stan/math/prim/mat/fun/rep_row_vector.hpp 53d855ad6a763627d1fc22d2a1cafafa *inst/include/stan/math/prim/mat/fun/rep_vector.hpp af80dfc2a1ec7edfa44e7aaf91b94f0b *inst/include/stan/math/prim/mat/fun/resize.hpp c64868859a5521dfcb872f3aa4d99b51 *inst/include/stan/math/prim/mat/fun/round.hpp aaa2f218e38c740274581a49cf1cc4a6 *inst/include/stan/math/prim/mat/fun/row.hpp e561ad68231ec477066b54958e4f5c8b *inst/include/stan/math/prim/mat/fun/rows.hpp 0985733ba8cb0e8844186c16da37465d *inst/include/stan/math/prim/mat/fun/rows_dot_product.hpp 1e710e1ac9384e32550f0cb9d98c6fba *inst/include/stan/math/prim/mat/fun/rows_dot_self.hpp 3995942bc0ae17c0dd3828aad6ebd340 *inst/include/stan/math/prim/mat/fun/scale_matrix_exp_multiply.hpp 09dad92448566ce079a4f18f8f59a6d3 *inst/include/stan/math/prim/mat/fun/sd.hpp c870d42208e457087459c750cb56f986 *inst/include/stan/math/prim/mat/fun/segment.hpp f4b6a9ec0db467f87487063496c32225 *inst/include/stan/math/prim/mat/fun/simplex_constrain.hpp 447dab2205dc3946df06797263404467 *inst/include/stan/math/prim/mat/fun/simplex_free.hpp a9dd96980937499920da32afb857c94d *inst/include/stan/math/prim/mat/fun/sin.hpp 703c1e93aef53c347cc46315a739568b *inst/include/stan/math/prim/mat/fun/singular_values.hpp 7380a105e4893a4a9a4b0c5957c25ffd *inst/include/stan/math/prim/mat/fun/sinh.hpp 7de05e891efb023224ed9a9378b51f40 *inst/include/stan/math/prim/mat/fun/size.hpp 50b0a37f47d7ebbf502845d5f09eda6e *inst/include/stan/math/prim/mat/fun/softmax.hpp 2543f5c4bcfb3cfa4d4b2b7128ad45eb *inst/include/stan/math/prim/mat/fun/sort_asc.hpp c0bf4bb5be5080844983579dc47694aa *inst/include/stan/math/prim/mat/fun/sort_desc.hpp 4f45e07c88fce5b2b2f4b6de08e69755 *inst/include/stan/math/prim/mat/fun/sort_indices.hpp 9faac68bd80078dce8e20be6ee1e87da *inst/include/stan/math/prim/mat/fun/sort_indices_asc.hpp ee8e475e53c89aca1d72d37063697462 *inst/include/stan/math/prim/mat/fun/sort_indices_desc.hpp 4a97ce02f741defdf852b49caa8c690a *inst/include/stan/math/prim/mat/fun/sqrt.hpp e8956f04e1f39cb17158a93b2d3bf460 *inst/include/stan/math/prim/mat/fun/square.hpp c9508aa4e39f5902363607659375b410 *inst/include/stan/math/prim/mat/fun/squared_distance.hpp 13974eb928c6c0822356190fb275ac07 *inst/include/stan/math/prim/mat/fun/stan_print.hpp 542f028635b368de8e49ddedda5a7325 *inst/include/stan/math/prim/mat/fun/sub_col.hpp c7735d9a460465f155ea9c55cc6a6146 *inst/include/stan/math/prim/mat/fun/sub_row.hpp 77f8b3ecb696566b660b09e66baa3657 *inst/include/stan/math/prim/mat/fun/subtract.hpp a9264381c7797356b906f300074708c5 *inst/include/stan/math/prim/mat/fun/sum.hpp e6437d168720ca4509f20fdc81bec839 *inst/include/stan/math/prim/mat/fun/tail.hpp d698ea0c425234f2f6f20458a3785ab8 *inst/include/stan/math/prim/mat/fun/tan.hpp 497b6cc415082833bbf5c1c38365ecf1 *inst/include/stan/math/prim/mat/fun/tanh.hpp b397d2dfe56093a5ebec649875226a26 *inst/include/stan/math/prim/mat/fun/tcrossprod.hpp d8dc15b11725c459357f6c7ef7ae150d *inst/include/stan/math/prim/mat/fun/tgamma.hpp 031ab59ab3cfebd575d7e3777591684e *inst/include/stan/math/prim/mat/fun/to_array_1d.hpp 0151b34d539552ce7935c0f35fd78169 *inst/include/stan/math/prim/mat/fun/to_array_2d.hpp 65ebdd5a696ef45f51dd1d157bf57b91 *inst/include/stan/math/prim/mat/fun/to_matrix.hpp cb77d664074c607eb5a6342175b2a005 *inst/include/stan/math/prim/mat/fun/to_row_vector.hpp 927ae27b2d556caae39bcf36c65f4705 *inst/include/stan/math/prim/mat/fun/to_vector.hpp ff5049c7ce7ec1cc26ec73f47b9bc79e *inst/include/stan/math/prim/mat/fun/trace.hpp 587a5b3e48e4b5860a8306214b2ecd0c *inst/include/stan/math/prim/mat/fun/trace_gen_inv_quad_form_ldlt.hpp 77ee4064f5d2b8bee55f0b6e4eadc15f *inst/include/stan/math/prim/mat/fun/trace_gen_quad_form.hpp 6fe633441a97ff4fb7bb5e5781e23448 *inst/include/stan/math/prim/mat/fun/trace_inv_quad_form_ldlt.hpp 42f37b0026c1bf61c1d79475ce336dd8 *inst/include/stan/math/prim/mat/fun/trace_quad_form.hpp 134ca0d1a5eeac36c14145bef21a48a3 *inst/include/stan/math/prim/mat/fun/transpose.hpp fe8e4961e0d050c4a6f72aacca07aef1 *inst/include/stan/math/prim/mat/fun/trigamma.hpp 7b9b17b25e2f8760a050eff7f5786f11 *inst/include/stan/math/prim/mat/fun/trunc.hpp 59fc4fac480d8aced36606f78b5be997 *inst/include/stan/math/prim/mat/fun/typedefs.hpp 2fbee103ac8ee029b1df00cc15f278fd *inst/include/stan/math/prim/mat/fun/unit_vector_constrain.hpp b2de64fe896b838ff13fcfdf5c449c88 *inst/include/stan/math/prim/mat/fun/unit_vector_free.hpp 8eca1c99f7277e6f928272f0163796cd *inst/include/stan/math/prim/mat/fun/value_of.hpp b5cc69e7b572f9d6cdefa04d3343e205 *inst/include/stan/math/prim/mat/fun/value_of_rec.hpp 7cab6b5c640798d917f603f5213bd92a *inst/include/stan/math/prim/mat/fun/variance.hpp 0b0980c61d8dd9d1d6d1a459ae942cc5 *inst/include/stan/math/prim/mat/fun/welford_covar_estimator.hpp f61ec3fb33c81d234ee47c5748c10c1d *inst/include/stan/math/prim/mat/fun/welford_var_estimator.hpp 35e372d5f1d3570682ff895abdc5d82f *inst/include/stan/math/prim/mat/functor/finite_diff_gradient.hpp 5e9288a4bdaa9b8035d6a997794bfbb0 *inst/include/stan/math/prim/mat/functor/finite_diff_gradient_auto.hpp 597c782c60c1951db705970d6822b36f *inst/include/stan/math/prim/mat/functor/finite_diff_hessian.hpp 7252fcf899c54ed5ef61a3f81023ff5a *inst/include/stan/math/prim/mat/functor/finite_diff_hessian_auto.hpp 4772dbe7ba51231b2994d5be17268324 *inst/include/stan/math/prim/mat/functor/finite_diff_hessian_helper.hpp 5cc5a10563e3ec4d18a37e72a8d94ca1 *inst/include/stan/math/prim/mat/functor/map_rect.hpp ff4db38b4e7fe1e38f9d49b5318138ec *inst/include/stan/math/prim/mat/functor/map_rect_combine.hpp c70c61b5d9d687d58ecd961cf2f70a8a *inst/include/stan/math/prim/mat/functor/map_rect_concurrent.hpp db0dc7ecbcef59759f809e07dde488c0 *inst/include/stan/math/prim/mat/functor/map_rect_mpi.hpp ccab9b77f3f0267bdd21f94dec21d40f *inst/include/stan/math/prim/mat/functor/map_rect_reduce.hpp 54115788772e4d239be091671179c431 *inst/include/stan/math/prim/mat/functor/mpi_parallel_call.hpp 736db30184a6a207d05e142f931753d5 *inst/include/stan/math/prim/mat/meta/append_return_type.hpp 7c2fc81c06404cf75a55f15e49f5ffc5 *inst/include/stan/math/prim/mat/meta/as_array_or_scalar.hpp af73aa033dac49158bb10d663dfa05a9 *inst/include/stan/math/prim/mat/meta/as_column_vector_or_scalar.hpp c2a19386bb6334126760510dfead4f6d *inst/include/stan/math/prim/mat/meta/as_scalar.hpp da25b1826339921e11039b6ab04df1d7 *inst/include/stan/math/prim/mat/meta/broadcast_array.hpp 8635890427d002476a83f32454bd0cbd *inst/include/stan/math/prim/mat/meta/get.hpp 485b9482c45ddd634d0d9aea16b82f5d *inst/include/stan/math/prim/mat/meta/index_type.hpp 1557975b0481485805e04cb151b006a6 *inst/include/stan/math/prim/mat/meta/is_constant.hpp 5dfe8bc74147463338b0274446a19ced *inst/include/stan/math/prim/mat/meta/is_eigen.hpp 02c338b4ed75504899bfe88a85e0ab4f *inst/include/stan/math/prim/mat/meta/length.hpp 14a03d389f99461d685d37fadffcaa38 *inst/include/stan/math/prim/mat/meta/length_mvt.hpp e1e88435725acf9e348340f23d3b5693 *inst/include/stan/math/prim/mat/meta/operands_and_partials.hpp 28106fdd3fdd57e30a27d29b5d377acf *inst/include/stan/math/prim/mat/meta/scalar_type.hpp 834252dd6ace68127fcf8b92213bf799 *inst/include/stan/math/prim/mat/meta/seq_view.hpp db93c7a8bce63bd0d177b887c5cd3fd6 *inst/include/stan/math/prim/mat/meta/value_type.hpp 25122816ee5631faf0fb5b3875954a98 *inst/include/stan/math/prim/mat/meta/vector_seq_view.hpp b023334f5dd2c9405f8c0ddec0383d5a *inst/include/stan/math/prim/mat/prob/bernoulli_logit_glm_log.hpp 643665080c595026e25c7b99c099f8fd *inst/include/stan/math/prim/mat/prob/bernoulli_logit_glm_lpmf.hpp b5a5bd8b80fda62407b22c953e4191df *inst/include/stan/math/prim/mat/prob/bernoulli_logit_glm_rng.hpp 4f5e03163e11459d36ccf4413cd0ec4b *inst/include/stan/math/prim/mat/prob/categorical_log.hpp 1085648bd578e6aa270cc72560bf46e2 *inst/include/stan/math/prim/mat/prob/categorical_logit_glm_lpmf.hpp 5b8a765487fc081749a7a212f5b96ace *inst/include/stan/math/prim/mat/prob/categorical_logit_log.hpp 1c5803f0249f585ad348e149e2827503 *inst/include/stan/math/prim/mat/prob/categorical_logit_lpmf.hpp 20acf7b26c8ca363d40d026a84fb4a5a *inst/include/stan/math/prim/mat/prob/categorical_logit_rng.hpp 60b01ea8baa86c7494220949ace1c7df *inst/include/stan/math/prim/mat/prob/categorical_lpmf.hpp 9eb79867edb782f069d1808cbf55912e *inst/include/stan/math/prim/mat/prob/categorical_rng.hpp 3b0d3405c800355a9be163a38637ee08 *inst/include/stan/math/prim/mat/prob/dirichlet_log.hpp 8950b0387ac1d071db57630e9b5bdde9 *inst/include/stan/math/prim/mat/prob/dirichlet_lpmf.hpp 14738fe4d1bd07c17d442f75c5b4a8df *inst/include/stan/math/prim/mat/prob/dirichlet_rng.hpp 11a430ea61881a41b250b4aca4581929 *inst/include/stan/math/prim/mat/prob/gaussian_dlm_obs_log.hpp 0ec7c19fc487a772ee7d4be443ff001f *inst/include/stan/math/prim/mat/prob/gaussian_dlm_obs_lpdf.hpp f040997aafdda2a2c995eb6ccd26b49a *inst/include/stan/math/prim/mat/prob/gaussian_dlm_obs_rng.hpp ffda5071e7c4e4bcc0582e93aaec8125 *inst/include/stan/math/prim/mat/prob/inv_wishart_log.hpp 270e1563ecb4cf49e21a20242e6a41c7 *inst/include/stan/math/prim/mat/prob/inv_wishart_lpdf.hpp 95ebe4ab4c0011ef304625096b86c3d7 *inst/include/stan/math/prim/mat/prob/inv_wishart_rng.hpp 730a238755654b37a57d4ef10a5fc184 *inst/include/stan/math/prim/mat/prob/lkj_corr_cholesky_log.hpp 8ad5c688b7b4068cf1db2b2339f2915b *inst/include/stan/math/prim/mat/prob/lkj_corr_cholesky_lpdf.hpp ff474f42ffdacf0e497198ff794ca0e1 *inst/include/stan/math/prim/mat/prob/lkj_corr_cholesky_rng.hpp 524e879329c7c5718f7fe87b1e2e4962 *inst/include/stan/math/prim/mat/prob/lkj_corr_log.hpp 3b7119f829b1d34f18ae295a4e6cd367 *inst/include/stan/math/prim/mat/prob/lkj_corr_lpdf.hpp 7d27f57e9d3bba7e9881fc2f25eaafb7 *inst/include/stan/math/prim/mat/prob/lkj_corr_rng.hpp 08eef7fda6d92733a5382d0fab51b4e7 *inst/include/stan/math/prim/mat/prob/lkj_cov_log.hpp 433fe8129cdc727f1ba02ac379f2f31d *inst/include/stan/math/prim/mat/prob/lkj_cov_lpdf.hpp 8af0782702bf0d06dd2263e7b61ade18 *inst/include/stan/math/prim/mat/prob/matrix_normal_prec_log.hpp 1da2674f3f11dee22c1be3d82b916f88 *inst/include/stan/math/prim/mat/prob/matrix_normal_prec_lpdf.hpp 8484c2cbd73c08af24632ed6983d1546 *inst/include/stan/math/prim/mat/prob/matrix_normal_prec_rng.hpp 94769d4378f09a10fb0d4bb2ef7b7eb7 *inst/include/stan/math/prim/mat/prob/multi_gp_cholesky_log.hpp e9d986c12bb8887b07bc6b83a8ec13db *inst/include/stan/math/prim/mat/prob/multi_gp_cholesky_lpdf.hpp 6f6c9ca992bce84797b51165faa17e09 *inst/include/stan/math/prim/mat/prob/multi_gp_log.hpp ae8ccf4ffafd64f82ff601565dd5c294 *inst/include/stan/math/prim/mat/prob/multi_gp_lpdf.hpp b5cd7635e2a0899bec5fae2015a5f2df *inst/include/stan/math/prim/mat/prob/multi_normal_cholesky_log.hpp 6041d2bac5b556e1622e1b5205dcfde9 *inst/include/stan/math/prim/mat/prob/multi_normal_cholesky_lpdf.hpp 34f659f43b0d36c844f17a7974d0d8da *inst/include/stan/math/prim/mat/prob/multi_normal_cholesky_rng.hpp 6749d3ce77b3d77a7d7c275cb12df3c8 *inst/include/stan/math/prim/mat/prob/multi_normal_log.hpp 0ad5567bb11b446d2f33e36ca77d115e *inst/include/stan/math/prim/mat/prob/multi_normal_lpdf.hpp 9649028261032eaf58e89a4911370267 *inst/include/stan/math/prim/mat/prob/multi_normal_prec_log.hpp fbee99d9a46ed89a913947c148d603c0 *inst/include/stan/math/prim/mat/prob/multi_normal_prec_lpdf.hpp 57b18164f44018c2a423c0f335efc5a2 *inst/include/stan/math/prim/mat/prob/multi_normal_prec_rng.hpp c226eef93844cf298622a90c6a507375 *inst/include/stan/math/prim/mat/prob/multi_normal_rng.hpp 40c62157fc512a3381094b108ccfa33c *inst/include/stan/math/prim/mat/prob/multi_student_t_log.hpp 1cde624ef6657627a84cfaae330e9ffb *inst/include/stan/math/prim/mat/prob/multi_student_t_lpdf.hpp 22f7fe053c312bc6acb10b6fe8098fad *inst/include/stan/math/prim/mat/prob/multi_student_t_rng.hpp 0c0486003c0c4ee59ad503b482f04fd8 *inst/include/stan/math/prim/mat/prob/multinomial_log.hpp 5a31334c594a233bc7e76fddfe2f84b4 *inst/include/stan/math/prim/mat/prob/multinomial_lpmf.hpp 8804a08e0d525ffd3c68d59e4fc97ad2 *inst/include/stan/math/prim/mat/prob/multinomial_rng.hpp 667f49f419bdbd84a9a1960de93874a0 *inst/include/stan/math/prim/mat/prob/neg_binomial_2_log_glm_log.hpp 26be0eb1f3a2a2b70cacdbf4706292ec *inst/include/stan/math/prim/mat/prob/neg_binomial_2_log_glm_lpmf.hpp 222664b59d7990e2a017fa2c7b9acdc9 *inst/include/stan/math/prim/mat/prob/normal_id_glm_log.hpp 7c7594832fb8c288a72405e996bb476d *inst/include/stan/math/prim/mat/prob/normal_id_glm_lpdf.hpp 95ce1a591b133607f2e2cc93b5595c13 *inst/include/stan/math/prim/mat/prob/ordered_logistic_glm_lpmf.hpp c9a48401c7c476b0b1790a69886713b1 *inst/include/stan/math/prim/mat/prob/ordered_logistic_log.hpp 42c449994edb1e5462582df2e94732f1 *inst/include/stan/math/prim/mat/prob/ordered_logistic_lpmf.hpp d3a930e902c3456f7c71b892b91ba31e *inst/include/stan/math/prim/mat/prob/ordered_logistic_rng.hpp b06133949f7d9adb0a712337365cfb4f *inst/include/stan/math/prim/mat/prob/ordered_probit_log.hpp 5858caaee782bce66b7bedd4dc951051 *inst/include/stan/math/prim/mat/prob/ordered_probit_lpmf.hpp 32de6f7c7792f9a618ab65523bfed8fc *inst/include/stan/math/prim/mat/prob/ordered_probit_rng.hpp 2e0949338db05f62894958bec93c5526 *inst/include/stan/math/prim/mat/prob/poisson_log_glm_log.hpp 7abb8bcece8deeb967da3099fb7de1dc *inst/include/stan/math/prim/mat/prob/poisson_log_glm_lpmf.hpp ff343959be74bc84d97ce2c3261bd082 *inst/include/stan/math/prim/mat/prob/wishart_log.hpp efbe33e5b4b0239bcce46961c26da265 *inst/include/stan/math/prim/mat/prob/wishart_lpdf.hpp ad671a59201a8d5305d8d60561bd00aa *inst/include/stan/math/prim/mat/prob/wishart_rng.hpp 701406d7f52794a28fe698224fb9fb1d *inst/include/stan/math/prim/mat/vectorize/apply_scalar_unary.hpp c76d3b54aa703a73e9c30579e066c3fa *inst/include/stan/math/prim/meta.hpp afbfbeb6d88e987b88b84dc7fe359cb4 *inst/include/stan/math/prim/scal.hpp ec209c675126378d0dc6799b9e55bb77 *inst/include/stan/math/prim/scal/err/check_2F1_converges.hpp 61a03e944ee62109d7fb241c2b8dcac1 *inst/include/stan/math/prim/scal/err/check_3F2_converges.hpp 623e9f918c0ebbf84e47efee6cdd4cb6 *inst/include/stan/math/prim/scal/err/check_bounded.hpp c128a61f4551934ef5f6f818e12039e5 *inst/include/stan/math/prim/scal/err/check_consistent_size.hpp 784af4aed8d11f771c51718d031558ca *inst/include/stan/math/prim/scal/err/check_consistent_sizes.hpp d4abafa4798851e5d13c1dec0dbf2bb5 *inst/include/stan/math/prim/scal/err/check_finite.hpp 0d01b4c64778c1385428875f43154d53 *inst/include/stan/math/prim/scal/err/check_greater.hpp 2ae63704ea20a9167b4f52c3da90646e *inst/include/stan/math/prim/scal/err/check_greater_or_equal.hpp 362b47dce98a6388090c4b178d1d6f3c *inst/include/stan/math/prim/scal/err/check_less.hpp 18932469fcbf0e9d0e80f4346349014a *inst/include/stan/math/prim/scal/err/check_less_or_equal.hpp 963104ef72d2ee4c53b5e4e59c9523d8 *inst/include/stan/math/prim/scal/err/check_nonnegative.hpp e77e761d84071a92b21cc50c403de7f0 *inst/include/stan/math/prim/scal/err/check_not_nan.hpp 81a1d9b8d8bb2d837c815a89103ca443 *inst/include/stan/math/prim/scal/err/check_positive.hpp d1f9f040fdb8ac15291d195cc675ae42 *inst/include/stan/math/prim/scal/err/check_positive_finite.hpp 03ce30add49602a29e25c4507d179e2f *inst/include/stan/math/prim/scal/err/check_size_match.hpp 7a0bae64368d04d9c869b3e901cb722a *inst/include/stan/math/prim/scal/err/domain_error.hpp 67ad2e8e90aa83ceefd908317cc836bd *inst/include/stan/math/prim/scal/err/domain_error_vec.hpp 576a81a369d1317d982fe32a6d6e237d *inst/include/stan/math/prim/scal/err/invalid_argument.hpp 2a32413f060cdd7a46a77908bee526e1 *inst/include/stan/math/prim/scal/err/invalid_argument_vec.hpp 1a9790ced90449183d68df4bd461e41a *inst/include/stan/math/prim/scal/err/is_less_or_equal.hpp f03d348adf7c77f7f5257701fee217a1 *inst/include/stan/math/prim/scal/err/is_not_nan.hpp e3c1cc39a8df25168c7f71c2d5c32b8a *inst/include/stan/math/prim/scal/err/is_positive.hpp 7119af6df788bf84cd1ac6bfa62809cf *inst/include/stan/math/prim/scal/err/is_scal_finite.hpp f291c9c7afd25febc339b02b888c4e14 *inst/include/stan/math/prim/scal/err/is_size_match.hpp 48767d48e66e9ed242129e14282d2241 *inst/include/stan/math/prim/scal/err/out_of_range.hpp dfe82388263de16ee6b5bd72fea16837 *inst/include/stan/math/prim/scal/err/system_error.hpp 48381b7b5fb5f8d3636fdec86b10e753 *inst/include/stan/math/prim/scal/fun/F32.hpp dd3b6333b27fca12da5e906abf4264c6 *inst/include/stan/math/prim/scal/fun/Phi.hpp 3a50d5a04ff8c0f31def1f24ba3b5229 *inst/include/stan/math/prim/scal/fun/Phi_approx.hpp c34b964684506f54e5be7b1d9e19a020 *inst/include/stan/math/prim/scal/fun/abs.hpp d6469eb527893f9edf33108474574c12 *inst/include/stan/math/prim/scal/fun/acosh.hpp a13ddcf6b2b34e7d75b1e5c49e6cf256 *inst/include/stan/math/prim/scal/fun/as_bool.hpp e8f0559d5ca05e5d58e6a6241ae86956 *inst/include/stan/math/prim/scal/fun/asinh.hpp d1e21e943b8238d3798b4de470a1fd8c *inst/include/stan/math/prim/scal/fun/atanh.hpp 74beb46df8da62c7a08f58c3e765c4ad *inst/include/stan/math/prim/scal/fun/bessel_first_kind.hpp c4789081e7b6a8edf12c723ca7e1798f *inst/include/stan/math/prim/scal/fun/bessel_second_kind.hpp a16dce9bcf7ff8cedc49d362b279d767 *inst/include/stan/math/prim/scal/fun/beta.hpp 87279e0e13ef816306e4fdee5658f4e5 *inst/include/stan/math/prim/scal/fun/binary_log_loss.hpp 72291dd1d68bb4d4d167906463578de2 *inst/include/stan/math/prim/scal/fun/binomial_coefficient_log.hpp 562deba0887b1c52847ffe79224f920e *inst/include/stan/math/prim/scal/fun/boost_policy.hpp ac9e8dd8a1194fc95495dd8273a44a48 *inst/include/stan/math/prim/scal/fun/cbrt.hpp 6217f32f84a3cfebb5bc6bbb388e0574 *inst/include/stan/math/prim/scal/fun/choose.hpp 3d4b32093fc5086dcf51119cddb3ff95 *inst/include/stan/math/prim/scal/fun/common_type.hpp dfacf2d176cce8f272a1a1c8a049d417 *inst/include/stan/math/prim/scal/fun/constants.hpp ee5e3347b1851055269a1ba1dd6840e2 *inst/include/stan/math/prim/scal/fun/corr_constrain.hpp 5930c5da7c6ad6fa0eb34fd9d0ab7cf1 *inst/include/stan/math/prim/scal/fun/corr_free.hpp 63db7f315a7ad1e725c280fbd051e74c *inst/include/stan/math/prim/scal/fun/digamma.hpp 360038eaa5a8b026207e1c869c5cba0f *inst/include/stan/math/prim/scal/fun/distance.hpp 913a100c1d30cb933c17e17f583c54ba *inst/include/stan/math/prim/scal/fun/divide.hpp 583d75ef1364b2aca0f3a75096ed4892 *inst/include/stan/math/prim/scal/fun/erf.hpp 86051ac062c4e70d40b184911594facf *inst/include/stan/math/prim/scal/fun/erfc.hpp 346b4aeaf6286703ddca99f6b63ee3b4 *inst/include/stan/math/prim/scal/fun/exp.hpp 5346e4537e83490068461e425acc8dd6 *inst/include/stan/math/prim/scal/fun/exp2.hpp 55591d7e2a8b166f583d711facd13c61 *inst/include/stan/math/prim/scal/fun/expm1.hpp 19acdb6d47e7c3927d9a094b6febd203 *inst/include/stan/math/prim/scal/fun/falling_factorial.hpp 697a868700a4eba16d79991e6447a952 *inst/include/stan/math/prim/scal/fun/fdim.hpp 21c79dda2f7de7dae5df163dfa78d02d *inst/include/stan/math/prim/scal/fun/fill.hpp 70c7ccf1b7ee527aa43d5be4cee7dcff *inst/include/stan/math/prim/scal/fun/finite_diff_stepsize.hpp 56a8a4e7363779fde77befa56a348c78 *inst/include/stan/math/prim/scal/fun/fma.hpp 3a49dd5298891b235a26ce1d707d82d9 *inst/include/stan/math/prim/scal/fun/fmax.hpp 1bc80dd5088d4176ef48b3c1d0dda01f *inst/include/stan/math/prim/scal/fun/fmin.hpp 00f9f990114cca1cbfbbbd10832a7c63 *inst/include/stan/math/prim/scal/fun/gamma_p.hpp 0aeb47c32283b67c2b2213ab05e241a7 *inst/include/stan/math/prim/scal/fun/gamma_q.hpp 6a0fa5664f243b2275d388ad964dd042 *inst/include/stan/math/prim/scal/fun/grad_2F1.hpp 0f6f4fccc02b29aae0e4efb428d7f4d0 *inst/include/stan/math/prim/scal/fun/grad_F32.hpp 19a1fb085b48402e36970dac5c46c417 *inst/include/stan/math/prim/scal/fun/grad_inc_beta.hpp 2aa8d9d6626a8d4325a59f05a8539b17 *inst/include/stan/math/prim/scal/fun/grad_reg_inc_beta.hpp 568479f33351a3a28dbdc38256eb33c2 *inst/include/stan/math/prim/scal/fun/grad_reg_inc_gamma.hpp 39195a92c36252e4ef86bac04ab94056 *inst/include/stan/math/prim/scal/fun/grad_reg_lower_inc_gamma.hpp 157bd953335f61186224e87731ddcb1f *inst/include/stan/math/prim/scal/fun/hypot.hpp 2804a17db26f9b56b000762910055ff8 *inst/include/stan/math/prim/scal/fun/ibeta.hpp 081f585dbd6bd441336066a4647e7cc7 *inst/include/stan/math/prim/scal/fun/identity_constrain.hpp 93e1729c0c6b9d39dd79fdf4eed062c0 *inst/include/stan/math/prim/scal/fun/identity_free.hpp 9e03d33a86e2bd5e2cafbb9f6a3497c8 *inst/include/stan/math/prim/scal/fun/if_else.hpp 3f70307fa6c7df11f3dd9056ab03a868 *inst/include/stan/math/prim/scal/fun/inc_beta.hpp 16f31f8fc5e74917ef867773fe055dcf *inst/include/stan/math/prim/scal/fun/inc_beta_dda.hpp aa4dc84609f1a7ad712bac2bf87939f1 *inst/include/stan/math/prim/scal/fun/inc_beta_ddb.hpp 546e447bd361e3cc36f569aca1c3643d *inst/include/stan/math/prim/scal/fun/inc_beta_ddz.hpp 10925fd655b8980cdc9c85f699f83f84 *inst/include/stan/math/prim/scal/fun/int_step.hpp eedd14544e995e7c77d4611e706c70b8 *inst/include/stan/math/prim/scal/fun/inv.hpp 567a189f9a7684316a396d5fb456fe24 *inst/include/stan/math/prim/scal/fun/inv_Phi.hpp 2e67db164a5fa3c16424ff5f282836b8 *inst/include/stan/math/prim/scal/fun/inv_cloglog.hpp 23196a53bbd2eeff599ad58b8c6a5294 *inst/include/stan/math/prim/scal/fun/inv_logit.hpp 43c686c142f219b108ffce7fa3951b70 *inst/include/stan/math/prim/scal/fun/inv_sqrt.hpp e01ee6e6757869161ec274448f323e6b *inst/include/stan/math/prim/scal/fun/inv_square.hpp 023c4d5aad307710a30c243ea79701ca *inst/include/stan/math/prim/scal/fun/is_any_nan.hpp 89c93eae4f905eb77e614bd882f12acd *inst/include/stan/math/prim/scal/fun/is_inf.hpp 0a0e181dc1170e018ec82380a86bc31d *inst/include/stan/math/prim/scal/fun/is_integer.hpp 4b845a3f548f782b749914e0df060b66 *inst/include/stan/math/prim/scal/fun/is_nan.hpp 17c47e2d3a300ba21623c466fec670fb *inst/include/stan/math/prim/scal/fun/is_nonpositive_integer.hpp 31756813029bec5f3cc42100dc9c2ac4 *inst/include/stan/math/prim/scal/fun/is_uninitialized.hpp c178fc02c28b8b5284245e28eca14528 *inst/include/stan/math/prim/scal/fun/lb_constrain.hpp 1fd4a780846b1e942321b0b8c8728f66 *inst/include/stan/math/prim/scal/fun/lb_free.hpp db882f102168f54d404f311d2e39bd02 *inst/include/stan/math/prim/scal/fun/lbeta.hpp 77ccbc86aa944fa6bc31d2943e77feac *inst/include/stan/math/prim/scal/fun/ldexp.hpp c6206656e66842774a2dd98bb4bcece2 *inst/include/stan/math/prim/scal/fun/lgamma.hpp abc74311fbaee289af8d715228dbe088 *inst/include/stan/math/prim/scal/fun/lmgamma.hpp 1544b809dc1293ea505607b9f76d0d05 *inst/include/stan/math/prim/scal/fun/locscale_constrain.hpp a2fc96961055badfe44b0fbcc6154f7e *inst/include/stan/math/prim/scal/fun/locscale_free.hpp 6ee236c34104fbbd488bc7adc5e36339 *inst/include/stan/math/prim/scal/fun/log.hpp 118b5a2eec4bcb1dbf8369b1df3015fd *inst/include/stan/math/prim/scal/fun/log1m.hpp 448cfff7c97b6301acefecd67967aa52 *inst/include/stan/math/prim/scal/fun/log1m_exp.hpp bc3638f60a2dc5fb7aad58cc211bba5b *inst/include/stan/math/prim/scal/fun/log1m_inv_logit.hpp 6248c7112c0a3fb944f3d47522a63af7 *inst/include/stan/math/prim/scal/fun/log1p.hpp 2deebc1c5e212762db51a4d0d58948f5 *inst/include/stan/math/prim/scal/fun/log1p_exp.hpp c764ccfc93a70ef6e51732c69888cd51 *inst/include/stan/math/prim/scal/fun/log2.hpp 754ab4d27e856e5b5241c2da75cda165 *inst/include/stan/math/prim/scal/fun/log_diff_exp.hpp 3add1b796573ec6522d6d12163c0c72c *inst/include/stan/math/prim/scal/fun/log_falling_factorial.hpp 977acb97b3911a1db3dfb43bcff96c6b *inst/include/stan/math/prim/scal/fun/log_inv_logit.hpp 03afb3daebb9aede448303191afdf054 *inst/include/stan/math/prim/scal/fun/log_inv_logit_diff.hpp cdb7afff0d831cfa8ae138a1763852cf *inst/include/stan/math/prim/scal/fun/log_mix.hpp a0e52a723a81ba850218ac1a758df842 *inst/include/stan/math/prim/scal/fun/log_modified_bessel_first_kind.hpp b02ffb23b7fc07bd4836014466391320 *inst/include/stan/math/prim/scal/fun/log_rising_factorial.hpp 5bb06f4d9f7a915752fbbefd620b6e26 *inst/include/stan/math/prim/scal/fun/log_sum_exp.hpp 5d207fdb10679503bd3b956843d4551a *inst/include/stan/math/prim/scal/fun/logical_and.hpp 152bfbc01c3a30dc22ac1ac8a151013d *inst/include/stan/math/prim/scal/fun/logical_eq.hpp acd4926a3b4e7a49257302b4c418a0b0 *inst/include/stan/math/prim/scal/fun/logical_gt.hpp 594d73f3cebb66f816fdaff32f391300 *inst/include/stan/math/prim/scal/fun/logical_gte.hpp 6df7e5fbf4d12a4231df4b0dc590f79d *inst/include/stan/math/prim/scal/fun/logical_lt.hpp 06268b4e41ff4b0edc53380173bfbf6f *inst/include/stan/math/prim/scal/fun/logical_lte.hpp 1ee02624cc146a96c0ad2b7278265ce3 *inst/include/stan/math/prim/scal/fun/logical_negation.hpp 470c869edf85dd517d83b82ab9566e9b *inst/include/stan/math/prim/scal/fun/logical_neq.hpp 2190badd7a8378c046acd0fe1dca963f *inst/include/stan/math/prim/scal/fun/logical_or.hpp 64ec3a832d64ab6dee0d51dc0e39ab04 *inst/include/stan/math/prim/scal/fun/logit.hpp 95e6aebe3dd9c50f4904015ef713ea3f *inst/include/stan/math/prim/scal/fun/lub_constrain.hpp 0acd841363842c3571f394ea313c4432 *inst/include/stan/math/prim/scal/fun/lub_free.hpp 0e824cbf4ebf3e848b4354d3c8d4149a *inst/include/stan/math/prim/scal/fun/modified_bessel_first_kind.hpp 755caef992106e8878343b44672032ab *inst/include/stan/math/prim/scal/fun/modified_bessel_second_kind.hpp d587931c9f5a0d81efecca2be6da13d2 *inst/include/stan/math/prim/scal/fun/modulus.hpp 376a9cede4ec2f4ea8bd450c8961734a *inst/include/stan/math/prim/scal/fun/multiply_log.hpp 2cfdc500eea4646a655521f7af112367 *inst/include/stan/math/prim/scal/fun/offset_multiplier_constrain.hpp da9f250ec3e381e956eb6c34dbc7033b *inst/include/stan/math/prim/scal/fun/offset_multiplier_free.hpp e744aca266b94c27b814f172098d65dc *inst/include/stan/math/prim/scal/fun/owens_t.hpp daab6b77935dab1b4189169998eeb89e *inst/include/stan/math/prim/scal/fun/positive_constrain.hpp 3bd8d461d6e42f5e40451bdbec1bef4e *inst/include/stan/math/prim/scal/fun/positive_free.hpp 86cc05d90350ee8c27cad2adf196fcd6 *inst/include/stan/math/prim/scal/fun/primitive_value.hpp 5c8d7a75e3419e5d43ca2da2b76c7676 *inst/include/stan/math/prim/scal/fun/prob_constrain.hpp 02495477addf9b9e59154afeb7818a28 *inst/include/stan/math/prim/scal/fun/prob_free.hpp be2cdf599a0ec806c5b95c1b4e56e749 *inst/include/stan/math/prim/scal/fun/promote_elements.hpp 8636c3e09b69855af3d6b5d7dc0eeba6 *inst/include/stan/math/prim/scal/fun/promote_scalar.hpp d73b229ead5e8b24911e51b2415bceba *inst/include/stan/math/prim/scal/fun/promote_scalar_type.hpp 24ad7a0984efe58d7a5687c364bc4687 *inst/include/stan/math/prim/scal/fun/rising_factorial.hpp 0c9d5d75c60748e95be0bb2777f0986b *inst/include/stan/math/prim/scal/fun/round.hpp edfbe5a9f977d5bbf1849f3d8d9b59b9 *inst/include/stan/math/prim/scal/fun/sign.hpp aa9a2a69fd81455e569725e7d8b43ddb *inst/include/stan/math/prim/scal/fun/size_zero.hpp 4ecd3d042567adb2a7c19e669c13a7df *inst/include/stan/math/prim/scal/fun/sqrt.hpp 3685088028365242df8431db7cd77db2 *inst/include/stan/math/prim/scal/fun/square.hpp 3859c7629669629c24abaff0f1efc92e *inst/include/stan/math/prim/scal/fun/squared_distance.hpp 3d285d1e2d095c78222bea20b8f520aa *inst/include/stan/math/prim/scal/fun/step.hpp 609ee211cae6fb0925e896492c56687d *inst/include/stan/math/prim/scal/fun/sum.hpp 998aa845962cf388cd0633be7cdf2c4a *inst/include/stan/math/prim/scal/fun/tgamma.hpp 6a8a0fa60668c04a8969ee20eb8454f6 *inst/include/stan/math/prim/scal/fun/trigamma.hpp 1216ff5ffab1d7c29342c0b2c99d5f87 *inst/include/stan/math/prim/scal/fun/trunc.hpp 0f4efb23d5ba5c7646e9979d60898f55 *inst/include/stan/math/prim/scal/fun/ub_constrain.hpp c0be9f712884ebeb3f21e35ae37b1fb2 *inst/include/stan/math/prim/scal/fun/ub_free.hpp 8ac88d050f838f9307ed08fd0d0e2451 *inst/include/stan/math/prim/scal/fun/value_of.hpp 49ad29a7061ceaccd25d358e05ea7cf2 *inst/include/stan/math/prim/scal/fun/value_of_rec.hpp 7c7e08d6274b61149d2f09e5cc9a9af8 *inst/include/stan/math/prim/scal/meta/StdVectorBuilder.hpp 16f310956dcf06c5da9c5e63e955d85f *inst/include/stan/math/prim/scal/meta/VectorBuilder.hpp eba610474dbcc4d8cb1b405e4316e7e4 *inst/include/stan/math/prim/scal/meta/VectorBuilderHelper.hpp 8fe0e6f532cb137509745f60b9dffcd2 *inst/include/stan/math/prim/scal/meta/ad_promotable.hpp 4a46805590c1892466a40f68f22baa5a *inst/include/stan/math/prim/scal/meta/as_array_or_scalar.hpp 08fa4f269f7f47235e80f973ad3b8c26 *inst/include/stan/math/prim/scal/meta/as_column_vector_or_scalar.hpp d0d0547408cac3cd0806e72656c94c87 *inst/include/stan/math/prim/scal/meta/as_scalar.hpp 629836a5652a965fe63c36819090dd99 *inst/include/stan/math/prim/scal/meta/bool_constant.hpp cf6772aef2db94666b5fa003a373bfaa *inst/include/stan/math/prim/scal/meta/broadcast_array.hpp a7cb9d486017c6002df8be5fb2199c66 *inst/include/stan/math/prim/scal/meta/child_type.hpp 3aef7f3a7aa7fbb946893c0a3d6925a6 *inst/include/stan/math/prim/scal/meta/conjunction.hpp 10200b29b157480e5cab6758d1b7ebd6 *inst/include/stan/math/prim/scal/meta/contains_fvar.hpp 68e9c3bf144066df4ed48ffa29e5b67d *inst/include/stan/math/prim/scal/meta/contains_std_vector.hpp 29698b8b9aba1d5952dac63b559a0c5c *inst/include/stan/math/prim/scal/meta/contains_vector.hpp c089cb0b0e57bcc367f3ab6935d4c78e *inst/include/stan/math/prim/scal/meta/disjunction.hpp f895b4764a20664f27f8aa8b2c800802 *inst/include/stan/math/prim/scal/meta/error_index.hpp 5db22c8866b9a02f04b87ea17a368bcb *inst/include/stan/math/prim/scal/meta/get.hpp 1976b75820c40f1e5d3b73e6393fe211 *inst/include/stan/math/prim/scal/meta/include_summand.hpp c7582bc716bc9228890b2ddec176ccd1 *inst/include/stan/math/prim/scal/meta/index_type.hpp cccd7056eaedb023a4163288ed008817 *inst/include/stan/math/prim/scal/meta/is_constant.hpp 5469fd01a1a8b54b3c5195426ac97724 *inst/include/stan/math/prim/scal/meta/is_eigen.hpp 81c8f2520a921dae041268e7856ca113 *inst/include/stan/math/prim/scal/meta/is_fvar.hpp beb2a347db747d8e4e32009a3c16ec47 *inst/include/stan/math/prim/scal/meta/is_var.hpp 09f94655ccc211d698bcba5e94efdd50 *inst/include/stan/math/prim/scal/meta/is_var_or_arithmetic.hpp b86fb2fb7bc06fa0564f44a98c84372c *inst/include/stan/math/prim/scal/meta/is_vector.hpp c1b523c5beba4371e4521c9999af9bc4 *inst/include/stan/math/prim/scal/meta/is_vector_like.hpp e20bc4fe69d2511bea7bd746dddaf1ce *inst/include/stan/math/prim/scal/meta/length.hpp d30ece1216a4cf149e25f1f5090bc196 *inst/include/stan/math/prim/scal/meta/length_mvt.hpp 65beffcf7afd4dfd3a4e8ac9c4bc88ff *inst/include/stan/math/prim/scal/meta/likely.hpp dae661b7ef67307f2040a07c0db38253 *inst/include/stan/math/prim/scal/meta/max_size.hpp 7bc912bd687a8ee9d8ede079317145a4 *inst/include/stan/math/prim/scal/meta/max_size_mvt.hpp 23790759748bbdb659dc92c08ed86f54 *inst/include/stan/math/prim/scal/meta/operands_and_partials.hpp 2d389bb7c1272ccaf884000980d497dc *inst/include/stan/math/prim/scal/meta/partials_return_type.hpp d97dd126947ff6e29a5f73aa4f3a1482 *inst/include/stan/math/prim/scal/meta/partials_type.hpp 7e019be625bdd7d7d78da9d3abfbbbf9 *inst/include/stan/math/prim/scal/meta/promote_args.hpp a053691c700ad5fc52d2beb954b0cc1a *inst/include/stan/math/prim/scal/meta/require_generics.hpp e1d29ac11550598ca8731722b9bfedd9 *inst/include/stan/math/prim/scal/meta/return_type.hpp 41499b6681fe75c3970a9fd445f4516d *inst/include/stan/math/prim/scal/meta/scalar_seq_view.hpp 8f13fe1d8f20950fcdbc13dfc3c788cd *inst/include/stan/math/prim/scal/meta/scalar_type.hpp 740fad2cae805897df8abe20dae35a94 *inst/include/stan/math/prim/scal/meta/scalar_type_pre.hpp e9eaeac1768e65805758883815035a3f *inst/include/stan/math/prim/scal/meta/size_of.hpp ed4940230c611a1fd6657b29e03269f3 *inst/include/stan/math/prim/scal/meta/value_type.hpp db6d3abc089247d8d17b8339a1097a3b *inst/include/stan/math/prim/scal/prob/bernoulli_ccdf_log.hpp aa5afcf90d4327b7ee003d934bd3207b *inst/include/stan/math/prim/scal/prob/bernoulli_cdf.hpp 6406a19b0377f74851a3d20018df850e *inst/include/stan/math/prim/scal/prob/bernoulli_cdf_log.hpp 3ed46177c1b7f97384be11a2dc27e9ba *inst/include/stan/math/prim/scal/prob/bernoulli_lccdf.hpp d2bcdce945bbfec5d4a0e3c0221a8dcc *inst/include/stan/math/prim/scal/prob/bernoulli_lcdf.hpp afd344f88a3da8dc0c1b49abf8b076f5 *inst/include/stan/math/prim/scal/prob/bernoulli_log.hpp f2913f8c37cacb068f0818789de5b863 *inst/include/stan/math/prim/scal/prob/bernoulli_logit_log.hpp 1dcaab7b8bb790b8b1f24144bb49aa8f *inst/include/stan/math/prim/scal/prob/bernoulli_logit_lpmf.hpp 97af7bc90e7690fcd3e589dcc282b6a8 *inst/include/stan/math/prim/scal/prob/bernoulli_logit_rng.hpp 2edb51dd58ca1e7d0bdd6c604008584a *inst/include/stan/math/prim/scal/prob/bernoulli_lpmf.hpp bacb3020c9219539506204e04fd7e81b *inst/include/stan/math/prim/scal/prob/bernoulli_rng.hpp 4df04779b9c79a702e424a570b0c7cb1 *inst/include/stan/math/prim/scal/prob/beta_binomial_ccdf_log.hpp 7030084b2aefa8376de7d6691e8279a8 *inst/include/stan/math/prim/scal/prob/beta_binomial_cdf.hpp c9abf1ab2c7a3bb5fbecff1f48f0c6b6 *inst/include/stan/math/prim/scal/prob/beta_binomial_cdf_log.hpp 60af8f9671cf216a3c39cb6ac130e347 *inst/include/stan/math/prim/scal/prob/beta_binomial_lccdf.hpp 4c0954f25a45ed0990820d7b6c1d1469 *inst/include/stan/math/prim/scal/prob/beta_binomial_lcdf.hpp 79119321f659f1de5ba9ab2e98a30b83 *inst/include/stan/math/prim/scal/prob/beta_binomial_log.hpp 326c02baf20311e7be3972019d81f281 *inst/include/stan/math/prim/scal/prob/beta_binomial_lpmf.hpp 634411cfaac2983f88cd71d0ff9fd69e *inst/include/stan/math/prim/scal/prob/beta_binomial_rng.hpp 2c427b8bfcb4393f035d69be6c39aa5d *inst/include/stan/math/prim/scal/prob/beta_ccdf_log.hpp 5bedd1683d8d79c14988e36625e1f93b *inst/include/stan/math/prim/scal/prob/beta_cdf.hpp f2692d0bf7aea1705f858e55195242df *inst/include/stan/math/prim/scal/prob/beta_cdf_log.hpp 03112876f1edcd085670a216a897de67 *inst/include/stan/math/prim/scal/prob/beta_lccdf.hpp 055c2e599953a1310c163b7454b2a0be *inst/include/stan/math/prim/scal/prob/beta_lcdf.hpp 1071acc07416c52a4ec20e4fb752159b *inst/include/stan/math/prim/scal/prob/beta_log.hpp edf84f34e387d01ad2752e308353f4df *inst/include/stan/math/prim/scal/prob/beta_lpdf.hpp ee2b5c603ff5dfa75429b94e12636add *inst/include/stan/math/prim/scal/prob/beta_proportion_ccdf_log.hpp 36608e7ec2c4b51d96052500f7d59dae *inst/include/stan/math/prim/scal/prob/beta_proportion_cdf_log.hpp 1e4a3b2fbfe37eeed0dfdc3a5619de50 *inst/include/stan/math/prim/scal/prob/beta_proportion_lccdf.hpp 34e78bb3a893585f85951f7b95dc9de9 *inst/include/stan/math/prim/scal/prob/beta_proportion_lcdf.hpp 02b33da80d15fb0fccc07a891036a65c *inst/include/stan/math/prim/scal/prob/beta_proportion_log.hpp 3e71fb83b4e8aef8f05221205bb3174b *inst/include/stan/math/prim/scal/prob/beta_proportion_lpdf.hpp 4e5e0c16643dc69443bc900a1c75ca0b *inst/include/stan/math/prim/scal/prob/beta_proportion_rng.hpp 162e447ad11ae45b66e4de026031308f *inst/include/stan/math/prim/scal/prob/beta_rng.hpp 2e1568292572e17ac68b4905fcbf2e1a *inst/include/stan/math/prim/scal/prob/binomial_ccdf_log.hpp 44b87591a6180b887852602173562402 *inst/include/stan/math/prim/scal/prob/binomial_cdf.hpp ce29bf0b0ab5cfedfcc18a81cd11585d *inst/include/stan/math/prim/scal/prob/binomial_cdf_log.hpp 9999f9f3f8c3dc44ae030b9b48b29d08 *inst/include/stan/math/prim/scal/prob/binomial_lccdf.hpp a97587006a44daf87c9849cac06d16ab *inst/include/stan/math/prim/scal/prob/binomial_lcdf.hpp 0ffcc9863458c33ff8db9deabd48221a *inst/include/stan/math/prim/scal/prob/binomial_log.hpp 48c0403a7fa5e5b6c9ce6ce1d9d6d33c *inst/include/stan/math/prim/scal/prob/binomial_logit_log.hpp 4ae5ea58da4602d938e35d95ec546845 *inst/include/stan/math/prim/scal/prob/binomial_logit_lpmf.hpp 51c251884951d4440d6ef80aabff4efb *inst/include/stan/math/prim/scal/prob/binomial_lpmf.hpp e103ccf9cc287c8865ba33b1234e5b7f *inst/include/stan/math/prim/scal/prob/binomial_rng.hpp 1c506cd8290de12c300a322fff627db0 *inst/include/stan/math/prim/scal/prob/cauchy_ccdf_log.hpp ef87f474d205e0385d4a70b5de05e96d *inst/include/stan/math/prim/scal/prob/cauchy_cdf.hpp ae30eb228be19bc239a7a60ec5d62995 *inst/include/stan/math/prim/scal/prob/cauchy_cdf_log.hpp 9e8aa989dad18d2bb61cf7dd469ba3c5 *inst/include/stan/math/prim/scal/prob/cauchy_lccdf.hpp a733c276ca137ee01c000a9c682e91e9 *inst/include/stan/math/prim/scal/prob/cauchy_lcdf.hpp 8f349636be999a7b3a6a08393c74a2c8 *inst/include/stan/math/prim/scal/prob/cauchy_log.hpp ddf2179d49d25a97ae26f955a2c51f38 *inst/include/stan/math/prim/scal/prob/cauchy_lpdf.hpp 28d5669c14d7d20534077b292423eec9 *inst/include/stan/math/prim/scal/prob/cauchy_rng.hpp c54966ea1d5102bde42e967b10e04ddf *inst/include/stan/math/prim/scal/prob/chi_square_ccdf_log.hpp 1a79dd6262c9ccc6a82a9b46e890282e *inst/include/stan/math/prim/scal/prob/chi_square_cdf.hpp c7c9230358c00b1d65f190c97467cd4a *inst/include/stan/math/prim/scal/prob/chi_square_cdf_log.hpp b542b07a48661828c6c5d52aed67d9cc *inst/include/stan/math/prim/scal/prob/chi_square_lccdf.hpp 8be64b94b9ae1f2e685440a6fd381e22 *inst/include/stan/math/prim/scal/prob/chi_square_lcdf.hpp 3bf456d3c0eb1c6f7bebb118ba2d27f9 *inst/include/stan/math/prim/scal/prob/chi_square_log.hpp 2c5a8cb6b6ae441067159832c4e6e50c *inst/include/stan/math/prim/scal/prob/chi_square_lpdf.hpp dbd5d088f69640cee363018a0ab9657a *inst/include/stan/math/prim/scal/prob/chi_square_rng.hpp f5fdb0fbe06fdc895d7d34608d276450 *inst/include/stan/math/prim/scal/prob/double_exponential_ccdf_log.hpp 109028626e07c416453164b3eb90c663 *inst/include/stan/math/prim/scal/prob/double_exponential_cdf.hpp 9e3b3639af9bed8da5ba09343a75f9d5 *inst/include/stan/math/prim/scal/prob/double_exponential_cdf_log.hpp a39268ec547340031a9652680217afb7 *inst/include/stan/math/prim/scal/prob/double_exponential_lccdf.hpp d0fb0a75460c7dda14b12eb0e5cf8d3f *inst/include/stan/math/prim/scal/prob/double_exponential_lcdf.hpp b3b4bdb3d13d0a23956bc82258be4a20 *inst/include/stan/math/prim/scal/prob/double_exponential_log.hpp 81370b5971a984e0e31140ac278dc354 *inst/include/stan/math/prim/scal/prob/double_exponential_lpdf.hpp 89adec3c48098c82d1d25b51bdf5a32e *inst/include/stan/math/prim/scal/prob/double_exponential_rng.hpp a49215f4c8730500c176e8fde1b73ad3 *inst/include/stan/math/prim/scal/prob/exp_mod_normal_ccdf_log.hpp a274a830208f310aa5dfc0a7487a05dc *inst/include/stan/math/prim/scal/prob/exp_mod_normal_cdf.hpp 21c53d552086d675f8d6ccb04825eae8 *inst/include/stan/math/prim/scal/prob/exp_mod_normal_cdf_log.hpp 88fe7811730c626d5b80311b7e7e6f96 *inst/include/stan/math/prim/scal/prob/exp_mod_normal_lccdf.hpp ff8f38406d4d52b16677df58d049a524 *inst/include/stan/math/prim/scal/prob/exp_mod_normal_lcdf.hpp 83b44b83c6e6c2bd0b965e1657d8466f *inst/include/stan/math/prim/scal/prob/exp_mod_normal_log.hpp 926932185cad59ef7090a2825dbb47d1 *inst/include/stan/math/prim/scal/prob/exp_mod_normal_lpdf.hpp daf978c8342a521197bf343474bf56eb *inst/include/stan/math/prim/scal/prob/exp_mod_normal_rng.hpp 7f4bff2a5d3e859742304d587c349ef9 *inst/include/stan/math/prim/scal/prob/exponential_ccdf_log.hpp 9986b2c9542ed158f9503a4cefbb338b *inst/include/stan/math/prim/scal/prob/exponential_cdf.hpp 3c2709629c01ed6b936b9307fb2eef94 *inst/include/stan/math/prim/scal/prob/exponential_cdf_log.hpp ba993e3ebe728da4524792d67ea9818d *inst/include/stan/math/prim/scal/prob/exponential_lccdf.hpp 69d67137e262d9cb03c087519df97bf2 *inst/include/stan/math/prim/scal/prob/exponential_lcdf.hpp 22aac88d82b53b0cd843c9029a60f54a *inst/include/stan/math/prim/scal/prob/exponential_log.hpp 3f5cbb35b6cb63d9210ea9bd1363005e *inst/include/stan/math/prim/scal/prob/exponential_lpdf.hpp b1913c16bdf927e55b4abe3b83a8f0b6 *inst/include/stan/math/prim/scal/prob/exponential_rng.hpp db5a21718034c9ba50b5b8c02ada4c00 *inst/include/stan/math/prim/scal/prob/frechet_ccdf_log.hpp 43d259bcf16da934a58b1717e78ec5fd *inst/include/stan/math/prim/scal/prob/frechet_cdf.hpp 343a2f66819779acc88647296e77b33d *inst/include/stan/math/prim/scal/prob/frechet_cdf_log.hpp eed72b027b63b43ad5f3f03b040d315f *inst/include/stan/math/prim/scal/prob/frechet_lccdf.hpp ca4c4acb9ca4f648d42269bbd98a0895 *inst/include/stan/math/prim/scal/prob/frechet_lcdf.hpp e2579ec9aeeb099ce7873222cd3f71ad *inst/include/stan/math/prim/scal/prob/frechet_log.hpp b75548ab681e47f1f66065ee7e2cbe03 *inst/include/stan/math/prim/scal/prob/frechet_lpdf.hpp 3b7fa926f4ce332866b4683f38e7a923 *inst/include/stan/math/prim/scal/prob/frechet_rng.hpp 484bacba2d0a1209d491a42da01c6c7c *inst/include/stan/math/prim/scal/prob/gamma_ccdf_log.hpp 77e97db1825e6adfa9917d74a0e714e6 *inst/include/stan/math/prim/scal/prob/gamma_cdf.hpp 6fb35f74bbaa17dff34fff151508e7de *inst/include/stan/math/prim/scal/prob/gamma_cdf_log.hpp 564dd143353487bb9298eca1fce6cae6 *inst/include/stan/math/prim/scal/prob/gamma_lccdf.hpp 932af81ee3389b26e52fbce6f1faf7e6 *inst/include/stan/math/prim/scal/prob/gamma_lcdf.hpp ad74ac59c9f08e99c12b4a37a3cc8336 *inst/include/stan/math/prim/scal/prob/gamma_log.hpp 83d0ab39b220164a72789584dd8d4e2d *inst/include/stan/math/prim/scal/prob/gamma_lpdf.hpp cc75eb631d50f3e1dd17dc5ff35bcf5e *inst/include/stan/math/prim/scal/prob/gamma_rng.hpp 0cd83967f7798239e10b8207b461bab5 *inst/include/stan/math/prim/scal/prob/gumbel_ccdf_log.hpp 15e0581b61853dbb374991bb071d31d8 *inst/include/stan/math/prim/scal/prob/gumbel_cdf.hpp 14e72635a70af253af37327f7268fd9d *inst/include/stan/math/prim/scal/prob/gumbel_cdf_log.hpp e4e9d5af469c1b157e9b1f667a08c77d *inst/include/stan/math/prim/scal/prob/gumbel_lccdf.hpp 278bd1e9dbdbe9c4f0931d8b8c96f0e0 *inst/include/stan/math/prim/scal/prob/gumbel_lcdf.hpp f0603388c3a18eda23b4d73f5b9ffb58 *inst/include/stan/math/prim/scal/prob/gumbel_log.hpp d34e5257605d29897d2cb2147e378778 *inst/include/stan/math/prim/scal/prob/gumbel_lpdf.hpp 55b6a05cb97770e850dc0ee333101c56 *inst/include/stan/math/prim/scal/prob/gumbel_rng.hpp 3a5676129a7fd43a9d7c2f2f188fa5b3 *inst/include/stan/math/prim/scal/prob/hypergeometric_log.hpp 7f8a14f315295e9e124631ec8dcdc7ca *inst/include/stan/math/prim/scal/prob/hypergeometric_lpmf.hpp 8cdabb06c3907799bb17be0cf72ea1db *inst/include/stan/math/prim/scal/prob/hypergeometric_rng.hpp c6b9ff31926c2aad566aace736051ab4 *inst/include/stan/math/prim/scal/prob/inv_chi_square_ccdf_log.hpp 6252ba0c755b1aa7d5a43c18a174290a *inst/include/stan/math/prim/scal/prob/inv_chi_square_cdf.hpp eebd894576b437b33771e33fdf2ac2e2 *inst/include/stan/math/prim/scal/prob/inv_chi_square_cdf_log.hpp fde2dc50bfef5c2fe976bb18014356cc *inst/include/stan/math/prim/scal/prob/inv_chi_square_lccdf.hpp 1993b0b11d947af4925d65c02dd36f93 *inst/include/stan/math/prim/scal/prob/inv_chi_square_lcdf.hpp aed5e2072a1120a0ebdb5a0fe7ee2c24 *inst/include/stan/math/prim/scal/prob/inv_chi_square_log.hpp ca4e74cb2e8a46f43701fb2824d74aa1 *inst/include/stan/math/prim/scal/prob/inv_chi_square_lpdf.hpp 5b96578e83c9e12be94fbd0a494ac342 *inst/include/stan/math/prim/scal/prob/inv_chi_square_rng.hpp f8c2a5d84d6e24c3fa800594356edf5e *inst/include/stan/math/prim/scal/prob/inv_gamma_ccdf_log.hpp fb325d30b87e61ee1aea43d31603fecd *inst/include/stan/math/prim/scal/prob/inv_gamma_cdf.hpp 9ca0a2195673a27647c2e5c6fa178515 *inst/include/stan/math/prim/scal/prob/inv_gamma_cdf_log.hpp 77c90760a681e45625c2cad86b963c95 *inst/include/stan/math/prim/scal/prob/inv_gamma_lccdf.hpp b22b2eb6ee9dfdae8e5931c3cf1d8327 *inst/include/stan/math/prim/scal/prob/inv_gamma_lcdf.hpp dc00a1a54efa563f49681db1663b95d8 *inst/include/stan/math/prim/scal/prob/inv_gamma_log.hpp 6160208dd60cc6f0846c193cfb567cf6 *inst/include/stan/math/prim/scal/prob/inv_gamma_lpdf.hpp 89e680a1801895ccbeb753a7adfdc119 *inst/include/stan/math/prim/scal/prob/inv_gamma_rng.hpp e9305e25825f920baf15de8d2762267e *inst/include/stan/math/prim/scal/prob/logistic_ccdf_log.hpp 8c861f4718948902b95ea98762b63f16 *inst/include/stan/math/prim/scal/prob/logistic_cdf.hpp 45dfb7cc6813f5e7a7c4785b0fa28966 *inst/include/stan/math/prim/scal/prob/logistic_cdf_log.hpp d724e9417a6a1e131a97443832167319 *inst/include/stan/math/prim/scal/prob/logistic_lccdf.hpp 3a58e92cb72aebbee9a79b0851261eac *inst/include/stan/math/prim/scal/prob/logistic_lcdf.hpp bd689c12ff3ed89470063f89f861c11b *inst/include/stan/math/prim/scal/prob/logistic_log.hpp f17606e63928d6bde7d4324f9a3926a0 *inst/include/stan/math/prim/scal/prob/logistic_lpdf.hpp 3b7b746fad697b5d25f13159f3f2fbd8 *inst/include/stan/math/prim/scal/prob/logistic_rng.hpp 2661634493a26dc6cfea1b73b1299747 *inst/include/stan/math/prim/scal/prob/lognormal_ccdf_log.hpp 75a3482282777e0f4d20e9645738eb9d *inst/include/stan/math/prim/scal/prob/lognormal_cdf.hpp bfe7e5e78d9f1b8da2f02cb55c6e0788 *inst/include/stan/math/prim/scal/prob/lognormal_cdf_log.hpp a5f5c0db562d4375c070dda816641c75 *inst/include/stan/math/prim/scal/prob/lognormal_lccdf.hpp 3cd20c2f0db5320207364f646a898301 *inst/include/stan/math/prim/scal/prob/lognormal_lcdf.hpp 978ce59913c5e0ba08c5a081272a00ec *inst/include/stan/math/prim/scal/prob/lognormal_log.hpp 2c9e512499265a761dde46c64c6beb04 *inst/include/stan/math/prim/scal/prob/lognormal_lpdf.hpp 8c7f6c1bea349570a8fd90d0523131d7 *inst/include/stan/math/prim/scal/prob/lognormal_rng.hpp e985a0f7db6d6c703879d7d4ff31b91d *inst/include/stan/math/prim/scal/prob/neg_binomial_2_ccdf_log.hpp aaaa02d6330e1c70dbac4d282cf9baeb *inst/include/stan/math/prim/scal/prob/neg_binomial_2_cdf.hpp c7b26ca50c400909ff90863bd211c095 *inst/include/stan/math/prim/scal/prob/neg_binomial_2_cdf_log.hpp 0c11ee9afbe6865c897c6d68d1da173f *inst/include/stan/math/prim/scal/prob/neg_binomial_2_lccdf.hpp 261e98ae0c161577393801be7b008551 *inst/include/stan/math/prim/scal/prob/neg_binomial_2_lcdf.hpp 13622f8466f7af0f01beece4abf5e3ec *inst/include/stan/math/prim/scal/prob/neg_binomial_2_log.hpp 0be75c13685eb8842835406542b9dfa0 *inst/include/stan/math/prim/scal/prob/neg_binomial_2_log_log.hpp 2c64d7082d4e5aa7f27d7cb8469b4328 *inst/include/stan/math/prim/scal/prob/neg_binomial_2_log_lpmf.hpp b7294d5439b41915ed8694c047efd49b *inst/include/stan/math/prim/scal/prob/neg_binomial_2_log_rng.hpp 234152a6ef02b2eb964fcc2fb6dadc6a *inst/include/stan/math/prim/scal/prob/neg_binomial_2_lpmf.hpp 64f6dcb0c7b6b3d1cc39d482723d7be3 *inst/include/stan/math/prim/scal/prob/neg_binomial_2_rng.hpp 983ec6a17eb6b1b43a8eec035634d6f6 *inst/include/stan/math/prim/scal/prob/neg_binomial_ccdf_log.hpp c9801042abaad1c5d8bc69ad55ab5330 *inst/include/stan/math/prim/scal/prob/neg_binomial_cdf.hpp 67b85f0821ada0241396da545a4a831e *inst/include/stan/math/prim/scal/prob/neg_binomial_cdf_log.hpp 6f884b3717a28f90a02c5a9187009032 *inst/include/stan/math/prim/scal/prob/neg_binomial_lccdf.hpp 4d4efa4e3a704654f3d6eb5e567f23c6 *inst/include/stan/math/prim/scal/prob/neg_binomial_lcdf.hpp 89b8c27f889ce0b57bc2123930239e84 *inst/include/stan/math/prim/scal/prob/neg_binomial_log.hpp 1da9e0e490341a6423bae14d9bbcbcdc *inst/include/stan/math/prim/scal/prob/neg_binomial_lpmf.hpp 0eb5ee5c3807a079491bd1460e3c7f03 *inst/include/stan/math/prim/scal/prob/neg_binomial_rng.hpp 779d4df4e555036e1ff28fa562e8303f *inst/include/stan/math/prim/scal/prob/normal_ccdf_log.hpp 572b2e6ba5201654c48113e4ca4fa543 *inst/include/stan/math/prim/scal/prob/normal_cdf.hpp 9288abd47b5ec0c3f288efe4417659a9 *inst/include/stan/math/prim/scal/prob/normal_cdf_log.hpp 35089e7d620a7420e0b45ecc4c5c7b92 *inst/include/stan/math/prim/scal/prob/normal_lccdf.hpp 5fe295e83a82b9eaa62122c62424e46e *inst/include/stan/math/prim/scal/prob/normal_lcdf.hpp a0aca5b8a7c9d30171f55990fdfb856c *inst/include/stan/math/prim/scal/prob/normal_log.hpp 72ada3920e24e6e794a8813bf399c067 *inst/include/stan/math/prim/scal/prob/normal_lpdf.hpp f489dceea8d35c2839c3b99c6f9e8d12 *inst/include/stan/math/prim/scal/prob/normal_rng.hpp 12a82c4401fe02b095d8f1204bd2768d *inst/include/stan/math/prim/scal/prob/normal_sufficient_log.hpp 70dc819a91850b8405502385eeb44c95 *inst/include/stan/math/prim/scal/prob/normal_sufficient_lpdf.hpp 06dabe6e71ae6cebb7f725476ad91397 *inst/include/stan/math/prim/scal/prob/pareto_ccdf_log.hpp 882f5c91237a376bc589453fe6739806 *inst/include/stan/math/prim/scal/prob/pareto_cdf.hpp 543c13fc7b4e7725365452c732733e18 *inst/include/stan/math/prim/scal/prob/pareto_cdf_log.hpp a9391ec88d27ccfa880db5c02217c0d9 *inst/include/stan/math/prim/scal/prob/pareto_lccdf.hpp 3757009f4a2f143e24d9560c373d57af *inst/include/stan/math/prim/scal/prob/pareto_lcdf.hpp dbe2d8a5556c46787515eec3420e2f6e *inst/include/stan/math/prim/scal/prob/pareto_log.hpp b6ba8a51d9a12f640b1157b5433b96ac *inst/include/stan/math/prim/scal/prob/pareto_lpdf.hpp 5bdfdeefc84dba065bbfe12c9bfceb19 *inst/include/stan/math/prim/scal/prob/pareto_rng.hpp b01daac6dbcd93c35e923ce3a93ab16b *inst/include/stan/math/prim/scal/prob/pareto_type_2_ccdf_log.hpp 121087d836b16051631a709493fb4ecd *inst/include/stan/math/prim/scal/prob/pareto_type_2_cdf.hpp 3c002e462907d3657dcf6f6136855127 *inst/include/stan/math/prim/scal/prob/pareto_type_2_cdf_log.hpp accbb3a85ad8c88361257daf87ced457 *inst/include/stan/math/prim/scal/prob/pareto_type_2_lccdf.hpp f7691bc4b3b27f869399ff156b7df1c7 *inst/include/stan/math/prim/scal/prob/pareto_type_2_lcdf.hpp 9d19df56a6632abe87311822c80f4f39 *inst/include/stan/math/prim/scal/prob/pareto_type_2_log.hpp e966686e5643e19f838914e10a9bbafd *inst/include/stan/math/prim/scal/prob/pareto_type_2_lpdf.hpp b00ab0253262b8dda7d43b19506cdc60 *inst/include/stan/math/prim/scal/prob/pareto_type_2_rng.hpp ddb50509a0b81d64827bb9c0ceefa616 *inst/include/stan/math/prim/scal/prob/poisson_ccdf_log.hpp 86c3d390cea063ea9507177ab730e47d *inst/include/stan/math/prim/scal/prob/poisson_cdf.hpp 4e70654b1eb6b250cd2914d297adaa7d *inst/include/stan/math/prim/scal/prob/poisson_cdf_log.hpp b5f85cea7760e3e70d8a83f1aaf7deb4 *inst/include/stan/math/prim/scal/prob/poisson_lccdf.hpp fc7760c57e33a855b2e5745c90fa8868 *inst/include/stan/math/prim/scal/prob/poisson_lcdf.hpp 4f84929825519b521c19aba242d936af *inst/include/stan/math/prim/scal/prob/poisson_log.hpp 28ba101859545c94d0c73dc597cfb86a *inst/include/stan/math/prim/scal/prob/poisson_log_log.hpp f696890c9e0eb63434762643031c631d *inst/include/stan/math/prim/scal/prob/poisson_log_lpmf.hpp cae67c88dc590f0f45f29b293f2ca0df *inst/include/stan/math/prim/scal/prob/poisson_log_rng.hpp 9b97074d4ab188b083bfd9f841dc210d *inst/include/stan/math/prim/scal/prob/poisson_lpmf.hpp b82615cae6fad7de1028912e9329ac39 *inst/include/stan/math/prim/scal/prob/poisson_rng.hpp 5e5a7458e5213108804bcdba33958ad5 *inst/include/stan/math/prim/scal/prob/rayleigh_ccdf_log.hpp b6cf51a5909457969b0fdfc392808181 *inst/include/stan/math/prim/scal/prob/rayleigh_cdf.hpp 59913d2ef741d441f9920d6eb3e4a04d *inst/include/stan/math/prim/scal/prob/rayleigh_cdf_log.hpp 5063347fa913ab632abdad6024cebb43 *inst/include/stan/math/prim/scal/prob/rayleigh_lccdf.hpp 78ff9f171f4b8707722e9f0f631bfc73 *inst/include/stan/math/prim/scal/prob/rayleigh_lcdf.hpp 728e6be656c3337356dfac0fafdf4c6d *inst/include/stan/math/prim/scal/prob/rayleigh_log.hpp 2f0de9adc71b0c428363d7583a9cdb5a *inst/include/stan/math/prim/scal/prob/rayleigh_lpdf.hpp 30036041d7155580564a468119256539 *inst/include/stan/math/prim/scal/prob/rayleigh_rng.hpp 7ef9bb4f2e91b65ded9e5c20b22c1a2d *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_ccdf_log.hpp 415d6eaa6f1a478c23094e2243b57f58 *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_cdf.hpp 9abe864b2f457a844795586a069b053a *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_cdf_log.hpp 1bee6932b231064e5b1daef66af7374b *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_lccdf.hpp f1f8f80941e8b0bce8af4cda333201e7 *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_lcdf.hpp 0a2ad50d3828790c5e5bed9e3141a591 *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_log.hpp 3012f21b7b2e48fea24c18d42e5078e6 *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_lpdf.hpp 21459dfdcbe2a1407989a888fe1c48c9 *inst/include/stan/math/prim/scal/prob/scaled_inv_chi_square_rng.hpp 378ac426c541426c542eefcc06149c05 *inst/include/stan/math/prim/scal/prob/skew_normal_ccdf_log.hpp e6f5060fae6202197269e1943337ecd0 *inst/include/stan/math/prim/scal/prob/skew_normal_cdf.hpp 7c7cfc2a5166aeb36bd211d3f0df64cc *inst/include/stan/math/prim/scal/prob/skew_normal_cdf_log.hpp 4131363c8302e1e60d90780d4d02270b *inst/include/stan/math/prim/scal/prob/skew_normal_lccdf.hpp 4025610229e1ef7359875b81488c885f *inst/include/stan/math/prim/scal/prob/skew_normal_lcdf.hpp 48d978882e6d04474e17c015a415d4dd *inst/include/stan/math/prim/scal/prob/skew_normal_log.hpp e59ba31b8b64a59e94356794d536e7c8 *inst/include/stan/math/prim/scal/prob/skew_normal_lpdf.hpp b46354cfc64d49c8fd08157b3e0d1196 *inst/include/stan/math/prim/scal/prob/skew_normal_rng.hpp 2a4ab1c5e416258dd543a19c308af1a0 *inst/include/stan/math/prim/scal/prob/std_normal_log.hpp c5fc467b7c57ce375b8ca7e509b1e601 *inst/include/stan/math/prim/scal/prob/std_normal_lpdf.hpp 5207b2e8546e6dae78edccbab9a2736e *inst/include/stan/math/prim/scal/prob/student_t_ccdf_log.hpp 3ed1ba02a7f8bace927330c6fc420492 *inst/include/stan/math/prim/scal/prob/student_t_cdf.hpp fb3af52a9f74105b407b1d6d1eafb6ce *inst/include/stan/math/prim/scal/prob/student_t_cdf_log.hpp 3ed2078408966742b176044e1236e998 *inst/include/stan/math/prim/scal/prob/student_t_lccdf.hpp 797dd95ce0fa950c0216f0478d0904f7 *inst/include/stan/math/prim/scal/prob/student_t_lcdf.hpp 8e8208e242da67194594e1971d9c9731 *inst/include/stan/math/prim/scal/prob/student_t_log.hpp 8cbc1b3415d134e8ef53e281bd020cc5 *inst/include/stan/math/prim/scal/prob/student_t_lpdf.hpp 2a00b61fb322b65757cd8d084106e0a5 *inst/include/stan/math/prim/scal/prob/student_t_rng.hpp 8b937d110a6208c54badde872bebf206 *inst/include/stan/math/prim/scal/prob/uniform_ccdf_log.hpp b3fc340f4f2509c98456d54eb77109a8 *inst/include/stan/math/prim/scal/prob/uniform_cdf.hpp 0c5583f85fed5c96183dc8265e7dff97 *inst/include/stan/math/prim/scal/prob/uniform_cdf_log.hpp 51a88226bf77431a3b7df749aa766bee *inst/include/stan/math/prim/scal/prob/uniform_lccdf.hpp ad2f29db93f7ef9dbd2b2abd6cd56955 *inst/include/stan/math/prim/scal/prob/uniform_lcdf.hpp 080b6daf1c72021308bdcb4f0b772241 *inst/include/stan/math/prim/scal/prob/uniform_log.hpp 5eb21ba24930be9321adce6843120b87 *inst/include/stan/math/prim/scal/prob/uniform_lpdf.hpp 51daac7c520a1a5901bf6eeb1ea7b184 *inst/include/stan/math/prim/scal/prob/uniform_rng.hpp 5f58bb91a6216c5e4ed7c9a5c4604307 *inst/include/stan/math/prim/scal/prob/von_mises_log.hpp 90cf06174d24378341e2d5b415ac4f25 *inst/include/stan/math/prim/scal/prob/von_mises_lpdf.hpp dfed6874a40d7f53a59f4b73b3176343 *inst/include/stan/math/prim/scal/prob/von_mises_rng.hpp 26ecdd614cb2ca773dbee2a4d2898e2b *inst/include/stan/math/prim/scal/prob/weibull_ccdf_log.hpp a504f6edff087e38e3007a089beedbd3 *inst/include/stan/math/prim/scal/prob/weibull_cdf.hpp 84789c3ea98f923c8065c3765acdc35f *inst/include/stan/math/prim/scal/prob/weibull_cdf_log.hpp b9bc23f9dbf269cd5a76d57bff5c72c4 *inst/include/stan/math/prim/scal/prob/weibull_lccdf.hpp 652093f1b1f1f9d6934c2436d3dca59b *inst/include/stan/math/prim/scal/prob/weibull_lcdf.hpp 80708a89a4d936f8f6d772babd46bccc *inst/include/stan/math/prim/scal/prob/weibull_log.hpp 954c0a37ad36239b3d81b5a98289dd2d *inst/include/stan/math/prim/scal/prob/weibull_lpdf.hpp 32507eb756eda52df0d0f1c1eabd64fe *inst/include/stan/math/prim/scal/prob/weibull_rng.hpp 9296caa5e4254d2f7ed65cbb49e7ca51 *inst/include/stan/math/prim/scal/prob/wiener_log.hpp 14269ce4c5ae4dcc91862f46460c4a04 *inst/include/stan/math/prim/scal/prob/wiener_lpdf.hpp f393a6ff535a1df4bae1fa840a71c07a *inst/include/stan/math/rev/arr.hpp 79dec55e0eb199053ccd5ecf5f64b126 *inst/include/stan/math/rev/arr/fun/log_sum_exp.hpp 715a42aa03dcf671c224b3cc5467e3ce *inst/include/stan/math/rev/arr/fun/sum.hpp fbd0705073aa3ed5ebb8a08fed9741d3 *inst/include/stan/math/rev/arr/fun/to_var.hpp 53e35a602aff7c40992c5434c3fca736 *inst/include/stan/math/rev/arr/functor/coupled_ode_system.hpp 176eb2831987a79693c46c9ae9f4152b *inst/include/stan/math/rev/arr/functor/integrate_1d.hpp 14358e8c870db501770512e7072446fd *inst/include/stan/math/rev/core.hpp 814e19efac388bbe93445231de0e9287 *inst/include/stan/math/rev/core/autodiffstackstorage.hpp f65a38e4a961fdd5b8e030b0790147d9 *inst/include/stan/math/rev/core/build_vari_array.hpp dccd634c297207015f1ae03a7a69d41a *inst/include/stan/math/rev/core/chainable_alloc.hpp 891674c8bf953ac71aa6cd5464231c5e *inst/include/stan/math/rev/core/chainablestack.hpp 68c34e05d440e630e43045a5c125ed0c *inst/include/stan/math/rev/core/ddv_vari.hpp 3df4d777906189f2ad4f1ec7e9347729 *inst/include/stan/math/rev/core/dv_vari.hpp 8d9c07187131a47ebe1422233261635a *inst/include/stan/math/rev/core/dvd_vari.hpp ffb77b76a04a6ee823aba36aa7333a26 *inst/include/stan/math/rev/core/dvv_vari.hpp 8eb13a19e7571d8f7d4659f8d7376101 *inst/include/stan/math/rev/core/empty_nested.hpp f2df3d5e841da0d1727c4fee020dcfb6 *inst/include/stan/math/rev/core/gevv_vvv_vari.hpp 9d8dc4b9ddf107ac2ca83be537ea92d7 *inst/include/stan/math/rev/core/grad.hpp cd799dacf3684f38ac28c603ee78e2e3 *inst/include/stan/math/rev/core/init_chainablestack.hpp 8a4f90ee55083ed7620ea2dee38112d6 *inst/include/stan/math/rev/core/matrix_vari.hpp f2aaf934d7593d23d4dd78df2c748b72 *inst/include/stan/math/rev/core/nested_size.hpp 6c593d351d232e98781cd0a26da18921 *inst/include/stan/math/rev/core/operator_addition.hpp ae66a03a55599fe0ebfb84c1a6f1ef60 *inst/include/stan/math/rev/core/operator_divide_equal.hpp e29c78f7ba28a4f9b4d1162c711b7e4c *inst/include/stan/math/rev/core/operator_division.hpp 744dd3f7ecc5690413cb1cc23719d2a0 *inst/include/stan/math/rev/core/operator_equal.hpp ae29249386d32fcdad77537ab77e1fff *inst/include/stan/math/rev/core/operator_greater_than.hpp 351138090adc327bca7d744f781e3de0 *inst/include/stan/math/rev/core/operator_greater_than_or_equal.hpp 3e11620f0382dd18d1fc791a96e88203 *inst/include/stan/math/rev/core/operator_less_than.hpp bb4004ccb25d02d0be0992709db481a4 *inst/include/stan/math/rev/core/operator_less_than_or_equal.hpp 722789f11253bbe41ceb9cf21205526f *inst/include/stan/math/rev/core/operator_logical_and.hpp b88e6d0b632a2f2f6e791c8b8a5066f5 *inst/include/stan/math/rev/core/operator_logical_or.hpp f6cb7fe8d4f80d34141848e157fef7d2 *inst/include/stan/math/rev/core/operator_minus_equal.hpp b5fbd489f63bcdc99687a8d90516a0b0 *inst/include/stan/math/rev/core/operator_multiplication.hpp b73dc8bf042a3705cdf5069fca4e1237 *inst/include/stan/math/rev/core/operator_multiply_equal.hpp b12f58622045051462ed13c4a8c4b7d7 *inst/include/stan/math/rev/core/operator_not_equal.hpp bc513aa3678f6e07ae03c6672792170a *inst/include/stan/math/rev/core/operator_plus_equal.hpp 6e7bf4e9eadeed27f21ed3f48d25136e *inst/include/stan/math/rev/core/operator_subtraction.hpp 54efa1f8911720a3ba841f17873cf7b6 *inst/include/stan/math/rev/core/operator_unary_decrement.hpp 58087a90f4d4d7c978c012a2be784c25 *inst/include/stan/math/rev/core/operator_unary_increment.hpp 156192bcea3dd79e87ae9f45caf1fac4 *inst/include/stan/math/rev/core/operator_unary_negative.hpp d9e6ec58f5187b70ae3958106e9bf77d *inst/include/stan/math/rev/core/operator_unary_not.hpp 52ac1fa930fac76e52cb7f4711ae58ff *inst/include/stan/math/rev/core/operator_unary_plus.hpp df099bd3c87734b6edaa098ac236b021 *inst/include/stan/math/rev/core/precomp_v_vari.hpp 882b5733165c223eb3b4da41b92a1671 *inst/include/stan/math/rev/core/precomp_vv_vari.hpp 2cb6a4db05c95923d54822723c594837 *inst/include/stan/math/rev/core/precomp_vvv_vari.hpp 52d2175adceb2893506480fce850dcbc *inst/include/stan/math/rev/core/precomputed_gradients.hpp 70b504df508d155733e038f5a47598eb *inst/include/stan/math/rev/core/print_stack.hpp 4626bb8eec847fb6d734fed31357f9d1 *inst/include/stan/math/rev/core/recover_memory.hpp 77b8196723ab98c3c64473fa0d5d59f3 *inst/include/stan/math/rev/core/recover_memory_nested.hpp 686ff429f8b90fc02a8f6d87a5a751e9 *inst/include/stan/math/rev/core/set_zero_all_adjoints.hpp 051a120a6a5b4324316e3ce04e7bfc55 *inst/include/stan/math/rev/core/set_zero_all_adjoints_nested.hpp 068969e15b34cd7b88d48b6051422898 *inst/include/stan/math/rev/core/start_nested.hpp d21c0344afe3eff7396fc5f7d5ebb8ad *inst/include/stan/math/rev/core/std_isinf.hpp 226a6e49356bcf2772ace980ea70148d *inst/include/stan/math/rev/core/std_isnan.hpp cc150dbb00e3a8f651358e927e1d102a *inst/include/stan/math/rev/core/std_numeric_limits.hpp a90c4e4e7f124f44838f721e9134be97 *inst/include/stan/math/rev/core/stored_gradient_vari.hpp 1d290398e626d6a85a7353bb2c002f14 *inst/include/stan/math/rev/core/v_vari.hpp 680544a17c67b1159a8eb1ce4bcba154 *inst/include/stan/math/rev/core/var.hpp a0efd3024251d0a58796e5818b6f8a98 *inst/include/stan/math/rev/core/vari.hpp 18dca63624a6b14b617a04d3e960f37e *inst/include/stan/math/rev/core/vd_vari.hpp 708b16c7821b39690fce30b23c0394e7 *inst/include/stan/math/rev/core/vdd_vari.hpp 04e01ccd5afbfa50ad609d7054caddbc *inst/include/stan/math/rev/core/vdv_vari.hpp 2bf4d279eb2fd6e1f087e7151ee6529d *inst/include/stan/math/rev/core/vector_vari.hpp 47f1a76471d0fa7784b92224fb0ca987 *inst/include/stan/math/rev/core/vv_vari.hpp 952a30d361a54309ea957986771ec38f *inst/include/stan/math/rev/core/vvd_vari.hpp 17f0e806bbbb7d1c5c45ed4d2758de50 *inst/include/stan/math/rev/core/vvv_vari.hpp 921f428e03144759ca4db46e9fe251a9 *inst/include/stan/math/rev/mat.hpp 835db23646c1918cbf8b47ece831a391 *inst/include/stan/math/rev/mat/fun/Eigen_NumTraits.hpp d3221b23ede6b5a5ac3bc90890d20aa1 *inst/include/stan/math/rev/mat/fun/LDLT_alloc.hpp 2d52dff107f34482a437ade82952a5e7 *inst/include/stan/math/rev/mat/fun/LDLT_factor.hpp a6fd5e96d82495ad3c9c8635a501d65d *inst/include/stan/math/rev/mat/fun/cholesky_decompose.hpp f89b642d66680127dee95658dd3de780 *inst/include/stan/math/rev/mat/fun/columns_dot_product.hpp 4437f4ad358bff42f45e41adcef0f40f *inst/include/stan/math/rev/mat/fun/columns_dot_self.hpp 39ff7940bc5fa103df68e49c8a2bf04e *inst/include/stan/math/rev/mat/fun/cov_exp_quad.hpp 1d1ccb8a2599738f93244c582a6612ad *inst/include/stan/math/rev/mat/fun/crossprod.hpp 376ba2fde4224db34379b2885fc207c6 *inst/include/stan/math/rev/mat/fun/determinant.hpp bc41396f928f70806f6c7b7dd6890f45 *inst/include/stan/math/rev/mat/fun/divide.hpp 64ae4e7ce57206cd7ef0dde6592abbde *inst/include/stan/math/rev/mat/fun/dot_product.hpp 4cfb485ada1c0be27bbbf621165e14ce *inst/include/stan/math/rev/mat/fun/dot_self.hpp 2137023fba400c26b72dd44521e0cfe4 *inst/include/stan/math/rev/mat/fun/gp_exp_quad_cov.hpp 16e46efe6b7e976daffc99fb16637317 *inst/include/stan/math/rev/mat/fun/gp_periodic_cov.hpp c8e98fa58d18ce5d54a19eed17b3ccdd *inst/include/stan/math/rev/mat/fun/grad.hpp c61bd45e0569a59e5909af640e4704be *inst/include/stan/math/rev/mat/fun/initialize_variable.hpp 6f8f06c338bb00019b694f7caa00cad1 *inst/include/stan/math/rev/mat/fun/inverse.hpp 43e1cab25e476b4e742f408642f7f496 *inst/include/stan/math/rev/mat/fun/log_determinant.hpp 8c7d457568d0ea4aa4b8aaf96365f42a *inst/include/stan/math/rev/mat/fun/log_determinant_ldlt.hpp cf793aba38c644108de338ed86b221fa *inst/include/stan/math/rev/mat/fun/log_determinant_spd.hpp 724208b475ea9a9804d4a90717c162ae *inst/include/stan/math/rev/mat/fun/log_softmax.hpp a3fe5364dbdfde07d7e7b53794da8076 *inst/include/stan/math/rev/mat/fun/log_sum_exp.hpp 69f9e80b604a55fde72b02f789e25f73 *inst/include/stan/math/rev/mat/fun/matrix_exp_multiply.hpp c512fbbc7e0becaf459e9b2451878bcc *inst/include/stan/math/rev/mat/fun/mdivide_left.hpp 83f6afe2738b5c566d57bc61efc314ea *inst/include/stan/math/rev/mat/fun/mdivide_left_ldlt.hpp 49ce790bb86fae217fb73ab3b169f342 *inst/include/stan/math/rev/mat/fun/mdivide_left_spd.hpp 06a35ab289e0ce5b610c92c0e620c6ea *inst/include/stan/math/rev/mat/fun/mdivide_left_tri.hpp 481ac575f7ad2814d7211f9b12a1684e *inst/include/stan/math/rev/mat/fun/multiply.hpp cd611eb30b61eadbe6382c61f76bdb61 *inst/include/stan/math/rev/mat/fun/multiply_lower_tri_self_transpose.hpp 4b28f8908323e31ca159fab0c1d72611 *inst/include/stan/math/rev/mat/fun/ordered_constrain.hpp b156150ba621bf81edd0cd63d7275940 *inst/include/stan/math/rev/mat/fun/positive_ordered_constrain.hpp 555d185c5924c9bb8eb55867aacf0e9a *inst/include/stan/math/rev/mat/fun/quad_form.hpp 771552ef422ae4fcddb8306622c54c3f *inst/include/stan/math/rev/mat/fun/quad_form_sym.hpp ca296e8ee12f34d066d886d1fefa5de1 *inst/include/stan/math/rev/mat/fun/rows_dot_product.hpp 52d429eec45454050b66a94b9b966c1c *inst/include/stan/math/rev/mat/fun/scale_matrix_exp_multiply.hpp 4654d9cd51e8de0824ee34a3ab213c0f *inst/include/stan/math/rev/mat/fun/sd.hpp ee85bb5e1ab398a4c0f5ae1023af11e9 *inst/include/stan/math/rev/mat/fun/simplex_constrain.hpp a51075431986378f6c38bf3bb3f9c4c1 *inst/include/stan/math/rev/mat/fun/softmax.hpp c2911b7e7c6098f59c5e384f94c754bf *inst/include/stan/math/rev/mat/fun/squared_distance.hpp 4ec3ad6788e95691ad391cba3bcebc27 *inst/include/stan/math/rev/mat/fun/stan_print.hpp e80f9579ffdd1957426ae416faa878fc *inst/include/stan/math/rev/mat/fun/sum.hpp e3d5574480ae36ae10e1f547666aa96c *inst/include/stan/math/rev/mat/fun/tcrossprod.hpp f250432b585d8196dd7d2f9a5f98a541 *inst/include/stan/math/rev/mat/fun/to_var.hpp 3442f35f77f5331b5b4d55e753f0ba6a *inst/include/stan/math/rev/mat/fun/trace_gen_inv_quad_form_ldlt.hpp 5707c82ad5964ef9a2b3a6757ce57bbf *inst/include/stan/math/rev/mat/fun/trace_gen_quad_form.hpp 892547d0515d20d3d09d7b62b2b150e6 *inst/include/stan/math/rev/mat/fun/trace_inv_quad_form_ldlt.hpp e48a53eccb9077dc9a248091766eff0a *inst/include/stan/math/rev/mat/fun/trace_quad_form.hpp 5f30025a3252e24811f5d47485960c7e *inst/include/stan/math/rev/mat/fun/typedefs.hpp 584128745b0c1c50d2a12aa562e4a625 *inst/include/stan/math/rev/mat/fun/unit_vector_constrain.hpp 3e3840a3bd2a2bb9439a762c10aa07a4 *inst/include/stan/math/rev/mat/fun/variance.hpp b96e883384a531cc4cf53611c3221338 *inst/include/stan/math/rev/mat/functor/adj_jac_apply.hpp 9d5ca78955cbc669e0cc7bd9bc2c0c4b *inst/include/stan/math/rev/mat/functor/algebra_solver_fp.hpp d2f7484e5cda3422693ad7ecaf0b234f *inst/include/stan/math/rev/mat/functor/algebra_solver_newton.hpp 99c333287e9be696510cc67ae43c3952 *inst/include/stan/math/rev/mat/functor/algebra_solver_powell.hpp 16b0a3248bd8ba1170f2ab9c0868942e *inst/include/stan/math/rev/mat/functor/algebra_system.hpp 8dc91fdfbfee7f7b3bb7c599c7e3aeca *inst/include/stan/math/rev/mat/functor/cvodes_integrator.hpp dc8d0fd65a90b44922cb989be9fe1e06 *inst/include/stan/math/rev/mat/functor/cvodes_ode_data.hpp 1c988afcbeddfce38c758087b130321e *inst/include/stan/math/rev/mat/functor/cvodes_utils.hpp f3e3eab9459f19b730494035fdd9ac87 *inst/include/stan/math/rev/mat/functor/gradient.hpp 28d7006ce5ad0ed43f8c7739c52c4078 *inst/include/stan/math/rev/mat/functor/idas_forward_system.hpp ba40c65bb2a7955f1a0b89d279fc9322 *inst/include/stan/math/rev/mat/functor/idas_integrator.hpp b46dc88db89bf6ee75895e6ab494c339 *inst/include/stan/math/rev/mat/functor/idas_system.hpp 644cc1c0f2f32556b9d631bf1522bdba *inst/include/stan/math/rev/mat/functor/integrate_dae.hpp 0ab7c821042a2af51e3e751e2cac70ed *inst/include/stan/math/rev/mat/functor/integrate_ode_adams.hpp 277a5aa6be4c9afcf922dc3c9d4ef79a *inst/include/stan/math/rev/mat/functor/integrate_ode_bdf.hpp 366ef02044b45003e75c50e915f9875a *inst/include/stan/math/rev/mat/functor/jacobian.hpp 9311500a74b93bc4f35e652dfd37a7d2 *inst/include/stan/math/rev/mat/functor/kinsol_data.hpp 1284fdd101a04edc7b0d30084871f02f *inst/include/stan/math/rev/mat/functor/kinsol_solve.hpp 496cb0e79940436000878f530297f5c6 *inst/include/stan/math/rev/mat/functor/map_rect_concurrent.hpp aec45df5a5f52650e7ef6a6a69162d66 *inst/include/stan/math/rev/mat/functor/map_rect_reduce.hpp 5f7670453ca02c3123742c6d7e10947b *inst/include/stan/math/rev/mat/meta/operands_and_partials.hpp f9939978fc8c52f208c70d89cebf7c95 *inst/include/stan/math/rev/mat/vectorize/apply_scalar_unary.hpp 37a1a80649d5bcf11a648b209e49e237 *inst/include/stan/math/rev/meta.hpp ecb3940667010bb9290ccdc4506439df *inst/include/stan/math/rev/scal.hpp ec3397c2993ea6ab3c59bfadc4cb2dfc *inst/include/stan/math/rev/scal/fun/Phi.hpp 460b887502370e5d7490c901fd2fe737 *inst/include/stan/math/rev/scal/fun/Phi_approx.hpp f79daf03a588e71b01370ee4cdb3e7bb *inst/include/stan/math/rev/scal/fun/abs.hpp 049fc9bac80d32183e671fb7360e0155 *inst/include/stan/math/rev/scal/fun/acos.hpp 0f4903ac5c5f96e0b923147ddf861308 *inst/include/stan/math/rev/scal/fun/acosh.hpp 54daaa3e0e9dc151751fd8759c75123e *inst/include/stan/math/rev/scal/fun/as_bool.hpp 6f3ef597c314f055244c97b2930672bb *inst/include/stan/math/rev/scal/fun/asin.hpp c6b0c759352a1744f99e53ee9d4976af *inst/include/stan/math/rev/scal/fun/asinh.hpp 2b4e336032f4486c1518a45773e05273 *inst/include/stan/math/rev/scal/fun/atan.hpp 40af6d9d4dd08e96261747da47203b0d *inst/include/stan/math/rev/scal/fun/atan2.hpp f6bc96361ad3ce49b489ab03207302a9 *inst/include/stan/math/rev/scal/fun/atanh.hpp c708d6376a9f310d128b1fa8544ff23c *inst/include/stan/math/rev/scal/fun/bessel_first_kind.hpp c115114cf73c673eb9347ad4a8dba33c *inst/include/stan/math/rev/scal/fun/bessel_second_kind.hpp d692cd55cf79e4530e7528b469c58f0b *inst/include/stan/math/rev/scal/fun/beta.hpp 5bd7fbb85fb1cf10c9c67cec75830377 *inst/include/stan/math/rev/scal/fun/binary_log_loss.hpp 550ad5bcde63195b64ab9ba667c29e9d *inst/include/stan/math/rev/scal/fun/boost_fpclassify.hpp 29663e56d2adc1a1d6e456d12273e861 *inst/include/stan/math/rev/scal/fun/boost_isfinite.hpp 7df8acf3bd7e0e1b3ab2c4b4d16dee15 *inst/include/stan/math/rev/scal/fun/boost_isnormal.hpp bc6975c8120fc6ff681beed0591bd6a2 *inst/include/stan/math/rev/scal/fun/calculate_chain.hpp ceb03f8a57c24942d9573cb3b5bc5cda *inst/include/stan/math/rev/scal/fun/cbrt.hpp 18ad793fd0645c3ccb3afb368f60cbe0 *inst/include/stan/math/rev/scal/fun/ceil.hpp dd0d8331ae6c9837b005e0f703be845b *inst/include/stan/math/rev/scal/fun/cos.hpp 8f2452743bab5d59b8f77b2c8b16b766 *inst/include/stan/math/rev/scal/fun/cosh.hpp 52886545699211e50ba2d3e7fac39b82 *inst/include/stan/math/rev/scal/fun/digamma.hpp f136075776172b5ad65bb4f245cab36e *inst/include/stan/math/rev/scal/fun/erf.hpp c0efe37bdaf6e76908b516b11821b39e *inst/include/stan/math/rev/scal/fun/erfc.hpp 94f878fe0bef8ba617895a695aaa3f70 *inst/include/stan/math/rev/scal/fun/exp.hpp 9a4a0418f108c7f8bf71778eebfc4025 *inst/include/stan/math/rev/scal/fun/exp2.hpp 6310b731610df99a33db6be8aadb837f *inst/include/stan/math/rev/scal/fun/expm1.hpp 0cb576ad581462562050bfcab1cee47e *inst/include/stan/math/rev/scal/fun/fabs.hpp 7f21b30ade9dd74776e871a5828a8bc3 *inst/include/stan/math/rev/scal/fun/falling_factorial.hpp 740931fd28733f3315852255639e9930 *inst/include/stan/math/rev/scal/fun/fdim.hpp ec12cb53ea7b304c8bfca8ba26d55921 *inst/include/stan/math/rev/scal/fun/floor.hpp 417b075d5eb1bdd8f159909a1b1643b1 *inst/include/stan/math/rev/scal/fun/fma.hpp a009884a9af72aab12e6451b0e3cc14c *inst/include/stan/math/rev/scal/fun/fmax.hpp 4567f011523ffc3b7e66c2b6303b036c *inst/include/stan/math/rev/scal/fun/fmin.hpp 13c9bded9875d6618d809fab9c792954 *inst/include/stan/math/rev/scal/fun/fmod.hpp 9a84f989911fc7ae2a1f302a9faec1ee *inst/include/stan/math/rev/scal/fun/gamma_p.hpp 5963d9d472d1188932d40e4838a2ff30 *inst/include/stan/math/rev/scal/fun/gamma_q.hpp 5b3e0147aac105dafc0d05295821ffd9 *inst/include/stan/math/rev/scal/fun/grad_inc_beta.hpp f1b2357aac067fe080894e5576743080 *inst/include/stan/math/rev/scal/fun/hypot.hpp 361cdeda348ed0695533b191f42548bd *inst/include/stan/math/rev/scal/fun/ibeta.hpp c81bb51bad34c634da6478cd99c02009 *inst/include/stan/math/rev/scal/fun/if_else.hpp 88295443d67c3a2fd3c804a9f10dba58 *inst/include/stan/math/rev/scal/fun/inc_beta.hpp e9281fa9964a3819f118dfc8e5f1f086 *inst/include/stan/math/rev/scal/fun/inv.hpp 336b8c88a62968dbea313728dd41d2ce *inst/include/stan/math/rev/scal/fun/inv_Phi.hpp 66ccda0b348b79bb1fdc016cf41ebd6b *inst/include/stan/math/rev/scal/fun/inv_cloglog.hpp 065737e59c65afdbfd71ac7c1db1ddc1 *inst/include/stan/math/rev/scal/fun/inv_logit.hpp 2e6b12b7371142f80c6cf9ad987c0746 *inst/include/stan/math/rev/scal/fun/inv_sqrt.hpp 407c6e3c899a01f822b84c7810db1b12 *inst/include/stan/math/rev/scal/fun/inv_square.hpp d1cf2943fceccd4b59de0a29cfad9cb0 *inst/include/stan/math/rev/scal/fun/is_inf.hpp e407631862e570e3a8ac50a651906494 *inst/include/stan/math/rev/scal/fun/is_nan.hpp e457d731c909a4069fb158332fce6fe8 *inst/include/stan/math/rev/scal/fun/is_uninitialized.hpp e295a5da950a750b530b7a62893ad90d *inst/include/stan/math/rev/scal/fun/lbeta.hpp f67dce3dbb0ae7f23ada7aa6bcb38222 *inst/include/stan/math/rev/scal/fun/ldexp.hpp d44b2ee9d191920712e7e66a7af20c0d *inst/include/stan/math/rev/scal/fun/lgamma.hpp b4f55735e2de8027533d592e09d4aff6 *inst/include/stan/math/rev/scal/fun/lmgamma.hpp d198d4a0fa652657bfe81183a99e6f18 *inst/include/stan/math/rev/scal/fun/log.hpp d237e7426cdba3389a6ac770fc79e2c9 *inst/include/stan/math/rev/scal/fun/log10.hpp 44e8f4b341b9941ae77eec9dd828429a *inst/include/stan/math/rev/scal/fun/log1m.hpp c9c0f98a71522ac7d3378d18c4a53350 *inst/include/stan/math/rev/scal/fun/log1m_exp.hpp e7617713a8d6cb84c0a0a2b76e142262 *inst/include/stan/math/rev/scal/fun/log1m_inv_logit.hpp e4429116d5920ee22b572d95fd9f4b0d *inst/include/stan/math/rev/scal/fun/log1p.hpp 3bb705e7f6052a287639a3465c97bd84 *inst/include/stan/math/rev/scal/fun/log1p_exp.hpp cb9029c1577c4a859eb3e47163a342ab *inst/include/stan/math/rev/scal/fun/log2.hpp f8d6129ab852b2ea82b605d398e0d0e8 *inst/include/stan/math/rev/scal/fun/log_diff_exp.hpp bd7d2a38b53fe19a835f781206087f98 *inst/include/stan/math/rev/scal/fun/log_falling_factorial.hpp 15743a63c6f9f0b2aedd8c9a7a46066b *inst/include/stan/math/rev/scal/fun/log_inv_logit.hpp 7f0eb4b9196b810b76cd13c57dd95c22 *inst/include/stan/math/rev/scal/fun/log_inv_logit_diff.hpp a999838e99ff36358694991cf3705233 *inst/include/stan/math/rev/scal/fun/log_mix.hpp ba1bb883afd48f6bdeae54f3f4d98090 *inst/include/stan/math/rev/scal/fun/log_rising_factorial.hpp 79ca2d4fcebf86d2a8ab70896b63d609 *inst/include/stan/math/rev/scal/fun/log_sum_exp.hpp 63d6d9290f7949a727c8f95ba07231d2 *inst/include/stan/math/rev/scal/fun/logit.hpp 809ab83128bca92224cae6b3df379799 *inst/include/stan/math/rev/scal/fun/modified_bessel_first_kind.hpp 181ea467b301b90c06c084c44256eea6 *inst/include/stan/math/rev/scal/fun/modified_bessel_second_kind.hpp d1e931fb921d1e57ff5920c6d849b1f2 *inst/include/stan/math/rev/scal/fun/multiply_log.hpp 98871c7f51d7f5bec7c064da48a18665 *inst/include/stan/math/rev/scal/fun/owens_t.hpp 1e3f18f6481de3262967248df2e523fa *inst/include/stan/math/rev/scal/fun/pow.hpp 004c5b67151372dd59f638edf328e9a3 *inst/include/stan/math/rev/scal/fun/primitive_value.hpp efd38595989dbf91dfba9fe71320887a *inst/include/stan/math/rev/scal/fun/rising_factorial.hpp 9ceb154c29ae11690f2ebe6d364049f2 *inst/include/stan/math/rev/scal/fun/round.hpp 4624aba89eff82895a75dcc52d0d50b3 *inst/include/stan/math/rev/scal/fun/sin.hpp f04dc6c4f8863fe6ea4b6651f8e6019c *inst/include/stan/math/rev/scal/fun/sinh.hpp 88eae7bdd6009ee23e71165e57fdd189 *inst/include/stan/math/rev/scal/fun/sqrt.hpp 91fad25189bae0e7723d81c4de0c00bc *inst/include/stan/math/rev/scal/fun/square.hpp 6f03e7271d36434dead4e322c9e582e3 *inst/include/stan/math/rev/scal/fun/squared_distance.hpp 572260baa92ba9d6f8ee0034ca715430 *inst/include/stan/math/rev/scal/fun/step.hpp 41e8b26d33b0c903f3f27a8dd844c581 *inst/include/stan/math/rev/scal/fun/tan.hpp 52e312b9e82c942794cc72b238475796 *inst/include/stan/math/rev/scal/fun/tanh.hpp 5d53f818f2572816643d00477a5f828d *inst/include/stan/math/rev/scal/fun/tgamma.hpp e1ba495b85556d7976b52129e6d2b580 *inst/include/stan/math/rev/scal/fun/to_var.hpp 58938c6b92db2049cc1aa67bfab8d743 *inst/include/stan/math/rev/scal/fun/trigamma.hpp e038e11e147d0bd3bbb3c3627428b36e *inst/include/stan/math/rev/scal/fun/trunc.hpp cb647491c8513bc5b556bdc68dd42dc8 *inst/include/stan/math/rev/scal/fun/value_of.hpp 77f6d5329a8af383c78aeb76cda64c7c *inst/include/stan/math/rev/scal/fun/value_of_rec.hpp 5232c8b48729aa1b0d0360ab80c9cbb7 *inst/include/stan/math/rev/scal/meta/is_var.hpp a3a9fa8e415425e1d1cfb8d9f4e6be45 *inst/include/stan/math/rev/scal/meta/operands_and_partials.hpp ad0f0580f3a21b1bea73fdf62f52eb44 *inst/include/stan/math/rev/scal/meta/partials_type.hpp f706dd0a921122182e09565534c8ecfa *inst/include/stan/math/version.hpp b3e50636326e2d460f7a76b7176477a2 *inst/include/stan_sundials_printf_override.hpp 403467bbf1d07ad3d924c5f0af325893 *inst/include/sundials/sundials_band.h 45aeda7a03726b3a93024546bd50caf5 *inst/include/sundials/sundials_config.h 5782886c80b6e38634329ab8a48e3956 *inst/include/sundials/sundials_config.in 5de662351c11c283714ef20985237d3b *inst/include/sundials/sundials_dense.h 1e4f434233774bcf94f4d6845e918e5e *inst/include/sundials/sundials_direct.h 05eec07d9fad8ad918e022b0febc1033 *inst/include/sundials/sundials_fconfig.h c6e29c14ddc49c6f93dca56345986bee *inst/include/sundials/sundials_fconfig.in 7f0ac02a6c824f2220bdf9e9c9d1ece1 *inst/include/sundials/sundials_fnvector.h b13fdc1388e47825530038b706b4db1e *inst/include/sundials/sundials_iterative.h d60d8ba9bceb6ecb08e9262a9e2ee231 *inst/include/sundials/sundials_klu_impl.h 868f429a8e86292bac652ccff4416821 *inst/include/sundials/sundials_lapack.h ee570a4561fc36a69aa83c179a7b4f52 *inst/include/sundials/sundials_linearsolver.h 5e8bfb955117200411081bdf469c696a *inst/include/sundials/sundials_math.h f41aad95ad5269153466f1ac48f19f9d *inst/include/sundials/sundials_matrix.h 0cd593367f2a5c79b061243531e2cfc2 *inst/include/sundials/sundials_mpi.h d9814acf10a34b100ad9b89ade18bb01 *inst/include/sundials/sundials_mpi_types.h ebdeb54f9f33a5396fd0e096953863f6 *inst/include/sundials/sundials_nonlinearsolver.h e029628678017244145b6f7da3c5108f *inst/include/sundials/sundials_nvector.h 03689b03c4ce9a377c6808fa264ec579 *inst/include/sundials/sundials_nvector_senswrapper.h de5b362fa5aa2c42afb40011c64317ae *inst/include/sundials/sundials_pcg.h 4d70d7fed927ef2dd6b3a1db6ae84232 *inst/include/sundials/sundials_sparse.h 75f1a3f97e8fec5f14001ff1b626fbfe *inst/include/sundials/sundials_spbcgs.h bb390ac0f0d4b36d7c26b2b98901f36d *inst/include/sundials/sundials_spfgmr.h d07f086e9ee129ab3b72193b9e8db387 *inst/include/sundials/sundials_spgmr.h 2f7b22a77c321a9aa94813d7deb1cf62 *inst/include/sundials/sundials_sptfqmr.h e50977de0b20237b028d84a554bf7fb3 *inst/include/sundials/sundials_superlumt_impl.h 67dc7962b26edaa94922f6f57b1deffd *inst/include/sundials/sundials_types.h 29ae2ab3a8233ac01354788be20d0aac *inst/include/sundials/sundials_version.h 07a7bd817cf206bb0b7a8924ec7f7c5b *inst/include/sunlinsol/sunlinsol_band.h d05eb51bbba2d91868e8d1e97844bf39 *inst/include/sunlinsol/sunlinsol_dense.h 5f58e6494692afcc544606ea9e2eba3c *inst/include/sunlinsol/sunlinsol_klu.h 178ff6ad497f05f01dacd5e952e1fd33 *inst/include/sunlinsol/sunlinsol_lapackband.h 6cab2dc186d1a3aa65d43791b66d4850 *inst/include/sunlinsol/sunlinsol_lapackdense.h 5e2b08a93249ca514f5c367a4d26949e *inst/include/sunlinsol/sunlinsol_pcg.h ec7e3aa367a89cb1a5f54ac0c0fadb08 *inst/include/sunlinsol/sunlinsol_spbcgs.h fb0e91ab024f6172b403e14d620e9abf *inst/include/sunlinsol/sunlinsol_spfgmr.h 0fa679fc4947ae106bc14412b4e08797 *inst/include/sunlinsol/sunlinsol_spgmr.h ac073a0c898a564a3fd15f7813122b41 *inst/include/sunlinsol/sunlinsol_sptfqmr.h 182df301b6350aebea55c89e5551ed47 *inst/include/sunlinsol/sunlinsol_superlumt.h 4863a6b165c6fe94ebf1a9c9e8042755 *inst/include/sunmatrix/sunmatrix_band.h 7751b1a150250b2460acc915d67e1b7c *inst/include/sunmatrix/sunmatrix_dense.h 804a49972f86798e6aa34b8896cf7b6b *inst/include/sunmatrix/sunmatrix_sparse.h 4cfffcdd7b0ac4a10120bc25de2a8390 *inst/include/sunnonlinsol/sunnonlinsol_fixedpoint.h 53c2c30209a13a421e82ba62bd7857b9 *inst/include/sunnonlinsol/sunnonlinsol_newton.h ea5e3433950f612f657da746ebfddef0 *man/CxxFlags.Rd 1543f396354b61b30e2ceea1c96c2187 *man/stanFunction.Rd 1416931241eded93a1a7892d608e13a2 *src/Makevars 775d01b2d4f7cd65f488621f9901b873 *src/Makevars.win bb1a34994e56bfa40202c6c2eab17fd6 *src/cvodes/LICENSE 5dfe22201a2919be5021a8bc7c74efc4 *src/cvodes/NOTICE cac04c97bced43d8838258bbc49696fb *src/cvodes/README 20b38683087d4dc5e9a63b9f3c3dc137 *src/cvodes/cvodea.c f664cb8451f182c071bfbbaf6cea6cbf *src/cvodes/cvodea_io.c de0fbd9a474aa8b9221282756bd51756 *src/cvodes/cvodes.c ff662139a006e66ea9e8d7be1071a223 *src/cvodes/cvodes_bandpre.c 2e36eb82501ac5b8e4837a3729031455 *src/cvodes/cvodes_bandpre_impl.h dc44088291420b200c25901662b5eece *src/cvodes/cvodes_bbdpre.c 573b67da4772f3bdd853af61150f46ea *src/cvodes/cvodes_bbdpre_impl.h 3da40dda91dc726a4ee433b94596f2d5 *src/cvodes/cvodes_diag.c 52a803fd59f2eed168ed76c56d4ac1df *src/cvodes/cvodes_diag_impl.h 897a82b840dbe67bf2f64e7aecd92ac8 *src/cvodes/cvodes_direct.c e6a9420f52a20eb40f2e62788bd09496 *src/cvodes/cvodes_impl.h e7b7f617821e5f7e88030c6e030b6dc5 *src/cvodes/cvodes_io.c f0b47f3adbd0f2539615d38262d5c1d3 *src/cvodes/cvodes_ls.c 2c402e39e0dbff8b8e27c2d923b61082 *src/cvodes/cvodes_ls_impl.h 1d05f9dfaa901932219a4910d57fbc1e *src/cvodes/cvodes_nls.c ef45b211a6177720139703b38027ce0a *src/cvodes/cvodes_nls_sim.c 321e2edc4a18c28c584269a55fe75e76 *src/cvodes/cvodes_nls_stg.c 86a517b68683cc2ec84980de5a105f3e *src/cvodes/cvodes_nls_stg1.c a9ca7004824bf3f045cea65bdab9c875 *src/cvodes/cvodes_spils.c bb1a34994e56bfa40202c6c2eab17fd6 *src/idas/LICENSE 5dfe22201a2919be5021a8bc7c74efc4 *src/idas/NOTICE 4213130d60dad030fecdb6c78de235cf *src/idas/README 4209747c26731674cef9de84ae03ae4d *src/idas/idaa.c e73aa5dd896155afb57504354723ae10 *src/idas/idaa_io.c be9ff45937061b2da2da247e2de40c69 *src/idas/idas.c bd585b27947d8d7f2bcc1f1fc29b75df *src/idas/idas_bbdpre.c 80fadb92c527bef4f7f63bedf36cce8a *src/idas/idas_bbdpre_impl.h d52c9094b1f0e9ab9ec20d7651703a3b *src/idas/idas_direct.c 5268b7f503995befdcb7ebaa73e53ba4 *src/idas/idas_ic.c bb0717b848321345357bcc85a909077c *src/idas/idas_impl.h 9a868e52b5dd83f635a2d2b22aa73054 *src/idas/idas_io.c 404507fcf9e8a1042f92c6536117ea3e *src/idas/idas_ls.c 52d2be65e947fff15b7413c7ffe12ddf *src/idas/idas_ls_impl.h f1dce9a57edb9a78bb7fbe4e960af0f5 *src/idas/idas_nls.c f64e7f731ae6d85c37ebdf128d3d6858 *src/idas/idas_nls_sim.c 511009b94108f938572b96010c3e97a3 *src/idas/idas_nls_stg.c e59b3f1554c0566bda92c8e4085e28fc *src/idas/idas_spils.c d8d6f3a81ddc136c7bad498731bb0af0 *src/init.c 2ee1232c21d367ea9b13996cb8e38b2e *src/install.libs.R 326e75e8d22d37780fc2cf052834d7ad *src/kinsol/CMakeLists.txt bb1a34994e56bfa40202c6c2eab17fd6 *src/kinsol/LICENSE 5dfe22201a2919be5021a8bc7c74efc4 *src/kinsol/NOTICE 4638c89b6b2173a4895743cb74a9d9b3 *src/kinsol/README 8a58c075d2f31642c8a59c16e1dec0dc *src/kinsol/fcmix/CMakeLists.txt 7e6de1f58c4a958a6270d298c2ed8ca0 *src/kinsol/fcmix/fkinband.c 08aa609fdf2767c9817331b2f6b82f0a *src/kinsol/fcmix/fkinbbd.c 4f59071113f6b7a882ec5e78780f9de3 *src/kinsol/fcmix/fkinbbd.h 67d3c3eee4709097cbc0d6fb0dd79346 *src/kinsol/fcmix/fkindense.c dd4084589579a1cf4a0a0b64bcd85934 *src/kinsol/fcmix/fkinjtimes.c 89c934c4d06f0a99da4498e700a0e694 *src/kinsol/fcmix/fkinnulllinsol.c e4678c7234f5581dbf39f858c4f9fdff *src/kinsol/fcmix/fkinnullmatrix.c 7a04615d2844876c6c71020bfbf5ccfe *src/kinsol/fcmix/fkinpreco.c b39ac47a67305bafd07e0a8a01030215 *src/kinsol/fcmix/fkinsol.c 2cf664677c8984b155a9fbbb6c43a31a *src/kinsol/fcmix/fkinsol.h 0b8642384a181357ee59372469a3cb64 *src/kinsol/fcmix/fkinsparse.c 253ba79f1799b90eedef5ac189343b6e *src/kinsol/kinsol.c 618b043ae1c68981a524d27419abcade *src/kinsol/kinsol_bbdpre.c 2d9a732df2808b5a5c79f973fbaf6cef *src/kinsol/kinsol_bbdpre_impl.h 7f6e5f9543cb2c13ae6fdfd913a49917 *src/kinsol/kinsol_direct.c ed747d145cab17d7b70cf07b05e0d3f6 *src/kinsol/kinsol_impl.h deeba15ce9a5da30466da926bc27cf44 *src/kinsol/kinsol_io.c 455bbf43b1889963522f114925e6a1a8 *src/kinsol/kinsol_ls.c daf70f7ca44836927f8991f77f29ef0b *src/kinsol/kinsol_ls_impl.h 664f8489f6c400010b64c09527d3b827 *src/kinsol/kinsol_spils.c 5818e4de2ed67bcbaa4e6596ec3470b0 *src/nvector/cuda/nvector_cuda.cu 2195f60fd4e05d6383412e4d1b207ec3 *src/nvector/openmp/F90/fnvector_openmp.f90 da3f42e28fe79baa8a272dc946d41b11 *src/nvector/openmp/fnvector_openmp.c ec61478ef89ed5a0cb9a71f62f9c9643 *src/nvector/openmp/fnvector_openmp.h 5182f1619205902cfe3bebee16d177eb *src/nvector/openmp/nvector_openmp.c 987ddb4a8b2bd283813248fc71495e64 *src/nvector/openmpdev/nvector_openmpdev.c e0ffab37944438d6413f644131e6febe *src/nvector/parallel/fnvector_parallel.c ea0b4563a9a1334317dd3144abd75c09 *src/nvector/parallel/fnvector_parallel.h b42f2cf02e19f45bdd31283f7fad9f39 *src/nvector/parallel/nvector_parallel.c ecb16fd58e51c9c8105e74b29d2c168a *src/nvector/parhyp/nvector_parhyp.c dbeae0a1be6b5ca0251c675cbe44f03b *src/nvector/petsc/nvector_petsc.c f4ce3c0e48d2bfa6bc99c3e7cdf6df2a *src/nvector/pthreads/F90/fnvector_pthreads.f90 e5ec8aaf0896849d34ba28197b8e3df8 *src/nvector/pthreads/fnvector_pthreads.c d04a118002525f9cd5f46a8fc5e2c608 *src/nvector/pthreads/fnvector_pthreads.h 584ee43db910ff0c5b90b8b64e8d81cf *src/nvector/pthreads/nvector_pthreads.c 8002a1a0edea5017e2145743bb96b049 *src/nvector/raja/nvector_raja.cu 4ef818e6e18cc9e44595e48f9cdeee74 *src/nvector/serial/F90/fnvector_serial.f90 17e815b232b2fc1214c4461aec62004c *src/nvector/serial/fnvector_serial.c 21a87502e5bf8a52c72f17ea049a15dc *src/nvector/serial/fnvector_serial.h e74ed37de00c2f4cde872b4af07a5c65 *src/nvector/serial/nvector_serial.c 69e3d15c0627b7d789d27c2812b2fefd *src/nvector/trilinos/nvector_trilinos.cpp 0b7829731c94b8011203e2bc8ff76f4f *src/sundials/sundials_band.c fbdb7332ba04fb8ff2ec82b9a05ea368 *src/sundials/sundials_dense.c d0d9d634c8b33d9c420d3f9a3d598ee5 *src/sundials/sundials_direct.c 42dd395faf2496bae9e3f386cbb6fe1e *src/sundials/sundials_iterative.c 14564f8b470824454d31f21c414b071a *src/sundials/sundials_linearsolver.c d93c0b9b89f505d05b1efbeda99405bb *src/sundials/sundials_math.c 1aeb779debb33d569dd868e1524f81ea *src/sundials/sundials_matrix.c 93599a95003a885463d8988365609522 *src/sundials/sundials_mpi.c ddb28a247a94d8827ebadf9fdf6e1bf9 *src/sundials/sundials_nonlinearsolver.c 5ad433ed4be2e87939f6aa61dfa7f4ac *src/sundials/sundials_nvector.c cee1653746606a0dfb73139921ff9e81 *src/sundials/sundials_nvector_senswrapper.c e22954ccda22bafd9e5d62649ad7935f *src/sundials/sundials_pcg.c 3a0d62a64ec8dc8ea333ba8133c9665b *src/sundials/sundials_sparse.c 0812f13f0951e067699862a2a839c5cc *src/sundials/sundials_spbcgs.c d9dd61094822ba687e36e5567d045cc9 *src/sundials/sundials_sptfqmr.c a35553b9e9dcf949d1410c1dbd84ed03 *src/sundials/sundials_version.c d17a1547f5ee8858d3075c97fdcc3989 *src/sunlinsol/band/F90/fsunlinsol_band.f90 f2a49547111e989083fd5020cd603da1 *src/sunlinsol/band/fsunlinsol_band.c 2d2da7df49e3a8f7526935df9cce474b *src/sunlinsol/band/fsunlinsol_band.h 43beef1af352af9ea19e1580b28d20ab *src/sunlinsol/band/sunlinsol_band.c 46581309d59114704c9377353e6e6955 *src/sunlinsol/dense/F90/fsunlinsol_dense.f90 35f5282f76b1a926626b468af68af633 *src/sunlinsol/dense/fsunlinsol_dense.c e314535117d8d3b6c048dc68a7a96c57 *src/sunlinsol/dense/fsunlinsol_dense.h 5043690ea0c5d27d98d0cbf51437e29b *src/sunlinsol/dense/sunlinsol_dense.c 2c60402a6775abb6a23fb34f69000ea1 *src/sunlinsol/klu/F90/fsunlinsol_klu.f90 3afaf89d22757f97da794af2cfe44619 *src/sunlinsol/klu/fsunlinsol_klu.c e06ed5aa6878ecdef158aab715459135 *src/sunlinsol/klu/fsunlinsol_klu.h 77012c88883f14134318d5bb87326727 *src/sunlinsol/klu/sunlinsol_klu.c 0e348cd9325c17d66518f52123110549 *src/sunlinsol/lapackband/fsunlinsol_lapackband.c 5178b967414d361a9a1d7a15669b3da5 *src/sunlinsol/lapackband/fsunlinsol_lapackband.h d5886f4d65d0a9197ece4f0428edd824 *src/sunlinsol/lapackband/sunlinsol_lapackband.c 0ec69e3b5678906962538fa5e95098b5 *src/sunlinsol/lapackdense/fsunlinsol_lapackdense.c b4a5df54b4e262521e895c932261abc8 *src/sunlinsol/lapackdense/fsunlinsol_lapackdense.h 616d0e1888e1a50ed5bb6e6962de8ae9 *src/sunlinsol/lapackdense/sunlinsol_lapackdense.c a5d18c9f6cbc560ab156a9b92a29863c *src/sunlinsol/pcg/F90/fsunlinsol_pcg.f90 87dbfced484bc93d084e137080b14e39 *src/sunlinsol/pcg/fsunlinsol_pcg.c a69c28a0abd45fd86fcf8083f634e88e *src/sunlinsol/pcg/fsunlinsol_pcg.h 6f96b9152cf0c34ced587c5df3bb0e9d *src/sunlinsol/pcg/sunlinsol_pcg.c 95e8c4bf0a580c8cf6ac61898587c8d3 *src/sunlinsol/spbcgs/F90/fsunlinsol_spbcgs.f90 2027deef734810e6ee9240a6af949150 *src/sunlinsol/spbcgs/fsunlinsol_spbcgs.c 8ae3dc2630fd14b1da4e53cde804c1d6 *src/sunlinsol/spbcgs/fsunlinsol_spbcgs.h 23aba342ff4317d3ada73b89d1ea2396 *src/sunlinsol/spbcgs/sunlinsol_spbcgs.c 2464a7cf59d266fb138f2f7cb6eb2c56 *src/sunlinsol/spfgmr/F90/fsunlinsol_spfgmr.f90 fc0f52508614a4bfdc0670b2632f05ed *src/sunlinsol/spfgmr/fsunlinsol_spfgmr.c 818efa2d3206be91c9354c3bce7cb23c *src/sunlinsol/spfgmr/fsunlinsol_spfgmr.h 623e222c22151c3213904f9044d101d0 *src/sunlinsol/spfgmr/sunlinsol_spfgmr.c 199e7a529e66ec61c7d8b43799463c41 *src/sunlinsol/spgmr/F90/fsunlinsol_spgmr.f90 861a14d6b9f2c94676d108aeca069a52 *src/sunlinsol/spgmr/fsunlinsol_spgmr.c 3e0c1dd4b86c9c8662ad8285bf0447f6 *src/sunlinsol/spgmr/fsunlinsol_spgmr.h 7785f46f8daa2cbae4c001a107ba354f *src/sunlinsol/spgmr/sunlinsol_spgmr.c 2003f4556893ef01f61f8bd6c84d4ac3 *src/sunlinsol/sptfqmr/F90/fsunlinsol_sptfqmr.f90 7a9735d1390c4bf67f79b59cce575eeb *src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.c f5135d8e18d22058de9db76dd5b83abf *src/sunlinsol/sptfqmr/fsunlinsol_sptfqmr.h 9ece1039154cd1677308aac4f4905568 *src/sunlinsol/sptfqmr/sunlinsol_sptfqmr.c e34305b52149712d1b15d42c42634d36 *src/sunlinsol/superlumt/fsunlinsol_superlumt.c eb7622c77e89c3d793d36785cb1b1f49 *src/sunlinsol/superlumt/fsunlinsol_superlumt.h ec7b0462734af2889268a0ebf467dfda *src/sunlinsol/superlumt/sunlinsol_superlumt.c fb1475e722de8a68a20cc8713a118d7f *src/sunmatrix/band/F90/fsunmatrix_band.f90 c5e845814f67f1a3169a39509c891dbd *src/sunmatrix/band/fsunmatrix_band.c 1f681db0f3d037f89b79d6f70a3b9627 *src/sunmatrix/band/fsunmatrix_band.h 0b5ec3ca07f7b73637e52552eec7ded4 *src/sunmatrix/band/sunmatrix_band.c af5fb4bdf97fb4a3b7b79ef206cd0b42 *src/sunmatrix/dense/F90/fsunmatrix_dense.f90 3f2a5637c5369d40d449bcda4e3737fb *src/sunmatrix/dense/fsunmatrix_dense.c e564687ebba119308e425f2213d2d797 *src/sunmatrix/dense/fsunmatrix_dense.h 3f094e776b794f3850bd1f39226a1488 *src/sunmatrix/dense/sunmatrix_dense.c e2111a6c1fb7c88f3a3dd02afea62d87 *src/sunmatrix/sparse/F90/fsunmatrix_sparse.f90 d848cfacdeff653af95ed6be4e544ad3 *src/sunmatrix/sparse/fsunmatrix_sparse.c 1e42e68fe1c546b7eee8ce640abe4d34 *src/sunmatrix/sparse/fsunmatrix_sparse.h ecb3175ab04a5eef6d4758e1ebdd479d *src/sunmatrix/sparse/sunmatrix_sparse.c d153d34ee4e22334e174374677479054 *src/sunnonlinsol/fixedpoint/F90/fsunnonlinsol_fixedpoint.f90 09e06caf8761e11cb3d1b8c2e3dd7c8a *src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.c 093d210a924c96bc61e940060ede06c8 *src/sunnonlinsol/fixedpoint/fsunnonlinsol_fixedpoint.h c3c84bb449ae87e470b3779521da6e72 *src/sunnonlinsol/fixedpoint/sunnonlinsol_fixedpoint.c fd7720f7f3734cdcdfd0a1be3080771d *src/sunnonlinsol/newton/F90/fsunnonlinsol_newton.f90 db903c2e1252893ca96eed15c095f41c *src/sunnonlinsol/newton/fsunnonlinsol_newton.c 737de6d4d62b5dfb9bbaa950c5e97cf8 *src/sunnonlinsol/newton/fsunnonlinsol_newton.h 4d3d4f0fc8930cfc00c728d461534c5c *src/sunnonlinsol/newton/sunnonlinsol_newton.c 54cf10ca5ac7b36b45a9796ab12a1bfb *tests/rstan.R d9f299a822d38c4fd8a3eb612ba4bbfd *vignettes/sparselm_stan.hpp d9e4def70bfef3a9124fe4edd9179a2d *vignettes/stanmath.Rmd StanHeaders/inst/0000755000176200001440000000000013766554455013454 5ustar liggesusersStanHeaders/inst/doc/0000755000176200001440000000000013766554463014220 5ustar liggesusersStanHeaders/inst/doc/stanmath.Rmd0000644000176200001440000004232713711604070016467 0ustar liggesusers--- title: "Using the Stan Math C++ Library" author: "Stan Development Team" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Using the Stan Math C++ Library} %\VignetteEncoding{UTF-8} %\VignetteEngine{knitr::rmarkdown} editor_options: chunk_output_type: inline --- ```{r setup, include = FALSE} options(width = 100) knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) local({ hook_output <- knitr::knit_hooks$get('output') knitr::knit_hooks$set(output = function(x, options) { if (!is.null(options$max.height)) options$attr.output <- c( options$attr.output, sprintf('style="max-height: %s;"', options$max.height) ) hook_output(x, options) }) }) Sys.setenv(USE_CXX14 = "1") set.seed(12345) ``` # Using the **StanHeaders** Package from Other R Packages The **StanHeaders** package contains no R functions. To use the Stan Math Library in other packages, it is often sufficient to specify ``` LinkingTo: StanHeaders (>= 2.21.0), RcppParallel (>= 5.0.1) ``` in the DESCRIPTION file of another package and put something like ``` CXX_STD = CXX14 PKG_CXXFLAGS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::CxxFlags()") \ $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::CxxFlags()") PKG_LIBS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::RcppParallelLibs()") \ $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::LdFlags()") ``` in the src/Makevars and src/Makevars.win files and put `GNU make` in the `SystemRequirements:` field of the package's DESCRIPTION file. If, in addition, the other package needs to utilize the MCMC, optimization, variational inference, or parsing facilities of the Stan Library, then it is also necessary to include the `src` directory of **StanHeaders** in the other package's `PKG_CXXFLAGS` in the src/Makevars and src/Makevars.win files with something like ``` STANHEADERS_SRC = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "message()" \ -e "cat(system.file('include', 'src', package = 'StanHeaders', mustWork = TRUE))" \ -e "message()" | grep "StanHeaders") PKG_CXXFLAGS += -I"$(STANHEADERS_SRC)" ``` # Calling functions in the **StanHeaders** Package from R The only exposed R function in the in the **StanHeaders** package is `stanFunction`, which can be used to call most functions in the Stan Math Library. ```{r} example(stanFunction, package = "StanHeaders", run.dontrun = TRUE) ``` ```{css, echo=FALSE} .scroll-100 { max-height: 100px; overflow-y: auto; background-color: inherit; } ``` The `functions` object defined in this example lists the many Stan functions that could be called (if all their arguments are numeric, see `help(stanFunction, package = "StanHeaders")` for details) ```{r, echo = FALSE, warning = FALSE, class.output="scroll-100"} if (length(functions) %% 2 == 1) { functions <- c(functions, "") } functions <- matrix(functions, ncol = 2, byrow = TRUE) print(functions) ``` # Using Higher-Order Functions in the **StanHeaders** Package This section will demonstrate how to use some of the C++ functions in the **StanHeaders** package whose first argument is another C++ function, in which case the `stanFunction` in the previous section will not work and you have to write your own C++. ## Derivatives and Minimization The following is a toy example of using the Stan Math library via `Rcpp::sourceCpp`: to minimize the function $$\left(\mathbf{x} - \mathbf{a}\right)^\top \left(\mathbf{x} - \mathbf{a}\right)$$ which has a global minimum when $\mathbf{x} = \mathbf{a}$. To find this minimum with autodifferentiation, we need to define the objective function. Then, its gradient with respect to $\mathbf{x}$, which we know is $2\left(\mathbf{x} - \mathbf{a}\right)$ in this case, can be calculated by autodifferentiation. At the optimum (or on the way to the optimum), we might want to evaluate the Hessian matrix, which we know is $2\mathbf{I}$, but would need an additional function to evaluate it via autodifferentiation. Finally, one could reconceptualize the problem as solving a homogeneous system of equations where the gradient is set equal to a vector of zeros. The `stan::math::algebra_solver` function can solve such a system using autodifferentiation to obtain the Jacobian, which we know to be the identity matrix in this case. ```{r} Sys.setenv(PKG_CXXFLAGS = StanHeaders:::CxxFlags(as_character = TRUE)) SH <- system.file(ifelse(.Platform$OS.type == "windows", "libs", "lib"), .Platform$r_arch, package = "StanHeaders", mustWork = TRUE) Sys.setenv(PKG_LIBS = paste0(StanHeaders:::LdFlags(as_character = TRUE), " -L", shQuote(SH), " -lStanHeaders")) ``` Here is C++ code that does all of the above, except for the part of finding the optimum, which is done using the R function `optim` below. ```{Rcpp} // [[Rcpp::depends(BH)]] // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(StanHeaders)]] #include // stuff from fwd/ must come first #include // then stuff from mix/ must come next #include // finally pull in everything from rev/ & prim/ #include #include // do this AFTER including stan/math // [[Rcpp::plugins(cpp14)]] /* Objective function */ // [[Rcpp::export]] auto f(Eigen::VectorXd x, Eigen::VectorXd a) { // objective function in doubles using stan::math::dot_self; // dot_self() is a dot product with self return dot_self( (x - a).eval() ); // .eval() yields a Eigen::VectorXd } /* Gradient */ // [[Rcpp::export]] auto g(Eigen::VectorXd x, Eigen::VectorXd a) { // gradient by AD using Stan double fx; Eigen::VectorXd grad_fx; using stan::math::dot_self; stan::math::gradient([&a](auto x) { return dot_self( (x - a).eval() ); }, x, fx, grad_fx); return grad_fx; } /* Hessian */ // [[Rcpp::export]] auto H(Eigen::VectorXd x, Eigen::VectorXd a) { // Hessian by AD using Stan double fx; Eigen::VectorXd grad_fx; Eigen::MatrixXd H; using stan::math::dot_self; using stan::math::subtract; // necessary to get the type promotion correct stan::math::hessian([&a](auto x) { return dot_self(subtract(x, a)); }, x, fx, grad_fx, H); return H; } /* Jacobian */ // [[Rcpp::export]] auto J(Eigen::VectorXd x, Eigen::VectorXd a) { // not actually used Eigen::VectorXd fx; Eigen::MatrixXd J; using stan::math::dot_self; stan::math::jacobian([&a](auto x) { return (2 * (x - a)).eval(); }, x, fx, J); return J; } struct equations_functor { template inline Eigen::Matrix operator()(const Eigen::Matrix& x, const Eigen::Matrix& theta, const std::vector& x_r, const std::vector& x_i, std::ostream* pstream__) const { return 2 * (x - stan::math::to_vector(x_r)).eval(); } }; // [[Rcpp::export]] auto solution(Eigen::VectorXd a, Eigen::VectorXd guess) { Eigen::VectorXd theta; auto x_r = stan::math::to_array_1d(a); equations_functor f; auto x = stan::math::algebra_solver(f, guess, theta, x_r, {}); return x; } ``` In this compiled RMarkdown document, the **knitr** package has exported functions `f`, `g`, `H`, `J` and `solution` (but not `equations_functor`) to R's global environment using the `sourceCpp` function in the **Rcpp** package, so that they can now be called from R. Here we find the optimum starting from a random point in three dimensions: ```{r} x <- optim(rnorm(3), fn = f, gr = g, a = 1:3, method = "BFGS", hessian = TRUE) x$par x$hessian H(x$par, a = 1:3) J(x$par, a = 1:3) solution(a = 1:3, guess = rnorm(3)) ``` # Integrals and Ordinary Differential Equations The Stan Math library can do one-dimensional numerical integration and can solve stiff and non-stiff systems of differential equations, such as the harmonic oscillator example below. Solving stiff systems utilizes the CVODES library, which is included in **StanHeaders**. ```{Rcpp} // [[Rcpp::depends(BH)]] // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(StanHeaders)]] #include // pulls in everything from rev/ and prim/ #include #include // do this AFTER including stan/math // [[Rcpp::plugins(cpp14)]] /* Definite integrals */ // [[Rcpp::export]] double Cauchy(double scale) { std::vector theta; auto half = stan::math::integrate_1d([](auto x, auto xc, auto theta, auto x_r, auto x_i, auto msgs) { return exp(stan::math::cauchy_lpdf(x, 0, x_r[0])); }, -scale, scale, theta, {scale}, {}, Rcpp::Rcout, 1e-7); return half * 2; // should equal 1 for any positive scale } /* Ordinary Differential Equations */ // [[Rcpp::export]] auto nonstiff(Eigen::MatrixXd A, Eigen::VectorXd y0) { using stan::math::integrate_ode_rk45; using stan::math::to_vector; using stan::math::to_array_1d; std::vector theta; std::vector times = {1, 2}; auto y = integrate_ode_rk45([&A](auto t, auto y, auto theta, auto x_r, auto x_i, std::ostream *msgs) { return to_array_1d( (A * to_vector(y)).eval() ); }, to_array_1d(y0), 0, times, theta, {}, {}); Eigen::VectorXd truth = stan::math::matrix_exp(A) * y0; return (to_vector(y[0]) - truth).eval(); // should be "zero" } // [[Rcpp::export]] auto stiff(Eigen::MatrixXd A, Eigen::VectorXd y0) { // not actually stiff using stan::math::integrate_ode_bdf; // but use the stiff solver anyways using stan::math::to_vector; using stan::math::to_array_1d; std::vector theta; std::vector times = {1, 2}; auto y = integrate_ode_bdf([&A](auto t, auto y, auto theta, auto x_r, auto x_i, std::ostream *msgs) { return to_array_1d( (A * to_vector(y)).eval() ); }, to_array_1d(y0), 0, times, theta, {}, {}); Eigen::VectorXd truth = stan::math::matrix_exp(A) * y0; return (to_vector(y[0]) - truth).eval(); // should be "zero" } ``` Again, in this compiled RMarkdown document, the **knitr** package has exported the `Cauchy`, `nonstiff` and `stiff` functions to R's global environment using the `sourceCpp` function in the **Rcpp** package so that they can be called from R. First, we numerically integrate the Cauchy PDF over its interquartile range --- which has an area of $\frac{1}{2}$ --- that we then double to verify that it is almost within machine precision of $1$. ```{r} all.equal(1, Cauchy(rexp(1)), tol = 1e-15) ``` Next, we consider the system of differential equations $$\frac{d}{dt}\mathbf{y} = \mathbf{A}\mathbf{y}$$ where $\mathbf{A}$ is a square matrix such as that for a simple harmonic oscillator $$\mathbf{A} = \begin{bmatrix}0 & 1 \\ -1 & -\theta\end{bmatrix}$$ for $\theta \in \left(0,1\right)$. The solution for $\mathbf{y}_t = e^{t\mathbf{A}}\mathbf{y}_0$ can be obtained via the matrix exponential function, which is available in the Stan Math Library, but it can also be obtained numerically using a fourth-order Runge-Kutta solver, which is appropriate for non-stiff systems of ODEs, such as this one. However, it is possible, albeit less efficient in this case, to use the backward-differentiation formula solver for stiff systems of ODEs. In both cases, we calculate the difference between the analytical solution and the numerical one, and the stiff version does produce somewhat better accuracy in this case. ```{r} A <- matrix(c(0, -1, 1, -runif(1)), nrow = 2, ncol = 2) y0 <- rexp(2) all.equal(nonstiff(A, y0), c(0, 0), tol = 1e-5) all.equal( stiff(A, y0), c(0, 0), tol = 1e-8) ``` # Map and Parellelization The Stan Math Library includes the `map_rect` function, which applies a function to each element of rectangular arrays and returns a vector, making it a bit like a restricted version of R's `sapply` function. However, `map_rect` can also be executed in parallel by defining the pre-processor directive `STAN_THREADS` and then setting the `STAN_NUM_THREADS` environmental variable to be the number of threads to use, as in ```{r} Sys.setenv(STAN_NUM_THREADS = 2) # specify -1 to use all available cores ``` Below is C++ code to test whether an integer is prime, using a rather brute-force algorithm and running it in parallel via `map_rect`. ```{Rcpp} // [[Rcpp::depends(BH)]] // [[Rcpp::depends(RcppEigen)]] // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::depends(StanHeaders)]] #include // pulls in everything from rev/ and prim/ #include #include // do this AFTER including stan/math // [[Rcpp::plugins(cpp14)]] // see https://en.wikipedia.org/wiki/Primality_test#Pseudocode struct is_prime { is_prime() {} template auto operator()(const Eigen::Matrix& eta, const Eigen::Matrix& theta, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs = 0) const { Eigen::VectorXd res(1); // can only return double or var vectors int n = x_i[0]; if (n <= 3) { res.coeffRef(0) = n > 1; return res; } else if ( (n % 2 == 0) || (n % 3 == 0) ) { res.coeffRef(0) = false; return res; } int i = 5; while (i * i <= n) { if ( (n % i == 0) || (n % (i + 2) == 0) ) { res.coeffRef(0) = false; return res; } i += 6; } res.coeffRef(0) = true; return res; } }; /* parallelization */ // [[Rcpp::export]] auto psapply(std::vector > n) { std::vector eta(n.size()); // these all have to be the same size Eigen::VectorXd theta; std::vector > x_d(n.size()); return stan::math::map_rect<0, is_prime>(theta, eta, x_d, n, &Rcpp::Rcout); } ``` Since the signature for `n` is a `std::vector >`, we have to pass it from R as a list (which is converted to the outer `std::vector<>`) of integer vectors (which is converted to the inner `std::vector`) that happen to be of size one in this case. ```{r} odd <- seq.int(from = 2^25 - 1, to = 2^26 - 1, by = 2) tail(psapply(n = as.list(odd))) == 1 # check your process manager while this is running ``` Thus, $2^{26} - 5 = 67,108,859$ is a prime number. # Defining a Stan Model in C++ The Stan _language_ does not have much support for sparse matrices for a variety of reasons. Essentially the only applicable function is `csr_matrix_times_vector`, which pre-multiplies a vector by a sparse matrix in compressed row storage by taking as arguments its number of rows, columns, non-zero values, column indices of non-zero values, and locations where the non-zero values start in each row. While the `csr_matrix_times_vector` function could be used to implement the example below, we illustrate how to use the sparse data structures in the **Matrix** and **RcppEigen** packages in a Stan model written in C++, which could easily be extended to more complicated models with sparse data structures. Our C++ file for the log-likelihood of a linear model with a sparse design matrix reads as ```{r, echo = FALSE, comment = ""} cat(readLines("sparselm_stan.hpp"), sep = "\n") ``` To use it from R, we call the `exposeClass` function in the **Rcpp** package with the necessary arguments and then call `sourceCpp` on the file it wrote in the temporary directory: ```{r, message = FALSE} library(Rcpp) tf <- tempfile(fileext = "Module.cpp") exposeClass("sparselm_stan", constructors = list(c("Eigen::Map >", "Eigen::VectorXd")), fields = c("X", "y"), methods = c("log_prob<>", "gradient<>"), rename = c(log_prob = "log_prob<>", gradient = "gradient<>"), header = c("// [[Rcpp::depends(BH)]]", "// [[Rcpp::depends(RcppEigen)]]", "// [[Rcpp::depends(RcppParallel)]", "// [[Rcpp::depends(StanHeaders)]]", "// [[Rcpp::plugins(cpp14)]]", paste0("#include <", file.path(getwd(), "sparselm_stan.hpp"), ">")), file = tf, Rfile = FALSE) Sys.setenv(PKG_CXXFLAGS = paste0(Sys.getenv("PKG_CXXFLAGS"), " -I", system.file("include", "src", package = "StanHeaders", mustWork = TRUE))) sourceCpp(tf) sparselm_stan ``` At this point, we need a sparse design matrix and (dense) outcome vector to pass to the constructor. The former can be created with a variety of functions in the **Matrix** package, such as ```{r} dd <- data.frame(a = gl(3, 4), b = gl(4, 1, 12)) X <- Matrix::sparse.model.matrix(~ a + b, data = dd) X ``` Finally, we call the `new` function in the **methods** package, which essentially calls our C++ constructor and provides an R interface to the instantiated object, which contains the `log_prob` and `gradient` methods we defined and can be called with arbitrary inputs. ```{r} sm <- new(sparselm_stan, X = X, y = rnorm(nrow(X))) sm$log_prob(c(beta = rnorm(ncol(X)), log_sigma = log(pi))) round(sm$gradient(c(beta = rnorm(ncol(X)), log_sigma = log(pi))), digits = 4) ``` StanHeaders/inst/doc/stanmath.R0000644000176200001440000001025113766554453016160 0ustar liggesusers## ----setup, include = FALSE----------------------------------------------------------------------- options(width = 100) knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) local({ hook_output <- knitr::knit_hooks$get('output') knitr::knit_hooks$set(output = function(x, options) { if (!is.null(options$max.height)) options$attr.output <- c( options$attr.output, sprintf('style="max-height: %s;"', options$max.height) ) hook_output(x, options) }) }) Sys.setenv(USE_CXX14 = "1") set.seed(12345) ## ------------------------------------------------------------------------------------------------- example(stanFunction, package = "StanHeaders", run.dontrun = TRUE) ## ---- echo = FALSE, warning = FALSE, class.output="scroll-100"------------------------------------ if (length(functions) %% 2 == 1) { functions <- c(functions, "") } functions <- matrix(functions, ncol = 2, byrow = TRUE) print(functions) ## ------------------------------------------------------------------------------------------------- Sys.setenv(PKG_CXXFLAGS = StanHeaders:::CxxFlags(as_character = TRUE)) SH <- system.file(ifelse(.Platform$OS.type == "windows", "libs", "lib"), .Platform$r_arch, package = "StanHeaders", mustWork = TRUE) Sys.setenv(PKG_LIBS = paste0(StanHeaders:::LdFlags(as_character = TRUE), " -L", shQuote(SH), " -lStanHeaders")) ## ------------------------------------------------------------------------------------------------- x <- optim(rnorm(3), fn = f, gr = g, a = 1:3, method = "BFGS", hessian = TRUE) x$par x$hessian H(x$par, a = 1:3) J(x$par, a = 1:3) solution(a = 1:3, guess = rnorm(3)) ## ------------------------------------------------------------------------------------------------- all.equal(1, Cauchy(rexp(1)), tol = 1e-15) ## ------------------------------------------------------------------------------------------------- A <- matrix(c(0, -1, 1, -runif(1)), nrow = 2, ncol = 2) y0 <- rexp(2) all.equal(nonstiff(A, y0), c(0, 0), tol = 1e-5) all.equal( stiff(A, y0), c(0, 0), tol = 1e-8) ## ------------------------------------------------------------------------------------------------- Sys.setenv(STAN_NUM_THREADS = 2) # specify -1 to use all available cores ## ------------------------------------------------------------------------------------------------- odd <- seq.int(from = 2^25 - 1, to = 2^26 - 1, by = 2) tail(psapply(n = as.list(odd))) == 1 # check your process manager while this is running ## ---- echo = FALSE, comment = ""------------------------------------------------------------------ cat(readLines("sparselm_stan.hpp"), sep = "\n") ## ---- message = FALSE----------------------------------------------------------------------------- library(Rcpp) tf <- tempfile(fileext = "Module.cpp") exposeClass("sparselm_stan", constructors = list(c("Eigen::Map >", "Eigen::VectorXd")), fields = c("X", "y"), methods = c("log_prob<>", "gradient<>"), rename = c(log_prob = "log_prob<>", gradient = "gradient<>"), header = c("// [[Rcpp::depends(BH)]]", "// [[Rcpp::depends(RcppEigen)]]", "// [[Rcpp::depends(RcppParallel)]", "// [[Rcpp::depends(StanHeaders)]]", "// [[Rcpp::plugins(cpp14)]]", paste0("#include <", file.path(getwd(), "sparselm_stan.hpp"), ">")), file = tf, Rfile = FALSE) Sys.setenv(PKG_CXXFLAGS = paste0(Sys.getenv("PKG_CXXFLAGS"), " -I", system.file("include", "src", package = "StanHeaders", mustWork = TRUE))) sourceCpp(tf) sparselm_stan ## ------------------------------------------------------------------------------------------------- dd <- data.frame(a = gl(3, 4), b = gl(4, 1, 12)) X <- Matrix::sparse.model.matrix(~ a + b, data = dd) X ## ------------------------------------------------------------------------------------------------- sm <- new(sparselm_stan, X = X, y = rnorm(nrow(X))) sm$log_prob(c(beta = rnorm(ncol(X)), log_sigma = log(pi))) round(sm$gradient(c(beta = rnorm(ncol(X)), log_sigma = log(pi))), digits = 4) StanHeaders/inst/doc/stanmath.html0000644000176200001440000032056013766554454016733 0ustar liggesusers Using the Stan Math C++ Library

Using the Stan Math C++ Library

Stan Development Team

2020-12-16

Using the StanHeaders Package from Other R Packages

The StanHeaders package contains no R functions. To use the Stan Math Library in other packages, it is often sufficient to specify

LinkingTo: StanHeaders (>= 2.21.0), RcppParallel (>= 5.0.1)

in the DESCRIPTION file of another package and put something like

CXX_STD = CXX14
PKG_CXXFLAGS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::CxxFlags()") \
               $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::CxxFlags()")
PKG_LIBS = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "RcppParallel::RcppParallelLibs()") \
           $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "StanHeaders:::LdFlags()")

in the src/Makevars and src/Makevars.win files and put GNU make in the SystemRequirements: field of the package’s DESCRIPTION file. If, in addition, the other package needs to utilize the MCMC, optimization, variational inference, or parsing facilities of the Stan Library, then it is also necessary to include the src directory of StanHeaders in the other package’s PKG_CXXFLAGS in the src/Makevars and src/Makevars.win files with something like

STANHEADERS_SRC = $(shell "$(R_HOME)/bin$(R_ARCH_BIN)/Rscript" -e "message()" \
  -e "cat(system.file('include', 'src', package = 'StanHeaders', mustWork = TRUE))" \
  -e "message()" | grep "StanHeaders")
PKG_CXXFLAGS += -I"$(STANHEADERS_SRC)"

Calling functions in the StanHeaders Package from R

The only exposed R function in the in the StanHeaders package is stanFunction, which can be used to call most functions in the Stan Math Library.

example(stanFunction, package = "StanHeaders", run.dontrun = TRUE)
#> 
#> stnFnc>   files <- dir(system.file("include", "stan", "math", "prim",
#> stnFnc+                            package = "StanHeaders"), 
#> stnFnc+                pattern = "hpp$", recursive = TRUE)
#> 
#> stnFnc>   functions <- sub("\\.hpp$", "", 
#> stnFnc+                    sort(unique(basename(files[dirname(files) != "."]))))
#> 
#> stnFnc>   length(functions) # you could call most of these Stan functions
#> [1] 760
#> 
#> stnFnc>     log(sum(exp(exp(1)), exp(pi))) # true value
#> [1] 3.645318
#> 
#> stnFnc>     stanFunction("log_sum_exp", x = exp(1), y = pi)
#> [1] 3.645318
#> 
#> stnFnc>     args(log_sum_exp) # now exists in .GlobalEnv
#> function (x, y) 
#> NULL
#> 
#> stnFnc>     log_sum_exp(x = pi, y = exp(1))
#> [1] 3.645318
#> 
#> stnFnc>     # but log_sum_exp() was not defined for a vector or matrix
#> stnFnc>     x <- c(exp(1), pi)
#> 
#> stnFnc>     try(log_sum_exp(x))
#> Error in log_sum_exp(x) : argument "y" is missing, with no default
#> 
#> stnFnc>     stanFunction("log_sum_exp", x = x) # now it is
#> [1] 3.645318
#> 
#> stnFnc>     # log_sum_exp() is now also defined for a matrix
#> stnFnc>     log_sum_exp(as.matrix(x))
#> [1] 3.645318
#> 
#> stnFnc>     log_sum_exp(t(as.matrix(x)))
#> [1] 3.645318
#> 
#> stnFnc>     log_sum_exp(rbind(x, x))
#> [1] 4.338465
#> 
#> stnFnc>     # but log_sum_exp() was not defined for a list
#> stnFnc>     try(log_sum_exp(as.list(x)))
#> Error in log_sum_exp(as.list(x)) : 
#>   Not compatible with requested type: [type=list; target=double].
#> 
#> stnFnc>     stanFunction("log_sum_exp", x = as.list(x)) # now it is
#> [1] 3.645318
#> 
#> stnFnc>     # in rare cases, passing a nested list is needed
#> stnFnc>     stanFunction("dims", x = list(list(1:3)))
#> [1] 1 1 3
#> 
#> stnFnc>     # nullary functions work but are not that interesting
#> stnFnc>     stanFunction("negative_infinity")
#> [1] -Inf
#> 
#> stnFnc>     # PRNG functions work by adding a seed argument
#> stnFnc>     stanFunction("lkj_corr_rng", K = 3L, eta = 1)
#>            [,1]       [,2]      [,3]
#> [1,]  1.0000000 -0.5401593 0.1336589
#> [2,] -0.5401593  1.0000000 0.5153359
#> [3,]  0.1336589  0.5153359 1.0000000
#> 
#> stnFnc>     args(lkj_corr_rng) # has a seed argument
#> function (K, eta, random_seed = sample.int(.Machine$integer.max, 
#>     size = 1L)) 
#> NULL

The functions object defined in this example lists the many Stan functions that could be called (if all their arguments are numeric, see help(stanFunction, package = "StanHeaders") for details)

#>        [,1]                                [,2]                            
#>   [1,] "Eigen"                             "F32"                           
#>   [2,] "LDLT_factor"                       "Phi"                           
#>   [3,] "Phi_approx"                        "StdVectorBuilder"              
#>   [4,] "VectorBuilder"                     "VectorBuilderHelper"           
#>   [5,] "abs"                               "accumulator"                   
#>   [6,] "acos"                              "acosh"                         
#>   [7,] "ad_promotable"                     "add"                           
#>   [8,] "add_diag"                          "append_array"                  
#>   [9,] "append_col"                        "append_return_type"            
#>  [10,] "append_row"                        "apply_scalar_unary"            
#>  [11,] "array_builder"                     "as_array_or_scalar"            
#>  [12,] "as_bool"                           "as_column_vector_or_scalar"    
#>  [13,] "as_scalar"                         "asin"                          
#>  [14,] "asinh"                             "assign"                        
#>  [15,] "atan"                              "atanh"                         
#>  [16,] "autocorrelation"                   "autocovariance"                
#>  [17,] "bernoulli_ccdf_log"                "bernoulli_cdf"                 
#>  [18,] "bernoulli_cdf_log"                 "bernoulli_lccdf"               
#>  [19,] "bernoulli_lcdf"                    "bernoulli_log"                 
#>  [20,] "bernoulli_logit_glm_log"           "bernoulli_logit_glm_lpmf"      
#>  [21,] "bernoulli_logit_glm_rng"           "bernoulli_logit_log"           
#>  [22,] "bernoulli_logit_lpmf"              "bernoulli_logit_rng"           
#>  [23,] "bernoulli_lpmf"                    "bernoulli_rng"                 
#>  [24,] "bessel_first_kind"                 "bessel_second_kind"            
#>  [25,] "beta"                              "beta_binomial_ccdf_log"        
#>  [26,] "beta_binomial_cdf"                 "beta_binomial_cdf_log"         
#>  [27,] "beta_binomial_lccdf"               "beta_binomial_lcdf"            
#>  [28,] "beta_binomial_log"                 "beta_binomial_lpmf"            
#>  [29,] "beta_binomial_rng"                 "beta_ccdf_log"                 
#>  [30,] "beta_cdf"                          "beta_cdf_log"                  
#>  [31,] "beta_lccdf"                        "beta_lcdf"                     
#>  [32,] "beta_log"                          "beta_lpdf"                     
#>  [33,] "beta_proportion_ccdf_log"          "beta_proportion_cdf_log"       
#>  [34,] "beta_proportion_lccdf"             "beta_proportion_lcdf"          
#>  [35,] "beta_proportion_log"               "beta_proportion_lpdf"          
#>  [36,] "beta_proportion_rng"               "beta_rng"                      
#>  [37,] "binary_log_loss"                   "binomial_ccdf_log"             
#>  [38,] "binomial_cdf"                      "binomial_cdf_log"              
#>  [39,] "binomial_coefficient_log"          "binomial_lccdf"                
#>  [40,] "binomial_lcdf"                     "binomial_log"                  
#>  [41,] "binomial_logit_log"                "binomial_logit_lpmf"           
#>  [42,] "binomial_lpmf"                     "binomial_rng"                  
#>  [43,] "block"                             "bool_constant"                 
#>  [44,] "boost_policy"                      "broadcast_array"               
#>  [45,] "categorical_log"                   "categorical_logit_glm_lpmf"    
#>  [46,] "categorical_logit_log"             "categorical_logit_lpmf"        
#>  [47,] "categorical_logit_rng"             "categorical_lpmf"              
#>  [48,] "categorical_rng"                   "cauchy_ccdf_log"               
#>  [49,] "cauchy_cdf"                        "cauchy_cdf_log"                
#>  [50,] "cauchy_lccdf"                      "cauchy_lcdf"                   
#>  [51,] "cauchy_log"                        "cauchy_lpdf"                   
#>  [52,] "cauchy_rng"                        "cbrt"                          
#>  [53,] "ceil"                              "check_2F1_converges"           
#>  [54,] "check_3F2_converges"               "check_bounded"                 
#>  [55,] "check_cholesky_factor"             "check_cholesky_factor_corr"    
#>  [56,] "check_column_index"                "check_consistent_size"         
#>  [57,] "check_consistent_size_mvt"         "check_consistent_sizes"        
#>  [58,] "check_consistent_sizes_mvt"        "check_corr_matrix"             
#>  [59,] "check_cov_matrix"                  "check_finite"                  
#>  [60,] "check_flag_sundials"               "check_greater"                 
#>  [61,] "check_greater_or_equal"            "check_ldlt_factor"             
#>  [62,] "check_less"                        "check_less_or_equal"           
#>  [63,] "check_lower_triangular"            "check_matching_dims"           
#>  [64,] "check_matching_sizes"              "check_multiplicable"           
#>  [65,] "check_nonempty"                    "check_nonnegative"             
#>  [66,] "check_nonzero_size"                "check_not_nan"                 
#>  [67,] "check_ordered"                     "check_pos_definite"            
#>  [68,] "check_pos_semidefinite"            "check_positive"                
#>  [69,] "check_positive_finite"             "check_positive_ordered"        
#>  [70,] "check_range"                       "check_row_index"               
#>  [71,] "check_simplex"                     "check_size_match"              
#>  [72,] "check_spsd_matrix"                 "check_square"                  
#>  [73,] "check_std_vector_index"            "check_symmetric"               
#>  [74,] "check_unit_vector"                 "check_vector"                  
#>  [75,] "chi_square_ccdf_log"               "chi_square_cdf"                
#>  [76,] "chi_square_cdf_log"                "chi_square_lccdf"              
#>  [77,] "chi_square_lcdf"                   "chi_square_log"                
#>  [78,] "chi_square_lpdf"                   "chi_square_rng"                
#>  [79,] "child_type"                        "chol2inv"                      
#>  [80,] "cholesky_corr_constrain"           "cholesky_corr_free"            
#>  [81,] "cholesky_decompose"                "cholesky_factor_constrain"     
#>  [82,] "cholesky_factor_free"              "choose"                        
#>  [83,] "col"                               "cols"                          
#>  [84,] "columns_dot_product"               "columns_dot_self"              
#>  [85,] "common_type"                       "conjunction"                   
#>  [86,] "constants"                         "constraint_tolerance"          
#>  [87,] "contains_fvar"                     "contains_std_vector"           
#>  [88,] "contains_vector"                   "corr_constrain"                
#>  [89,] "corr_free"                         "corr_matrix_constrain"         
#>  [90,] "corr_matrix_free"                  "cos"                           
#>  [91,] "cosh"                              "coupled_ode_observer"          
#>  [92,] "coupled_ode_system"                "cov_exp_quad"                  
#>  [93,] "cov_matrix_constrain"              "cov_matrix_constrain_lkj"      
#>  [94,] "cov_matrix_free"                   "cov_matrix_free_lkj"           
#>  [95,] "crossprod"                         "csr_extract_u"                 
#>  [96,] "csr_extract_v"                     "csr_extract_w"                 
#>  [97,] "csr_matrix_times_vector"           "csr_to_dense_matrix"           
#>  [98,] "csr_u_to_z"                        "cumulative_sum"                
#>  [99,] "determinant"                       "diag_matrix"                   
#> [100,] "diag_post_multiply"                "diag_pre_multiply"             
#> [101,] "diagonal"                          "digamma"                       
#> [102,] "dims"                              "dirichlet_log"                 
#> [103,] "dirichlet_lpmf"                    "dirichlet_rng"                 
#> [104,] "disjunction"                       "distance"                      
#> [105,] "divide"                            "divide_columns"                
#> [106,] "domain_error"                      "domain_error_vec"              
#> [107,] "dot"                               "dot_product"                   
#> [108,] "dot_self"                          "double_exponential_ccdf_log"   
#> [109,] "double_exponential_cdf"            "double_exponential_cdf_log"    
#> [110,] "double_exponential_lccdf"          "double_exponential_lcdf"       
#> [111,] "double_exponential_log"            "double_exponential_lpdf"       
#> [112,] "double_exponential_rng"            "eigenvalues_sym"               
#> [113,] "eigenvectors_sym"                  "elt_divide"                    
#> [114,] "elt_multiply"                      "erf"                           
#> [115,] "erfc"                              "error_index"                   
#> [116,] "exp"                               "exp2"                          
#> [117,] "exp_mod_normal_ccdf_log"           "exp_mod_normal_cdf"            
#> [118,] "exp_mod_normal_cdf_log"            "exp_mod_normal_lccdf"          
#> [119,] "exp_mod_normal_lcdf"               "exp_mod_normal_log"            
#> [120,] "exp_mod_normal_lpdf"               "exp_mod_normal_rng"            
#> [121,] "expm1"                             "exponential_ccdf_log"          
#> [122,] "exponential_cdf"                   "exponential_cdf_log"           
#> [123,] "exponential_lccdf"                 "exponential_lcdf"              
#> [124,] "exponential_log"                   "exponential_lpdf"              
#> [125,] "exponential_rng"                   "fabs"                          
#> [126,] "factor_U"                          "factor_cov_matrix"             
#> [127,] "falling_factorial"                 "fdim"                          
#> [128,] "fill"                              "finite_diff_gradient"          
#> [129,] "finite_diff_gradient_auto"         "finite_diff_hessian"           
#> [130,] "finite_diff_hessian_auto"          "finite_diff_hessian_helper"    
#> [131,] "finite_diff_stepsize"              "floor"                         
#> [132,] "fma"                               "fmax"                          
#> [133,] "fmin"                              "frechet_ccdf_log"              
#> [134,] "frechet_cdf"                       "frechet_cdf_log"               
#> [135,] "frechet_lccdf"                     "frechet_lcdf"                  
#> [136,] "frechet_log"                       "frechet_lpdf"                  
#> [137,] "frechet_rng"                       "gamma_ccdf_log"                
#> [138,] "gamma_cdf"                         "gamma_cdf_log"                 
#> [139,] "gamma_lccdf"                       "gamma_lcdf"                    
#> [140,] "gamma_log"                         "gamma_lpdf"                    
#> [141,] "gamma_p"                           "gamma_q"                       
#> [142,] "gamma_rng"                         "gaussian_dlm_obs_log"          
#> [143,] "gaussian_dlm_obs_lpdf"             "gaussian_dlm_obs_rng"          
#> [144,] "get"                               "get_base1"                     
#> [145,] "get_base1_lhs"                     "get_lp"                        
#> [146,] "gp_dot_prod_cov"                   "gp_exp_quad_cov"               
#> [147,] "gp_exponential_cov"                "gp_matern32_cov"               
#> [148,] "gp_matern52_cov"                   "gp_periodic_cov"               
#> [149,] "grad_2F1"                          "grad_F32"                      
#> [150,] "grad_inc_beta"                     "grad_reg_inc_beta"             
#> [151,] "grad_reg_inc_gamma"                "grad_reg_lower_inc_gamma"      
#> [152,] "gumbel_ccdf_log"                   "gumbel_cdf"                    
#> [153,] "gumbel_cdf_log"                    "gumbel_lccdf"                  
#> [154,] "gumbel_lcdf"                       "gumbel_log"                    
#> [155,] "gumbel_lpdf"                       "gumbel_rng"                    
#> [156,] "head"                              "hypergeometric_log"            
#> [157,] "hypergeometric_lpmf"               "hypergeometric_rng"            
#> [158,] "hypot"                             "ibeta"                         
#> [159,] "identity_constrain"                "identity_free"                 
#> [160,] "if_else"                           "inc_beta"                      
#> [161,] "inc_beta_dda"                      "inc_beta_ddb"                  
#> [162,] "inc_beta_ddz"                      "include_summand"               
#> [163,] "index_type"                        "init_threadpool_tbb"           
#> [164,] "initialize"                        "int_step"                      
#> [165,] "integrate_1d"                      "integrate_ode_rk45"            
#> [166,] "inv"                               "inv_Phi"                       
#> [167,] "inv_chi_square_ccdf_log"           "inv_chi_square_cdf"            
#> [168,] "inv_chi_square_cdf_log"            "inv_chi_square_lccdf"          
#> [169,] "inv_chi_square_lcdf"               "inv_chi_square_log"            
#> [170,] "inv_chi_square_lpdf"               "inv_chi_square_rng"            
#> [171,] "inv_cloglog"                       "inv_gamma_ccdf_log"            
#> [172,] "inv_gamma_cdf"                     "inv_gamma_cdf_log"             
#> [173,] "inv_gamma_lccdf"                   "inv_gamma_lcdf"                
#> [174,] "inv_gamma_log"                     "inv_gamma_lpdf"                
#> [175,] "inv_gamma_rng"                     "inv_logit"                     
#> [176,] "inv_sqrt"                          "inv_square"                    
#> [177,] "inv_wishart_log"                   "inv_wishart_lpdf"              
#> [178,] "inv_wishart_rng"                   "invalid_argument"              
#> [179,] "invalid_argument_vec"              "inverse"                       
#> [180,] "inverse_softmax"                   "inverse_spd"                   
#> [181,] "is_any_nan"                        "is_cholesky_factor"            
#> [182,] "is_cholesky_factor_corr"           "is_column_index"               
#> [183,] "is_constant"                       "is_corr_matrix"                
#> [184,] "is_eigen"                          "is_fvar"                       
#> [185,] "is_inf"                            "is_integer"                    
#> [186,] "is_ldlt_factor"                    "is_less_or_equal"              
#> [187,] "is_lower_triangular"               "is_mat_finite"                 
#> [188,] "is_matching_dims"                  "is_matching_size"              
#> [189,] "is_nan"                            "is_nonpositive_integer"        
#> [190,] "is_nonzero_size"                   "is_not_nan"                    
#> [191,] "is_ordered"                        "is_pos_definite"               
#> [192,] "is_positive"                       "is_scal_finite"                
#> [193,] "is_size_match"                     "is_square"                     
#> [194,] "is_symmetric"                      "is_uninitialized"              
#> [195,] "is_unit_vector"                    "is_var"                        
#> [196,] "is_var_or_arithmetic"              "is_vector"                     
#> [197,] "is_vector_like"                    "lb_constrain"                  
#> [198,] "lb_free"                           "lbeta"                         
#> [199,] "ldexp"                             "length"                        
#> [200,] "length_mvt"                        "lgamma"                        
#> [201,] "likely"                            "lkj_corr_cholesky_log"         
#> [202,] "lkj_corr_cholesky_lpdf"            "lkj_corr_cholesky_rng"         
#> [203,] "lkj_corr_log"                      "lkj_corr_lpdf"                 
#> [204,] "lkj_corr_rng"                      "lkj_cov_log"                   
#> [205,] "lkj_cov_lpdf"                      "lmgamma"                       
#> [206,] "locscale_constrain"                "locscale_free"                 
#> [207,] "log"                               "log10"                         
#> [208,] "log1m"                             "log1m_exp"                     
#> [209,] "log1m_inv_logit"                   "log1p"                         
#> [210,] "log1p_exp"                         "log2"                          
#> [211,] "log_determinant"                   "log_determinant_ldlt"          
#> [212,] "log_determinant_spd"               "log_diff_exp"                  
#> [213,] "log_falling_factorial"             "log_inv_logit"                 
#> [214,] "log_inv_logit_diff"                "log_mix"                       
#> [215,] "log_modified_bessel_first_kind"    "log_rising_factorial"          
#> [216,] "log_softmax"                       "log_sum_exp"                   
#> [217,] "logical_and"                       "logical_eq"                    
#> [218,] "logical_gt"                        "logical_gte"                   
#> [219,] "logical_lt"                        "logical_lte"                   
#> [220,] "logical_negation"                  "logical_neq"                   
#> [221,] "logical_or"                        "logistic_ccdf_log"             
#> [222,] "logistic_cdf"                      "logistic_cdf_log"              
#> [223,] "logistic_lccdf"                    "logistic_lcdf"                 
#> [224,] "logistic_log"                      "logistic_lpdf"                 
#> [225,] "logistic_rng"                      "logit"                         
#> [226,] "lognormal_ccdf_log"                "lognormal_cdf"                 
#> [227,] "lognormal_cdf_log"                 "lognormal_lccdf"               
#> [228,] "lognormal_lcdf"                    "lognormal_log"                 
#> [229,] "lognormal_lpdf"                    "lognormal_rng"                 
#> [230,] "lub_constrain"                     "lub_free"                      
#> [231,] "make_nu"                           "map_rect"                      
#> [232,] "map_rect_combine"                  "map_rect_concurrent"           
#> [233,] "map_rect_mpi"                      "map_rect_reduce"               
#> [234,] "matrix_exp"                        "matrix_exp_2x2"                
#> [235,] "matrix_exp_action_handler"         "matrix_exp_multiply"           
#> [236,] "matrix_exp_pade"                   "matrix_normal_prec_log"        
#> [237,] "matrix_normal_prec_lpdf"           "matrix_normal_prec_rng"        
#> [238,] "max"                               "max_size"                      
#> [239,] "max_size_mvt"                      "mdivide_left"                  
#> [240,] "mdivide_left_ldlt"                 "mdivide_left_spd"              
#> [241,] "mdivide_left_tri"                  "mdivide_left_tri_low"          
#> [242,] "mdivide_right"                     "mdivide_right_ldlt"            
#> [243,] "mdivide_right_spd"                 "mdivide_right_tri"             
#> [244,] "mdivide_right_tri_low"             "mean"                          
#> [245,] "min"                               "minus"                         
#> [246,] "modified_bessel_first_kind"        "modified_bessel_second_kind"   
#> [247,] "modulus"                           "mpi_cluster"                   
#> [248,] "mpi_command"                       "mpi_distributed_apply"         
#> [249,] "mpi_parallel_call"                 "multi_gp_cholesky_log"         
#> [250,] "multi_gp_cholesky_lpdf"            "multi_gp_log"                  
#> [251,] "multi_gp_lpdf"                     "multi_normal_cholesky_log"     
#> [252,] "multi_normal_cholesky_lpdf"        "multi_normal_cholesky_rng"     
#> [253,] "multi_normal_log"                  "multi_normal_lpdf"             
#> [254,] "multi_normal_prec_log"             "multi_normal_prec_lpdf"        
#> [255,] "multi_normal_prec_rng"             "multi_normal_rng"              
#> [256,] "multi_student_t_log"               "multi_student_t_lpdf"          
#> [257,] "multi_student_t_rng"               "multinomial_log"               
#> [258,] "multinomial_lpmf"                  "multinomial_rng"               
#> [259,] "multiply"                          "multiply_log"                  
#> [260,] "multiply_lower_tri_self_transpose" "neg_binomial_2_ccdf_log"       
#> [261,] "neg_binomial_2_cdf"                "neg_binomial_2_cdf_log"        
#> [262,] "neg_binomial_2_lccdf"              "neg_binomial_2_lcdf"           
#> [263,] "neg_binomial_2_log"                "neg_binomial_2_log_glm_log"    
#> [264,] "neg_binomial_2_log_glm_lpmf"       "neg_binomial_2_log_log"        
#> [265,] "neg_binomial_2_log_lpmf"           "neg_binomial_2_log_rng"        
#> [266,] "neg_binomial_2_lpmf"               "neg_binomial_2_rng"            
#> [267,] "neg_binomial_ccdf_log"             "neg_binomial_cdf"              
#> [268,] "neg_binomial_cdf_log"              "neg_binomial_lccdf"            
#> [269,] "neg_binomial_lcdf"                 "neg_binomial_log"              
#> [270,] "neg_binomial_lpmf"                 "neg_binomial_rng"              
#> [271,] "normal_ccdf_log"                   "normal_cdf"                    
#> [272,] "normal_cdf_log"                    "normal_id_glm_log"             
#> [273,] "normal_id_glm_lpdf"                "normal_lccdf"                  
#> [274,] "normal_lcdf"                       "normal_log"                    
#> [275,] "normal_lpdf"                       "normal_rng"                    
#> [276,] "normal_sufficient_log"             "normal_sufficient_lpdf"        
#> [277,] "num_elements"                      "offset_multiplier_constrain"   
#> [278,] "offset_multiplier_free"            "operands_and_partials"         
#> [279,] "ordered_constrain"                 "ordered_free"                  
#> [280,] "ordered_logistic_glm_lpmf"         "ordered_logistic_log"          
#> [281,] "ordered_logistic_lpmf"             "ordered_logistic_rng"          
#> [282,] "ordered_probit_log"                "ordered_probit_lpmf"           
#> [283,] "ordered_probit_rng"                "out_of_range"                  
#> [284,] "owens_t"                           "pareto_ccdf_log"               
#> [285,] "pareto_cdf"                        "pareto_cdf_log"                
#> [286,] "pareto_lccdf"                      "pareto_lcdf"                   
#> [287,] "pareto_log"                        "pareto_lpdf"                   
#> [288,] "pareto_rng"                        "pareto_type_2_ccdf_log"        
#> [289,] "pareto_type_2_cdf"                 "pareto_type_2_cdf_log"         
#> [290,] "pareto_type_2_lccdf"               "pareto_type_2_lcdf"            
#> [291,] "pareto_type_2_log"                 "pareto_type_2_lpdf"            
#> [292,] "pareto_type_2_rng"                 "partials_return_type"          
#> [293,] "partials_type"                     "poisson_ccdf_log"              
#> [294,] "poisson_cdf"                       "poisson_cdf_log"               
#> [295,] "poisson_lccdf"                     "poisson_lcdf"                  
#> [296,] "poisson_log"                       "poisson_log_glm_log"           
#> [297,] "poisson_log_glm_lpmf"              "poisson_log_log"               
#> [298,] "poisson_log_lpmf"                  "poisson_log_rng"               
#> [299,] "poisson_lpmf"                      "poisson_rng"                   
#> [300,] "positive_constrain"                "positive_free"                 
#> [301,] "positive_ordered_constrain"        "positive_ordered_free"         
#> [302,] "primitive_value"                   "prob_constrain"                
#> [303,] "prob_free"                         "prod"                          
#> [304,] "promote_args"                      "promote_common"                
#> [305,] "promote_elements"                  "promote_scalar"                
#> [306,] "promote_scalar_type"               "qr_Q"                          
#> [307,] "qr_R"                              "qr_thin_Q"                     
#> [308,] "qr_thin_R"                         "quad_form"                     
#> [309,] "quad_form_diag"                    "quad_form_sym"                 
#> [310,] "rank"                              "rayleigh_ccdf_log"             
#> [311,] "rayleigh_cdf"                      "rayleigh_cdf_log"              
#> [312,] "rayleigh_lccdf"                    "rayleigh_lcdf"                 
#> [313,] "rayleigh_log"                      "rayleigh_lpdf"                 
#> [314,] "rayleigh_rng"                      "read_corr_L"                   
#> [315,] "read_corr_matrix"                  "read_cov_L"                    
#> [316,] "read_cov_matrix"                   "rep_array"                     
#> [317,] "rep_matrix"                        "rep_row_vector"                
#> [318,] "rep_vector"                        "require_generics"              
#> [319,] "resize"                            "return_type"                   
#> [320,] "rising_factorial"                  "round"                         
#> [321,] "row"                               "rows"                          
#> [322,] "rows_dot_product"                  "rows_dot_self"                 
#> [323,] "scalar_seq_view"                   "scalar_type"                   
#> [324,] "scalar_type_pre"                   "scale_matrix_exp_multiply"     
#> [325,] "scaled_add"                        "scaled_inv_chi_square_ccdf_log"
#> [326,] "scaled_inv_chi_square_cdf"         "scaled_inv_chi_square_cdf_log" 
#> [327,] "scaled_inv_chi_square_lccdf"       "scaled_inv_chi_square_lcdf"    
#> [328,] "scaled_inv_chi_square_log"         "scaled_inv_chi_square_lpdf"    
#> [329,] "scaled_inv_chi_square_rng"         "sd"                            
#> [330,] "segment"                           "seq_view"                      
#> [331,] "sign"                              "simplex_constrain"             
#> [332,] "simplex_free"                      "sin"                           
#> [333,] "singular_values"                   "sinh"                          
#> [334,] "size"                              "size_of"                       
#> [335,] "size_zero"                         "skew_normal_ccdf_log"          
#> [336,] "skew_normal_cdf"                   "skew_normal_cdf_log"           
#> [337,] "skew_normal_lccdf"                 "skew_normal_lcdf"              
#> [338,] "skew_normal_log"                   "skew_normal_lpdf"              
#> [339,] "skew_normal_rng"                   "softmax"                       
#> [340,] "sort_asc"                          "sort_desc"                     
#> [341,] "sort_indices"                      "sort_indices_asc"              
#> [342,] "sort_indices_desc"                 "sqrt"                          
#> [343,] "square"                            "squared_distance"              
#> [344,] "stan_print"                        "std_normal_log"                
#> [345,] "std_normal_lpdf"                   "step"                          
#> [346,] "student_t_ccdf_log"                "student_t_cdf"                 
#> [347,] "student_t_cdf_log"                 "student_t_lccdf"               
#> [348,] "student_t_lcdf"                    "student_t_log"                 
#> [349,] "student_t_lpdf"                    "student_t_rng"                 
#> [350,] "sub"                               "sub_col"                       
#> [351,] "sub_row"                           "subtract"                      
#> [352,] "sum"                               "system_error"                  
#> [353,] "tail"                              "tan"                           
#> [354,] "tanh"                              "tcrossprod"                    
#> [355,] "tgamma"                            "to_array_1d"                   
#> [356,] "to_array_2d"                       "to_matrix"                     
#> [357,] "to_row_vector"                     "to_vector"                     
#> [358,] "trace"                             "trace_gen_inv_quad_form_ldlt"  
#> [359,] "trace_gen_quad_form"               "trace_inv_quad_form_ldlt"      
#> [360,] "trace_quad_form"                   "transpose"                     
#> [361,] "trigamma"                          "trunc"                         
#> [362,] "typedefs"                          "ub_constrain"                  
#> [363,] "ub_free"                           "uniform_ccdf_log"              
#> [364,] "uniform_cdf"                       "uniform_cdf_log"               
#> [365,] "uniform_lccdf"                     "uniform_lcdf"                  
#> [366,] "uniform_log"                       "uniform_lpdf"                  
#> [367,] "uniform_rng"                       "unit_vector_constrain"         
#> [368,] "unit_vector_free"                  "validate_non_negative_index"   
#> [369,] "value_of"                          "value_of_rec"                  
#> [370,] "value_type"                        "variance"                      
#> [371,] "vec_concat"                        "vector_seq_view"               
#> [372,] "von_mises_log"                     "von_mises_lpdf"                
#> [373,] "von_mises_rng"                     "weibull_ccdf_log"              
#> [374,] "weibull_cdf"                       "weibull_cdf_log"               
#> [375,] "weibull_lccdf"                     "weibull_lcdf"                  
#> [376,] "weibull_log"                       "weibull_lpdf"                  
#> [377,] "weibull_rng"                       "welford_covar_estimator"       
#> [378,] "welford_var_estimator"             "wiener_log"                    
#> [379,] "wiener_lpdf"                       "wishart_log"                   
#> [380,] "wishart_lpdf"                      "wishart_rng"

Using Higher-Order Functions in the StanHeaders Package

This section will demonstrate how to use some of the C++ functions in the StanHeaders package whose first argument is another C++ function, in which case the stanFunction in the previous section will not work and you have to write your own C++.

Derivatives and Minimization

The following is a toy example of using the Stan Math library via Rcpp::sourceCpp: to minimize the function \[\left(\mathbf{x} - \mathbf{a}\right)^\top \left(\mathbf{x} - \mathbf{a}\right)\] which has a global minimum when \(\mathbf{x} = \mathbf{a}\). To find this minimum with autodifferentiation, we need to define the objective function. Then, its gradient with respect to \(\mathbf{x}\), which we know is \(2\left(\mathbf{x} - \mathbf{a}\right)\) in this case, can be calculated by autodifferentiation. At the optimum (or on the way to the optimum), we might want to evaluate the Hessian matrix, which we know is \(2\mathbf{I}\), but would need an additional function to evaluate it via autodifferentiation. Finally, one could reconceptualize the problem as solving a homogeneous system of equations where the gradient is set equal to a vector of zeros. The stan::math::algebra_solver function can solve such a system using autodifferentiation to obtain the Jacobian, which we know to be the identity matrix in this case.

Here is C++ code that does all of the above, except for the part of finding the optimum, which is done using the R function optim below.

// [[Rcpp::depends(BH)]]
// [[Rcpp::depends(RcppEigen)]]
// [[Rcpp::depends(RcppParallel)]]
// [[Rcpp::depends(StanHeaders)]]
#include <stan/math/fwd/mat/fun/dot_self.hpp>    // stuff from fwd/ must come first
#include <stan/math/mix/mat/functor/hessian.hpp> // then stuff from mix/ must come next
#include <stan/math.hpp>                         // finally pull in everything from rev/ & prim/
#include <Rcpp.h>
#include <RcppEigen.h>                           // do this AFTER including stan/math

// [[Rcpp::plugins(cpp14)]]

/* Objective function */

// [[Rcpp::export]]
auto f(Eigen::VectorXd x, Eigen::VectorXd a) { // objective function in doubles
  using stan::math::dot_self;                  // dot_self() is a dot product with self
  return dot_self( (x - a).eval() );           // .eval() yields a Eigen::VectorXd
}

/* Gradient */

// [[Rcpp::export]]
auto g(Eigen::VectorXd x, Eigen::VectorXd a) {  // gradient by AD using Stan
  double fx;
  Eigen::VectorXd grad_fx;
  using stan::math::dot_self;
  stan::math::gradient([&a](auto x) { return dot_self( (x - a).eval() ); },
                       x, fx, grad_fx);
  return grad_fx;
}

/* Hessian */

// [[Rcpp::export]]
auto H(Eigen::VectorXd x, Eigen::VectorXd a) { // Hessian by AD using Stan
  double fx;
  Eigen::VectorXd grad_fx;
  Eigen::MatrixXd H;
  using stan::math::dot_self;
  using stan::math::subtract; // necessary to get the type promotion correct
  stan::math::hessian([&a](auto x) { return dot_self(subtract(x, a)); },
                      x, fx, grad_fx, H);
  return H;
}

/* Jacobian */

// [[Rcpp::export]]
auto J(Eigen::VectorXd x, Eigen::VectorXd a) { // not actually used
  Eigen::VectorXd fx;
  Eigen::MatrixXd J;
  using stan::math::dot_self;
  stan::math::jacobian([&a](auto x) {
    return (2 * (x - a)).eval();
  }, x, fx, J);
  return J;
}

struct equations_functor {
  template <typename T0, typename T1>
  inline Eigen::Matrix<T0, Eigen::Dynamic, 1>
  operator()(const Eigen::Matrix<T0, Eigen::Dynamic, 1>& x,
             const Eigen::Matrix<T1, Eigen::Dynamic, 1>& theta,
             const std::vector<double>& x_r, const std::vector<int>& x_i,
             std::ostream* pstream__) const {
    return 2 * (x - stan::math::to_vector(x_r)).eval();
  }
};

// [[Rcpp::export]]
auto solution(Eigen::VectorXd a, Eigen::VectorXd guess) {
  Eigen::VectorXd theta;
  auto x_r = stan::math::to_array_1d(a);
  equations_functor f;
  auto x = stan::math::algebra_solver(f, guess, theta, x_r, {});
  return x;
}

In this compiled RMarkdown document, the knitr package has exported functions f, g, H, J and solution (but not equations_functor) to R’s global environment using the sourceCpp function in the Rcpp package, so that they can now be called from R. Here we find the optimum starting from a random point in three dimensions:

Integrals and Ordinary Differential Equations

The Stan Math library can do one-dimensional numerical integration and can solve stiff and non-stiff systems of differential equations, such as the harmonic oscillator example below. Solving stiff systems utilizes the CVODES library, which is included in StanHeaders.

// [[Rcpp::depends(BH)]]
// [[Rcpp::depends(RcppEigen)]]
// [[Rcpp::depends(RcppParallel)]]
// [[Rcpp::depends(StanHeaders)]]
#include <stan/math.hpp>                         // pulls in everything from rev/ and prim/
#include <Rcpp.h>
#include <RcppEigen.h>                           // do this AFTER including stan/math

// [[Rcpp::plugins(cpp14)]]

/* Definite integrals */

// [[Rcpp::export]]
double Cauchy(double scale) {
  std::vector<double> theta;
  auto half = stan::math::integrate_1d([](auto x, auto xc, auto theta,
                                          auto x_r, auto x_i, auto msgs) {
    return exp(stan::math::cauchy_lpdf(x, 0, x_r[0]));
  }, -scale, scale, theta, {scale}, {}, Rcpp::Rcout, 1e-7);
  return half * 2; // should equal 1 for any positive scale
}

/* Ordinary Differential Equations */

// [[Rcpp::export]]
auto nonstiff(Eigen::MatrixXd A, Eigen::VectorXd y0) {
  using stan::math::integrate_ode_rk45;
  using stan::math::to_vector;
  using stan::math::to_array_1d;
  std::vector<double> theta;
  std::vector<double> times = {1, 2};
  auto y = integrate_ode_rk45([&A](auto t, auto y, 
                                   auto theta, auto x_r, auto x_i, std::ostream *msgs) {
    return to_array_1d( (A * to_vector(y)).eval() );
  }, to_array_1d(y0), 0, times, theta, {}, {});
  Eigen::VectorXd truth = stan::math::matrix_exp(A) * y0;
  return (to_vector(y[0]) - truth).eval(); // should be "zero"
}

// [[Rcpp::export]]
auto stiff(Eigen::MatrixXd A, Eigen::VectorXd y0) { // not actually stiff
  using stan::math::integrate_ode_bdf;              // but use the stiff solver anyways
  using stan::math::to_vector;
  using stan::math::to_array_1d;
  std::vector<double> theta;
  std::vector<double> times = {1, 2};
  auto y = integrate_ode_bdf([&A](auto t, auto y, 
                                  auto theta, auto x_r, auto x_i, std::ostream *msgs) {
    return to_array_1d( (A * to_vector(y)).eval() );
  }, to_array_1d(y0), 0, times, theta, {}, {});
  Eigen::VectorXd truth = stan::math::matrix_exp(A) * y0;
  return (to_vector(y[0]) - truth).eval(); // should be "zero"
}

Again, in this compiled RMarkdown document, the knitr package has exported the Cauchy, nonstiff and stiff functions to R’s global environment using the sourceCpp function in the Rcpp package so that they can be called from R.

First, we numerically integrate the Cauchy PDF over its interquartile range — which has an area of \(\frac{1}{2}\) — that we then double to verify that it is almost within machine precision of \(1\).

Next, we consider the system of differential equations \[\frac{d}{dt}\mathbf{y} = \mathbf{A}\mathbf{y}\] where \(\mathbf{A}\) is a square matrix such as that for a simple harmonic oscillator

\[\mathbf{A} = \begin{bmatrix}0 & 1 \\ -1 & -\theta\end{bmatrix}\] for \(\theta \in \left(0,1\right)\). The solution for \(\mathbf{y}_t = e^{t\mathbf{A}}\mathbf{y}_0\) can be obtained via the matrix exponential function, which is available in the Stan Math Library, but it can also be obtained numerically using a fourth-order Runge-Kutta solver, which is appropriate for non-stiff systems of ODEs, such as this one. However, it is possible, albeit less efficient in this case, to use the backward-differentiation formula solver for stiff systems of ODEs. In both cases, we calculate the difference between the analytical solution and the numerical one, and the stiff version does produce somewhat better accuracy in this case.

Map and Parellelization

The Stan Math Library includes the map_rect function, which applies a function to each element of rectangular arrays and returns a vector, making it a bit like a restricted version of R’s sapply function. However, map_rect can also be executed in parallel by defining the pre-processor directive STAN_THREADS and then setting the STAN_NUM_THREADS environmental variable to be the number of threads to use, as in

Below is C++ code to test whether an integer is prime, using a rather brute-force algorithm and running it in parallel via map_rect.

Since the signature for n is a std::vector<std::vector<int> >, we have to pass it from R as a list (which is converted to the outer std::vector<>) of integer vectors (which is converted to the inner std::vector<int>) that happen to be of size one in this case.

Thus, \(2^{26} - 5 = 67,108,859\) is a prime number.

Defining a Stan Model in C++

The Stan language does not have much support for sparse matrices for a variety of reasons. Essentially the only applicable function is csr_matrix_times_vector, which pre-multiplies a vector by a sparse matrix in compressed row storage by taking as arguments its number of rows, columns, non-zero values, column indices of non-zero values, and locations where the non-zero values start in each row. While the csr_matrix_times_vector function could be used to implement the example below, we illustrate how to use the sparse data structures in the Matrix and RcppEigen packages in a Stan model written in C++, which could easily be extended to more complicated models with sparse data structures.

Our C++ file for the log-likelihood of a linear model with a sparse design matrix reads as

#include <stan/model/model_header.hpp>
#include <Rcpp.h>
#include <RcppEigen.h>

class sparselm_stan {

public: // these would ordinarily be private in the C++ code generated by Stan
  Eigen::Map<Eigen::SparseMatrix<double> > X;
  Eigen::VectorXd y;

  sparselm_stan(Eigen::Map<Eigen::SparseMatrix<double> > X, Eigen::VectorXd y) :
    X(X), y(y) {}

  template <bool propto__ = false, bool jacobian__ = false, typename T__ = double>
  // propto__ is usually true but causes log_prob() to return 0 when called from R
  // jacobian__ is usually true for MCMC but typically is false for optimization
  T__ log_prob(std::vector<T__>& params_r__) const {
    using namespace stan::math;
    T__ lp__(0.0);
    accumulator<T__> lp_accum__;

    // set up model parameters
    std::vector<int> params_i__;
    stan::io::reader<T__> in__(params_r__, params_i__);
    auto beta = in__.vector_constrain(X.cols());
    T__ sigma;
    if (jacobian__) sigma = in__.scalar_lb_constrain(0, lp__);
    else sigma = in__.scalar_lb_constrain(0);

    // log-likelihood (should add priors)
    lp_accum__.add(lp__);
    lp_accum__.add(normal_lpdf<propto__>(y, (X * beta).eval(), sigma));
    return lp_accum__.sum();
  }

  template <bool propto__ = false, bool jacobian__ = false>
  std::vector<double> gradient(std::vector<double>& params_r__) const {
    // Calculate gradients using reverse-mode autodiff
    // although you could do them analytically in this case

    using std::vector;
    using stan::math::var;
    double lp;
    std::vector<double> gradient;
    try {
      vector<var> ad_params_r(params_r__.size());
      for (size_t i = 0; i < params_r__.size(); ++i) {
        var var_i(params_r__[i]);
        ad_params_r[i] = var_i;
      }
      var adLogProb
        = this->log_prob<propto__, jacobian__>(ad_params_r);
      lp = adLogProb.val();
      adLogProb.grad(ad_params_r, gradient);
    } catch (const std::exception &ex) {
      stan::math::recover_memory();
      throw;
    }
    stan::math::recover_memory();
    return gradient;
  }
};

To use it from R, we call the exposeClass function in the Rcpp package with the necessary arguments and then call sourceCpp on the file it wrote in the temporary directory:

At this point, we need a sparse design matrix and (dense) outcome vector to pass to the constructor. The former can be created with a variety of functions in the Matrix package, such as

Finally, we call the new function in the methods package, which essentially calls our C++ constructor and provides an R interface to the instantiated object, which contains the log_prob and gradient methods we defined and can be called with arbitrary inputs.

StanHeaders/inst/doc/sparselm_stan.hpp0000644000176200001440000000400413447465733017577 0ustar liggesusers#include #include #include class sparselm_stan { public: // these would ordinarily be private in the C++ code generated by Stan Eigen::Map > X; Eigen::VectorXd y; sparselm_stan(Eigen::Map > X, Eigen::VectorXd y) : X(X), y(y) {} template // propto__ is usually true but causes log_prob() to return 0 when called from R // jacobian__ is usually true for MCMC but typically is false for optimization T__ log_prob(std::vector& params_r__) const { using namespace stan::math; T__ lp__(0.0); accumulator lp_accum__; // set up model parameters std::vector params_i__; stan::io::reader in__(params_r__, params_i__); auto beta = in__.vector_constrain(X.cols()); T__ sigma; if (jacobian__) sigma = in__.scalar_lb_constrain(0, lp__); else sigma = in__.scalar_lb_constrain(0); // log-likelihood (should add priors) lp_accum__.add(lp__); lp_accum__.add(normal_lpdf(y, (X * beta).eval(), sigma)); return lp_accum__.sum(); } template std::vector gradient(std::vector& params_r__) const { // Calculate gradients using reverse-mode autodiff // although you could do them analytically in this case using std::vector; using stan::math::var; double lp; std::vector gradient; try { vector ad_params_r(params_r__.size()); for (size_t i = 0; i < params_r__.size(); ++i) { var var_i(params_r__[i]); ad_params_r[i] = var_i; } var adLogProb = this->log_prob(ad_params_r); lp = adLogProb.val(); adLogProb.grad(ad_params_r, gradient); } catch (const std::exception &ex) { stan::math::recover_memory(); throw; } stan::math::recover_memory(); return gradient; } }; StanHeaders/inst/include/0000755000176200001440000000000013766554465015100 5ustar liggesusersStanHeaders/inst/include/cvodes/0000755000176200001440000000000013766554135016355 5ustar liggesusersStanHeaders/inst/include/cvodes/cvodes_direct.h0000644000176200001440000000425313766554457021356 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated direct linear solver interface in * CVODES; these routines now just wrap the updated CVODE generic * linear solver interface in cvodes_ls.h. * -----------------------------------------------------------------*/ #ifndef _CVSDLS_H #define _CVSDLS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Function Types (typedefs for equivalent types in cvodes_ls.h) =================================================================*/ typedef CVLsJacFn CVDlsJacFn; typedef CVLsJacFnB CVDlsJacFnB; typedef CVLsJacFnBS CVDlsJacFnBS; /*==================================================================== Exported Functions (wrappers for equivalent routines in cvodes_ls.h) ====================================================================*/ int CVDlsSetLinearSolver(void *cvode_mem, SUNLinearSolver LS, SUNMatrix A); int CVDlsSetJacFn(void *cvode_mem, CVDlsJacFn jac); int CVDlsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); int CVDlsGetNumJacEvals(void *cvode_mem, long int *njevals); int CVDlsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); int CVDlsGetLastFlag(void *cvode_mem, long int *flag); char *CVDlsGetReturnFlagName(long int flag); int CVDlsSetLinearSolverB(void *cvode_mem, int which, SUNLinearSolver LS, SUNMatrix A); int CVDlsSetJacFnB(void *cvode_mem, int which, CVDlsJacFnB jacB); int CVDlsSetJacFnBS(void *cvode_mem, int which, CVDlsJacFnBS jacBS); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/cvodes/cvodes_bandpre.h0000644000176200001440000000343713766554457021522 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the CVBANDPRE module, which provides * a banded difference quotient Jacobian-based preconditioner. * -----------------------------------------------------------------*/ #ifndef _CVSBANDPRE_H #define _CVSBANDPRE_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------- FORWARD PROBLEMS -----------------*/ /* BandPrec inititialization function */ SUNDIALS_EXPORT int CVBandPrecInit(void *cvode_mem, sunindextype N, sunindextype mu, sunindextype ml); /* Optional output functions */ SUNDIALS_EXPORT int CVBandPrecGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVBandPrecGetNumRhsEvals(void *cvode_mem, long int *nfevalsBP); /*------------------ BACKWARD PROBLEMS ------------------*/ SUNDIALS_EXPORT int CVBandPrecInitB(void *cvode_mem, int which, sunindextype nB, sunindextype muB, sunindextype mlB); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/cvodes/cvodes_bbdpre.h0000644000176200001440000000605613766554457021345 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the CVBBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks. * -----------------------------------------------------------------*/ #ifndef _CVSBBDPRE_H #define _CVSBBDPRE_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------- FORWARD PROBLEMS -----------------*/ /* User-supplied function Types */ typedef int (*CVLocalFn)(sunindextype Nlocal, realtype t, N_Vector y, N_Vector g, void *user_data); typedef int (*CVCommFn)(sunindextype Nlocal, realtype t, N_Vector y, void *user_data); /* Exported Functions */ SUNDIALS_EXPORT int CVBBDPrecInit(void *cvode_mem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dqrely, CVLocalFn gloc, CVCommFn cfn); SUNDIALS_EXPORT int CVBBDPrecReInit(void *cvode_mem, sunindextype mudq, sunindextype mldq, realtype dqrely); /* Optional output functions */ SUNDIALS_EXPORT int CVBBDPrecGetWorkSpace(void *cvode_mem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int CVBBDPrecGetNumGfnEvals(void *cvode_mem, long int *ngevalsBBDP); /*------------------ BACKWARD PROBLEMS ------------------*/ /* User-Supplied Function Types */ typedef int (*CVLocalFnB)(sunindextype NlocalB, realtype t, N_Vector y, N_Vector yB, N_Vector gB, void *user_dataB); typedef int (*CVCommFnB)(sunindextype NlocalB, realtype t, N_Vector y, N_Vector yB, void *user_dataB); /* Exported Functions */ SUNDIALS_EXPORT int CVBBDPrecInitB(void *cvode_mem, int which, sunindextype NlocalB, sunindextype mudqB, sunindextype mldqB, sunindextype mukeepB, sunindextype mlkeepB, realtype dqrelyB, CVLocalFnB glocB, CVCommFnB cfnB); SUNDIALS_EXPORT int CVBBDPrecReInitB(void *cvode_mem, int which, sunindextype mudqB, sunindextype mldqB, realtype dqrelyB); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/cvodes/cvodes_diag.h0000644000176200001440000000401713766554457021006 0ustar liggesusers/* --------------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * --------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * --------------------------------------------------------------------- * This is the header file for the CVODE diagonal linear solver, CVDIAG. * ---------------------------------------------------------------------*/ #ifndef _CVSDIAG_H #define _CVSDIAG_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* --------------------- * CVDIAG return values * --------------------- */ #define CVDIAG_SUCCESS 0 #define CVDIAG_MEM_NULL -1 #define CVDIAG_LMEM_NULL -2 #define CVDIAG_ILL_INPUT -3 #define CVDIAG_MEM_FAIL -4 /* Additional last_flag values */ #define CVDIAG_INV_FAIL -5 #define CVDIAG_RHSFUNC_UNRECVR -6 #define CVDIAG_RHSFUNC_RECVR -7 /* Return values for adjoint module */ #define CVDIAG_NO_ADJ -101 /* ----------------- * Forward Problems * ----------------- */ /* CVDiag initialization function */ SUNDIALS_EXPORT int CVDiag(void *cvode_mem); /* Optional output functions */ SUNDIALS_EXPORT int CVDiagGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVDiagGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVDiagGetLastFlag(void *cvode_mem, long int *flag); SUNDIALS_EXPORT char *CVDiagGetReturnFlagName(long int flag); /* ------------------------------------- * Backward Problems - Function CVDiagB * ------------------------------------- */ SUNDIALS_EXPORT int CVDiagB(void *cvode_mem, int which); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/cvodes/cvodes.h0000644000176200001440000006104413766554457020025 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the main CVODES integrator. * -----------------------------------------------------------------*/ #ifndef _CVODES_H #define _CVODES_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ----------------- * CVODES Constants * ----------------- */ /* lmm */ #define CV_ADAMS 1 #define CV_BDF 2 /* itask */ #define CV_NORMAL 1 #define CV_ONE_STEP 2 /* ism */ #define CV_SIMULTANEOUS 1 #define CV_STAGGERED 2 #define CV_STAGGERED1 3 /* DQtype */ #define CV_CENTERED 1 #define CV_FORWARD 2 /* interp */ #define CV_HERMITE 1 #define CV_POLYNOMIAL 2 /* return values */ #define CV_SUCCESS 0 #define CV_TSTOP_RETURN 1 #define CV_ROOT_RETURN 2 #define CV_WARNING 99 #define CV_TOO_MUCH_WORK -1 #define CV_TOO_MUCH_ACC -2 #define CV_ERR_FAILURE -3 #define CV_CONV_FAILURE -4 #define CV_LINIT_FAIL -5 #define CV_LSETUP_FAIL -6 #define CV_LSOLVE_FAIL -7 #define CV_RHSFUNC_FAIL -8 #define CV_FIRST_RHSFUNC_ERR -9 #define CV_REPTD_RHSFUNC_ERR -10 #define CV_UNREC_RHSFUNC_ERR -11 #define CV_RTFUNC_FAIL -12 #define CV_NLS_INIT_FAIL -13 #define CV_NLS_SETUP_FAIL -14 #define CV_CONSTR_FAIL -15 #define CV_MEM_FAIL -20 #define CV_MEM_NULL -21 #define CV_ILL_INPUT -22 #define CV_NO_MALLOC -23 #define CV_BAD_K -24 #define CV_BAD_T -25 #define CV_BAD_DKY -26 #define CV_TOO_CLOSE -27 #define CV_VECTOROP_ERR -28 #define CV_NO_QUAD -30 #define CV_QRHSFUNC_FAIL -31 #define CV_FIRST_QRHSFUNC_ERR -32 #define CV_REPTD_QRHSFUNC_ERR -33 #define CV_UNREC_QRHSFUNC_ERR -34 #define CV_NO_SENS -40 #define CV_SRHSFUNC_FAIL -41 #define CV_FIRST_SRHSFUNC_ERR -42 #define CV_REPTD_SRHSFUNC_ERR -43 #define CV_UNREC_SRHSFUNC_ERR -44 #define CV_BAD_IS -45 #define CV_NO_QUADSENS -50 #define CV_QSRHSFUNC_FAIL -51 #define CV_FIRST_QSRHSFUNC_ERR -52 #define CV_REPTD_QSRHSFUNC_ERR -53 #define CV_UNREC_QSRHSFUNC_ERR -54 /* adjoint return values */ #define CV_NO_ADJ -101 #define CV_NO_FWD -102 #define CV_NO_BCK -103 #define CV_BAD_TB0 -104 #define CV_REIFWD_FAIL -105 #define CV_FWD_FAIL -106 #define CV_GETY_BADT -107 /* ------------------------------ * User-Supplied Function Types * ------------------------------ */ typedef int (*CVRhsFn)(realtype t, N_Vector y, N_Vector ydot, void *user_data); typedef int (*CVRootFn)(realtype t, N_Vector y, realtype *gout, void *user_data); typedef int (*CVEwtFn)(N_Vector y, N_Vector ewt, void *user_data); typedef void (*CVErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); typedef int (*CVQuadRhsFn)(realtype t, N_Vector y, N_Vector yQdot, void *user_data); typedef int (*CVSensRhsFn)(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector *yS, N_Vector *ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); typedef int (*CVSensRhs1Fn)(int Ns, realtype t, N_Vector y, N_Vector ydot, int iS, N_Vector yS, N_Vector ySdot, void *user_data, N_Vector tmp1, N_Vector tmp2); typedef int (*CVQuadSensRhsFn)(int Ns, realtype t, N_Vector y, N_Vector *yS, N_Vector yQdot, N_Vector *yQSdot, void *user_data, N_Vector tmp, N_Vector tmpQ); typedef int (*CVRhsFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector yBdot, void *user_dataB); typedef int (*CVRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector yBdot, void *user_dataB); typedef int (*CVQuadRhsFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector qBdot, void *user_dataB); typedef int (*CVQuadRhsFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector qBdot, void *user_dataB); /* --------------------------------------- * Exported Functions -- Forward Problems * --------------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT void *CVodeCreate(int lmm); SUNDIALS_EXPORT int CVodeInit(void *cvode_mem, CVRhsFn f, realtype t0, N_Vector y0); SUNDIALS_EXPORT int CVodeReInit(void *cvode_mem, realtype t0, N_Vector y0); /* Tolerance input functions */ SUNDIALS_EXPORT int CVodeSStolerances(void *cvode_mem, realtype reltol, realtype abstol); SUNDIALS_EXPORT int CVodeSVtolerances(void *cvode_mem, realtype reltol, N_Vector abstol); SUNDIALS_EXPORT int CVodeWFtolerances(void *cvode_mem, CVEwtFn efun); /* Optional input functions */ SUNDIALS_EXPORT int CVodeSetErrHandlerFn(void *cvode_mem, CVErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int CVodeSetErrFile(void *cvode_mem, FILE *errfp); SUNDIALS_EXPORT int CVodeSetUserData(void *cvode_mem, void *user_data); SUNDIALS_EXPORT int CVodeSetMaxOrd(void *cvode_mem, int maxord); SUNDIALS_EXPORT int CVodeSetMaxNumSteps(void *cvode_mem, long int mxsteps); SUNDIALS_EXPORT int CVodeSetMaxHnilWarns(void *cvode_mem, int mxhnil); SUNDIALS_EXPORT int CVodeSetStabLimDet(void *cvode_mem, booleantype stldet); SUNDIALS_EXPORT int CVodeSetInitStep(void *cvode_mem, realtype hin); SUNDIALS_EXPORT int CVodeSetMinStep(void *cvode_mem, realtype hmin); SUNDIALS_EXPORT int CVodeSetMaxStep(void *cvode_mem, realtype hmax); SUNDIALS_EXPORT int CVodeSetStopTime(void *cvode_mem, realtype tstop); SUNDIALS_EXPORT int CVodeSetMaxErrTestFails(void *cvode_mem, int maxnef); SUNDIALS_EXPORT int CVodeSetMaxNonlinIters(void *cvode_mem, int maxcor); SUNDIALS_EXPORT int CVodeSetMaxConvFails(void *cvode_mem, int maxncf); SUNDIALS_EXPORT int CVodeSetNonlinConvCoef(void *cvode_mem, realtype nlscoef); SUNDIALS_EXPORT int CVodeSetConstraints(void *cvode_mem, N_Vector constraints); SUNDIALS_EXPORT int CVodeSetNonlinearSolver(void *cvode_mem, SUNNonlinearSolver NLS); /* Rootfinding initialization function */ SUNDIALS_EXPORT int CVodeRootInit(void *cvode_mem, int nrtfn, CVRootFn g); /* Rootfinding optional input functions */ SUNDIALS_EXPORT int CVodeSetRootDirection(void *cvode_mem, int *rootdir); SUNDIALS_EXPORT int CVodeSetNoInactiveRootWarn(void *cvode_mem); /* Solver function */ SUNDIALS_EXPORT int CVode(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask); /* Dense output function */ SUNDIALS_EXPORT int CVodeGetDky(void *cvode_mem, realtype t, int k, N_Vector dky); /* Optional output functions */ SUNDIALS_EXPORT int CVodeGetWorkSpace(void *cvode_mem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int CVodeGetNumSteps(void *cvode_mem, long int *nsteps); SUNDIALS_EXPORT int CVodeGetNumRhsEvals(void *cvode_mem, long int *nfevals); SUNDIALS_EXPORT int CVodeGetNumLinSolvSetups(void *cvode_mem, long int *nlinsetups); SUNDIALS_EXPORT int CVodeGetNumErrTestFails(void *cvode_mem, long int *netfails); SUNDIALS_EXPORT int CVodeGetLastOrder(void *cvode_mem, int *qlast); SUNDIALS_EXPORT int CVodeGetCurrentOrder(void *cvode_mem, int *qcur); SUNDIALS_EXPORT int CVodeGetNumStabLimOrderReds(void *cvode_mem, long int *nslred); SUNDIALS_EXPORT int CVodeGetActualInitStep(void *cvode_mem, realtype *hinused); SUNDIALS_EXPORT int CVodeGetLastStep(void *cvode_mem, realtype *hlast); SUNDIALS_EXPORT int CVodeGetCurrentStep(void *cvode_mem, realtype *hcur); SUNDIALS_EXPORT int CVodeGetCurrentTime(void *cvode_mem, realtype *tcur); SUNDIALS_EXPORT int CVodeGetTolScaleFactor(void *cvode_mem, realtype *tolsfac); SUNDIALS_EXPORT int CVodeGetErrWeights(void *cvode_mem, N_Vector eweight); SUNDIALS_EXPORT int CVodeGetEstLocalErrors(void *cvode_mem, N_Vector ele); SUNDIALS_EXPORT int CVodeGetNumGEvals(void *cvode_mem, long int *ngevals); SUNDIALS_EXPORT int CVodeGetRootInfo(void *cvode_mem, int *rootsfound); SUNDIALS_EXPORT int CVodeGetIntegratorStats(void *cvode_mem, long int *nsteps, long int *nfevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur); SUNDIALS_EXPORT int CVodeGetNumNonlinSolvIters(void *cvode_mem, long int *nniters); SUNDIALS_EXPORT int CVodeGetNumNonlinSolvConvFails(void *cvode_mem, long int *nncfails); SUNDIALS_EXPORT int CVodeGetNonlinSolvStats(void *cvode_mem, long int *nniters, long int *nncfails); SUNDIALS_EXPORT char *CVodeGetReturnFlagName(long int flag); /* Free function */ SUNDIALS_EXPORT void CVodeFree(void **cvode_mem); /* --------------------------------- * Exported Functions -- Quadrature * --------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT int CVodeQuadInit(void *cvode_mem, CVQuadRhsFn fQ, N_Vector yQ0); SUNDIALS_EXPORT int CVodeQuadReInit(void *cvode_mem, N_Vector yQ0); /* Tolerance input functions */ SUNDIALS_EXPORT int CVodeQuadSStolerances(void *cvode_mem, realtype reltolQ, realtype abstolQ); SUNDIALS_EXPORT int CVodeQuadSVtolerances(void *cvode_mem, realtype reltolQ, N_Vector abstolQ); /* Optional input specification functions */ SUNDIALS_EXPORT int CVodeSetQuadErrCon(void *cvode_mem, booleantype errconQ); /* Extraction and Dense Output Functions for Forward Problems */ SUNDIALS_EXPORT int CVodeGetQuad(void *cvode_mem, realtype *tret, N_Vector yQout); SUNDIALS_EXPORT int CVodeGetQuadDky(void *cvode_mem, realtype t, int k, N_Vector dky); /* Optional output specification functions */ SUNDIALS_EXPORT int CVodeGetQuadNumRhsEvals(void *cvode_mem, long int *nfQevals); SUNDIALS_EXPORT int CVodeGetQuadNumErrTestFails(void *cvode_mem, long int *nQetfails); SUNDIALS_EXPORT int CVodeGetQuadErrWeights(void *cvode_mem, N_Vector eQweight); SUNDIALS_EXPORT int CVodeGetQuadStats(void *cvode_mem, long int *nfQevals, long int *nQetfails); /* Free function */ SUNDIALS_EXPORT void CVodeQuadFree(void *cvode_mem); /* ------------------------------------ * Exported Functions -- Sensitivities * ------------------------------------ */ /* Initialization functions */ SUNDIALS_EXPORT int CVodeSensInit(void *cvode_mem, int Ns, int ism, CVSensRhsFn fS, N_Vector *yS0); SUNDIALS_EXPORT int CVodeSensInit1(void *cvode_mem, int Ns, int ism, CVSensRhs1Fn fS1, N_Vector *yS0); SUNDIALS_EXPORT int CVodeSensReInit(void *cvode_mem, int ism, N_Vector *yS0); /* Tolerance input functions */ SUNDIALS_EXPORT int CVodeSensSStolerances(void *cvode_mem, realtype reltolS, realtype *abstolS); SUNDIALS_EXPORT int CVodeSensSVtolerances(void *cvode_mem, realtype reltolS, N_Vector *abstolS); SUNDIALS_EXPORT int CVodeSensEEtolerances(void *cvode_mem); /* Optional input specification functions */ SUNDIALS_EXPORT int CVodeSetSensDQMethod(void *cvode_mem, int DQtype, realtype DQrhomax); SUNDIALS_EXPORT int CVodeSetSensErrCon(void *cvode_mem, booleantype errconS); SUNDIALS_EXPORT int CVodeSetSensMaxNonlinIters(void *cvode_mem, int maxcorS); SUNDIALS_EXPORT int CVodeSetSensParams(void *cvode_mem, realtype *p, realtype *pbar, int *plist); /* Integrator nonlinear solver specification functions */ SUNDIALS_EXPORT int CVodeSetNonlinearSolverSensSim(void *cvode_mem, SUNNonlinearSolver NLS); SUNDIALS_EXPORT int CVodeSetNonlinearSolverSensStg(void *cvode_mem, SUNNonlinearSolver NLS); SUNDIALS_EXPORT int CVodeSetNonlinearSolverSensStg1(void *cvode_mem, SUNNonlinearSolver NLS); /* Enable/disable sensitivities */ SUNDIALS_EXPORT int CVodeSensToggleOff(void *cvode_mem); /* Extraction and dense output functions */ SUNDIALS_EXPORT int CVodeGetSens(void *cvode_mem, realtype *tret, N_Vector *ySout); SUNDIALS_EXPORT int CVodeGetSens1(void *cvode_mem, realtype *tret, int is, N_Vector ySout); SUNDIALS_EXPORT int CVodeGetSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyA); SUNDIALS_EXPORT int CVodeGetSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dky); /* Optional output specification functions */ SUNDIALS_EXPORT int CVodeGetSensNumRhsEvals(void *cvode_mem, long int *nfSevals); SUNDIALS_EXPORT int CVodeGetNumRhsEvalsSens(void *cvode_mem, long int *nfevalsS); SUNDIALS_EXPORT int CVodeGetSensNumErrTestFails(void *cvode_mem, long int *nSetfails); SUNDIALS_EXPORT int CVodeGetSensNumLinSolvSetups(void *cvode_mem, long int *nlinsetupsS); SUNDIALS_EXPORT int CVodeGetSensErrWeights(void *cvode_mem, N_Vector *eSweight); SUNDIALS_EXPORT int CVodeGetSensStats(void *cvode_mem, long int *nfSevals, long int *nfevalsS, long int *nSetfails, long int *nlinsetupsS); SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvIters(void *cvode_mem, long int *nSniters); SUNDIALS_EXPORT int CVodeGetSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSncfails); SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvIters(void *cvode_mem, long int *nSTGR1niters); SUNDIALS_EXPORT int CVodeGetStgrSensNumNonlinSolvConvFails(void *cvode_mem, long int *nSTGR1ncfails); SUNDIALS_EXPORT int CVodeGetSensNonlinSolvStats(void *cvode_mem, long int *nSniters, long int *nSncfails); /* Free function */ SUNDIALS_EXPORT void CVodeSensFree(void *cvode_mem); /* ------------------------------------------------------- * Exported Functions -- Sensitivity dependent quadrature * ------------------------------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT int CVodeQuadSensInit(void *cvode_mem, CVQuadSensRhsFn fQS, N_Vector *yQS0); SUNDIALS_EXPORT int CVodeQuadSensReInit(void *cvode_mem, N_Vector *yQS0); /* Tolerance input functions */ SUNDIALS_EXPORT int CVodeQuadSensSStolerances(void *cvode_mem, realtype reltolQS, realtype *abstolQS); SUNDIALS_EXPORT int CVodeQuadSensSVtolerances(void *cvode_mem, realtype reltolQS, N_Vector *abstolQS); SUNDIALS_EXPORT int CVodeQuadSensEEtolerances(void *cvode_mem); /* Optional input specification functions */ SUNDIALS_EXPORT int CVodeSetQuadSensErrCon(void *cvode_mem, booleantype errconQS); /* Extraction and dense output functions */ SUNDIALS_EXPORT int CVodeGetQuadSens(void *cvode_mem, realtype *tret, N_Vector *yQSout); SUNDIALS_EXPORT int CVodeGetQuadSens1(void *cvode_mem, realtype *tret, int is, N_Vector yQSout); SUNDIALS_EXPORT int CVodeGetQuadSensDky(void *cvode_mem, realtype t, int k, N_Vector *dkyQS_all); SUNDIALS_EXPORT int CVodeGetQuadSensDky1(void *cvode_mem, realtype t, int k, int is, N_Vector dkyQS); /* Optional output specification functions */ SUNDIALS_EXPORT int CVodeGetQuadSensNumRhsEvals(void *cvode_mem, long int *nfQSevals); SUNDIALS_EXPORT int CVodeGetQuadSensNumErrTestFails(void *cvode_mem, long int *nQSetfails); SUNDIALS_EXPORT int CVodeGetQuadSensErrWeights(void *cvode_mem, N_Vector *eQSweight); SUNDIALS_EXPORT int CVodeGetQuadSensStats(void *cvode_mem, long int *nfQSevals, long int *nQSetfails); /* Free function */ SUNDIALS_EXPORT void CVodeQuadSensFree(void *cvode_mem); /* ---------------------------------------- * Exported Functions -- Backward Problems * ---------------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT int CVodeAdjInit(void *cvode_mem, long int steps, int interp); SUNDIALS_EXPORT int CVodeAdjReInit(void *cvode_mem); SUNDIALS_EXPORT void CVodeAdjFree(void *cvode_mem); /* Backward Problem Setup Functions */ SUNDIALS_EXPORT int CVodeCreateB(void *cvode_mem, int lmmB, int *which); SUNDIALS_EXPORT int CVodeInitB(void *cvode_mem, int which, CVRhsFnB fB, realtype tB0, N_Vector yB0); SUNDIALS_EXPORT int CVodeInitBS(void *cvode_mem, int which, CVRhsFnBS fBs, realtype tB0, N_Vector yB0); SUNDIALS_EXPORT int CVodeReInitB(void *cvode_mem, int which, realtype tB0, N_Vector yB0); SUNDIALS_EXPORT int CVodeSStolerancesB(void *cvode_mem, int which, realtype reltolB, realtype abstolB); SUNDIALS_EXPORT int CVodeSVtolerancesB(void *cvode_mem, int which, realtype reltolB, N_Vector abstolB); SUNDIALS_EXPORT int CVodeQuadInitB(void *cvode_mem, int which, CVQuadRhsFnB fQB, N_Vector yQB0); SUNDIALS_EXPORT int CVodeQuadInitBS(void *cvode_mem, int which, CVQuadRhsFnBS fQBs, N_Vector yQB0); SUNDIALS_EXPORT int CVodeQuadReInitB(void *cvode_mem, int which, N_Vector yQB0); SUNDIALS_EXPORT int CVodeQuadSStolerancesB(void *cvode_mem, int which, realtype reltolQB, realtype abstolQB); SUNDIALS_EXPORT int CVodeQuadSVtolerancesB(void *cvode_mem, int which, realtype reltolQB, N_Vector abstolQB); /* Solver Function For Forward Problems */ SUNDIALS_EXPORT int CVodeF(void *cvode_mem, realtype tout, N_Vector yout, realtype *tret, int itask, int *ncheckPtr); /* Solver Function For Backward Problems */ SUNDIALS_EXPORT int CVodeB(void *cvode_mem, realtype tBout, int itaskB); /* Optional Input Functions For Adjoint Problems */ SUNDIALS_EXPORT int CVodeSetAdjNoSensi(void *cvode_mem); SUNDIALS_EXPORT int CVodeSetUserDataB(void *cvode_mem, int which, void *user_dataB); SUNDIALS_EXPORT int CVodeSetMaxOrdB(void *cvode_mem, int which, int maxordB); SUNDIALS_EXPORT int CVodeSetMaxNumStepsB(void *cvode_mem, int which, long int mxstepsB); SUNDIALS_EXPORT int CVodeSetStabLimDetB(void *cvode_mem, int which, booleantype stldetB); SUNDIALS_EXPORT int CVodeSetInitStepB(void *cvode_mem, int which, realtype hinB); SUNDIALS_EXPORT int CVodeSetMinStepB(void *cvode_mem, int which, realtype hminB); SUNDIALS_EXPORT int CVodeSetMaxStepB(void *cvode_mem, int which, realtype hmaxB); SUNDIALS_EXPORT int CVodeSetConstraintsB(void *cvode_mem, int which, N_Vector constraintsB); SUNDIALS_EXPORT int CVodeSetQuadErrConB(void *cvode_mem, int which, booleantype errconQB); SUNDIALS_EXPORT int CVodeSetNonlinearSolverB(void *cvode_mem, int which, SUNNonlinearSolver NLS); /* Extraction And Dense Output Functions For Backward Problems */ SUNDIALS_EXPORT int CVodeGetB(void *cvode_mem, int which, realtype *tBret, N_Vector yB); SUNDIALS_EXPORT int CVodeGetQuadB(void *cvode_mem, int which, realtype *tBret, N_Vector qB); /* Optional Output Functions For Backward Problems */ SUNDIALS_EXPORT void *CVodeGetAdjCVodeBmem(void *cvode_mem, int which); SUNDIALS_EXPORT int CVodeGetAdjY(void *cvode_mem, realtype t, N_Vector y); typedef struct { void *my_addr; void *next_addr; realtype t0; realtype t1; long int nstep; int order; realtype step; } CVadjCheckPointRec; SUNDIALS_EXPORT int CVodeGetAdjCheckPointsInfo(void *cvode_mem, CVadjCheckPointRec *ckpnt); /* Undocumented Optional Output Functions For Backward Problems */ /* ----------------------------------------------------------------- * CVodeGetAdjDataPointHermite * ----------------------------------------------------------------- * Returns the 2 vectors stored for cubic Hermite interpolation * at the data point 'which'. The user must allocate space for * y and yd. Returns CV_MEM_NULL if cvode_mem is NULL, * CV_ILL_INPUT if the interpolation type previously specified * is not CV_HERMITE, or CV_SUCCESS otherwise. * ----------------------------------------------------------------- * CVodeGetAdjDataPointPolynomial * ----------------------------------------------------------------- * Returns the vector stored for polynomial interpolation * at the data point 'which'. The user must allocate space for * y. Returns CV_MEM_NULL if cvode_mem is NULL, CV_ILL_INPUT if * the interpolation type previously specified is not * CV_POLYNOMIAL, or CV_SUCCESS otherwise. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetAdjDataPointHermite(void *cvode_mem, int which, realtype *t, N_Vector y, N_Vector yd); SUNDIALS_EXPORT int CVodeGetAdjDataPointPolynomial(void *cvode_mem, int which, realtype *t, int *order, N_Vector y); /* ----------------------------------------------------------------- * CVodeGetAdjCurrentCheckPoint * Returns the address of the 'active' check point. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int CVodeGetAdjCurrentCheckPoint(void *cvode_mem, void **addr); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/cvodes/cvodes_spils.h0000644000176200001440000000753713766554457021246 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated Scaled, Preconditioned Iterative * Linear Solver interface in CVODES; these routines now just wrap * the updated CVODES generic linear solver interface in cvodes_ls.h. * -----------------------------------------------------------------*/ #ifndef _CVSSPILS_H #define _CVSSPILS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*=============================================================== Function Types (typedefs for equivalent types in cvodes_ls.h) ===============================================================*/ typedef CVLsPrecSetupFn CVSpilsPrecSetupFn; typedef CVLsPrecSolveFn CVSpilsPrecSolveFn; typedef CVLsJacTimesSetupFn CVSpilsJacTimesSetupFn; typedef CVLsJacTimesVecFn CVSpilsJacTimesVecFn; typedef CVLsPrecSetupFnB CVSpilsPrecSetupFnB; typedef CVLsPrecSetupFnBS CVSpilsPrecSetupFnBS; typedef CVLsPrecSolveFnB CVSpilsPrecSolveFnB; typedef CVLsPrecSolveFnBS CVSpilsPrecSolveFnBS; typedef CVLsJacTimesSetupFnB CVSpilsJacTimesSetupFnB; typedef CVLsJacTimesSetupFnBS CVSpilsJacTimesSetupFnBS; typedef CVLsJacTimesVecFnB CVSpilsJacTimesVecFnB; typedef CVLsJacTimesVecFnBS CVSpilsJacTimesVecFnBS; /*==================================================================== Exported Functions (wrappers for equivalent routines in cvodes_ls.h) ====================================================================*/ int CVSpilsSetLinearSolver(void *cvode_mem, SUNLinearSolver LS); int CVSpilsSetEpsLin(void *cvode_mem, realtype eplifac); int CVSpilsSetPreconditioner(void *cvode_mem, CVSpilsPrecSetupFn pset, CVSpilsPrecSolveFn psolve); int CVSpilsSetJacTimes(void *cvode_mem, CVSpilsJacTimesSetupFn jtsetup, CVSpilsJacTimesVecFn jtimes); int CVSpilsGetWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); int CVSpilsGetNumPrecEvals(void *cvode_mem, long int *npevals); int CVSpilsGetNumPrecSolves(void *cvode_mem, long int *npsolves); int CVSpilsGetNumLinIters(void *cvode_mem, long int *nliters); int CVSpilsGetNumConvFails(void *cvode_mem, long int *nlcfails); int CVSpilsGetNumJTSetupEvals(void *cvode_mem, long int *njtsetups); int CVSpilsGetNumJtimesEvals(void *cvode_mem, long int *njvevals); int CVSpilsGetNumRhsEvals(void *cvode_mem, long int *nfevalsLS); int CVSpilsGetLastFlag(void *cvode_mem, long int *flag); char *CVSpilsGetReturnFlagName(long int flag); int CVSpilsSetLinearSolverB(void *cvode_mem, int which, SUNLinearSolver LS); int CVSpilsSetEpsLinB(void *cvode_mem, int which, realtype eplifacB); int CVSpilsSetPreconditionerB(void *cvode_mem, int which, CVSpilsPrecSetupFnB psetB, CVSpilsPrecSolveFnB psolveB); int CVSpilsSetPreconditionerBS(void *cvode_mem, int which, CVSpilsPrecSetupFnBS psetBS, CVSpilsPrecSolveFnBS psolveBS); int CVSpilsSetJacTimesB(void *cvode_mem, int which, CVSpilsJacTimesSetupFnB jtsetupB, CVSpilsJacTimesVecFnB jtimesB); int CVSpilsSetJacTimesBS(void *cvode_mem, int which, CVSpilsJacTimesSetupFnBS jtsetupBS, CVSpilsJacTimesVecFnBS jtimesBS); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/cvodes/cvodes_ls.h0000644000176200001440000002427013766554457020523 0ustar liggesusers/* ---------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ---------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ---------------------------------------------------------------- * This is the header file for CVODES' linear solver interface. * ----------------------------------------------------------------*/ #ifndef _CVSLS_H #define _CVSLS_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= CVLS Constants =================================================================*/ #define CVLS_SUCCESS 0 #define CVLS_MEM_NULL -1 #define CVLS_LMEM_NULL -2 #define CVLS_ILL_INPUT -3 #define CVLS_MEM_FAIL -4 #define CVLS_PMEM_NULL -5 #define CVLS_JACFUNC_UNRECVR -6 #define CVLS_JACFUNC_RECVR -7 #define CVLS_SUNMAT_FAIL -8 #define CVLS_SUNLS_FAIL -9 /* Return values for the adjoint module */ #define CVLS_NO_ADJ -101 #define CVLS_LMEMB_NULL -102 /*================================================================= Forward problems =================================================================*/ /*================================================================= CVLS user-supplied function prototypes =================================================================*/ typedef int (*CVLsJacFn)(realtype t, N_Vector y, N_Vector fy, SUNMatrix Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); typedef int (*CVLsPrecSetupFn)(realtype t, N_Vector y, N_Vector fy, booleantype jok, booleantype *jcurPtr, realtype gamma, void *user_data); typedef int (*CVLsPrecSolveFn)(realtype t, N_Vector y, N_Vector fy, N_Vector r, N_Vector z, realtype gamma, realtype delta, int lr, void *user_data); typedef int (*CVLsJacTimesSetupFn)(realtype t, N_Vector y, N_Vector fy, void *user_data); typedef int (*CVLsJacTimesVecFn)(N_Vector v, N_Vector Jv, realtype t, N_Vector y, N_Vector fy, void *user_data, N_Vector tmp); /*================================================================= CVLS Exported functions =================================================================*/ SUNDIALS_EXPORT int CVodeSetLinearSolver(void *cvode_mem, SUNLinearSolver LS, SUNMatrix A); /*----------------------------------------------------------------- Optional inputs to the CVLS linear solver interface -----------------------------------------------------------------*/ SUNDIALS_EXPORT int CVodeSetJacFn(void *cvode_mem, CVLsJacFn jac); SUNDIALS_EXPORT int CVodeSetMaxStepsBetweenJac(void *cvode_mem, long int msbj); SUNDIALS_EXPORT int CVodeSetEpsLin(void *cvode_mem, realtype eplifac); SUNDIALS_EXPORT int CVodeSetPreconditioner(void *cvode_mem, CVLsPrecSetupFn pset, CVLsPrecSolveFn psolve); SUNDIALS_EXPORT int CVodeSetJacTimes(void *cvode_mem, CVLsJacTimesSetupFn jtsetup, CVLsJacTimesVecFn jtimes); /*----------------------------------------------------------------- Optional outputs from the CVLS linear solver interface -----------------------------------------------------------------*/ SUNDIALS_EXPORT int CVodeGetLinWorkSpace(void *cvode_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int CVodeGetNumJacEvals(void *cvode_mem, long int *njevals); SUNDIALS_EXPORT int CVodeGetNumPrecEvals(void *cvode_mem, long int *npevals); SUNDIALS_EXPORT int CVodeGetNumPrecSolves(void *cvode_mem, long int *npsolves); SUNDIALS_EXPORT int CVodeGetNumLinIters(void *cvode_mem, long int *nliters); SUNDIALS_EXPORT int CVodeGetNumLinConvFails(void *cvode_mem, long int *nlcfails); SUNDIALS_EXPORT int CVodeGetNumJTSetupEvals(void *cvode_mem, long int *njtsetups); SUNDIALS_EXPORT int CVodeGetNumJtimesEvals(void *cvode_mem, long int *njvevals); SUNDIALS_EXPORT int CVodeGetNumLinRhsEvals(void *cvode_mem, long int *nfevalsLS); SUNDIALS_EXPORT int CVodeGetLastLinFlag(void *cvode_mem, long int *flag); SUNDIALS_EXPORT char *CVodeGetLinReturnFlagName(long int flag); /*================================================================= Backward problems =================================================================*/ /*================================================================= CVLS user-supplied function prototypes =================================================================*/ typedef int (*CVLsJacFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, SUNMatrix JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); typedef int (*CVLsJacFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector fyB, SUNMatrix JB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); typedef int (*CVLsPrecSetupFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *user_dataB); typedef int (*CVLsPrecSetupFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector fyB, booleantype jokB, booleantype *jcurPtrB, realtype gammaB, void *user_dataB); typedef int (*CVLsPrecSolveFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *user_dataB); typedef int (*CVLsPrecSolveFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector fyB, N_Vector rB, N_Vector zB, realtype gammaB, realtype deltaB, int lrB, void *user_dataB); typedef int (*CVLsJacTimesSetupFnB)(realtype t, N_Vector y, N_Vector yB, N_Vector fyB, void *jac_dataB); typedef int (*CVLsJacTimesSetupFnBS)(realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector fyB, void *jac_dataB); typedef int (*CVLsJacTimesVecFnB)(N_Vector vB, N_Vector JvB, realtype t, N_Vector y, N_Vector yB, N_Vector fyB, void *jac_dataB, N_Vector tmpB); typedef int (*CVLsJacTimesVecFnBS)(N_Vector vB, N_Vector JvB, realtype t, N_Vector y, N_Vector *yS, N_Vector yB, N_Vector fyB, void *jac_dataB, N_Vector tmpB); /*================================================================= CVLS Exported functions =================================================================*/ SUNDIALS_EXPORT int CVodeSetLinearSolverB(void *cvode_mem, int which, SUNLinearSolver LS, SUNMatrix A); /*----------------------------------------------------------------- Each CVodeSet***B or CVodeSet***BS function below links the main CVODES integrator with the corresponding CVSLS optional input function for the backward integration. The 'which' argument is the int returned by CVodeCreateB. -----------------------------------------------------------------*/ SUNDIALS_EXPORT int CVodeSetJacFnB(void *cvode_mem, int which, CVLsJacFnB jacB); SUNDIALS_EXPORT int CVodeSetJacFnBS(void *cvode_mem, int which, CVLsJacFnBS jacBS); SUNDIALS_EXPORT int CVodeSetEpsLinB(void *cvode_mem, int which, realtype eplifacB); SUNDIALS_EXPORT int CVodeSetPreconditionerB(void *cvode_mem, int which, CVLsPrecSetupFnB psetB, CVLsPrecSolveFnB psolveB); SUNDIALS_EXPORT int CVodeSetPreconditionerBS(void *cvode_mem, int which, CVLsPrecSetupFnBS psetBS, CVLsPrecSolveFnBS psolveBS); SUNDIALS_EXPORT int CVodeSetJacTimesB(void *cvode_mem, int which, CVLsJacTimesSetupFnB jtsetupB, CVLsJacTimesVecFnB jtimesB); SUNDIALS_EXPORT int CVodeSetJacTimesBS(void *cvode_mem, int which, CVLsJacTimesSetupFnBS jtsetupBS, CVLsJacTimesVecFnBS jtimesBS); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/0000755000176200001440000000000013766554135017120 5ustar liggesusersStanHeaders/inst/include/sunlinsol/sunlinsol_pcg.h0000644000176200001440000000776513766554457022176 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the PCG implementation of the * SUNLINSOL module, SUNLINSOL_PCG. The PCG algorithm is based * on the Preconditioned Conjugate Gradient. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_PCG_H #define _SUNLINSOL_PCG_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default PCG solver parameters */ #define SUNPCG_MAXL_DEFAULT 5 /* -------------------------------------- * PCG Implementation of SUNLinearSolver * -------------------------------------- */ struct _SUNLinearSolverContent_PCG { int maxl; int pretype; int numiters; realtype resnorm; long int last_flag; ATimesFn ATimes; void* ATData; PSetupFn Psetup; PSolveFn Psolve; void* PData; N_Vector s; N_Vector r; N_Vector p; N_Vector z; N_Vector Ap; }; typedef struct _SUNLinearSolverContent_PCG *SUNLinearSolverContent_PCG; /* ------------------------------------- * Exported Functions for SUNLINSOL_PCG * ------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_PCG(N_Vector y, int pretype, int maxl); SUNDIALS_EXPORT int SUNLinSol_PCGSetPrecType(SUNLinearSolver S, int pretype); SUNDIALS_EXPORT int SUNLinSol_PCGSetMaxl(SUNLinearSolver S, int maxl); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNPCG(N_Vector y, int pretype, int maxl); /* deprecated */ SUNDIALS_EXPORT int SUNPCGSetPrecType(SUNLinearSolver S, int pretype); /* deprecated */ SUNDIALS_EXPORT int SUNPCGSetMaxl(SUNLinearSolver S, int maxl); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_PCG(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_PCG(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetATimes_PCG(SUNLinearSolver S, void* A_data, ATimesFn ATimes); SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_PCG(SUNLinearSolver S, void* P_data, PSetupFn Pset, PSolveFn Psol); SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_PCG(SUNLinearSolver S, N_Vector s, N_Vector nul); SUNDIALS_EXPORT int SUNLinSolSetup_PCG(SUNLinearSolver S, SUNMatrix nul); SUNDIALS_EXPORT int SUNLinSolSolve_PCG(SUNLinearSolver S, SUNMatrix nul, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT int SUNLinSolNumIters_PCG(SUNLinearSolver S); SUNDIALS_EXPORT realtype SUNLinSolResNorm_PCG(SUNLinearSolver S); SUNDIALS_EXPORT N_Vector SUNLinSolResid_PCG(SUNLinearSolver S); SUNDIALS_EXPORT long int SUNLinSolLastFlag_PCG(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_PCG(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_PCG(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_superlumt.h0000644000176200001440000001056113766554457023451 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on codes sundials_superlumt_impl.h and _superlumt.h * written by Carol S. Woodward @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the SuperLUMT implementation of the * SUNLINSOL module, SUNLINSOL_SUPERLUMT. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_SLUMT_H #define _SUNLINSOL_SLUMT_H #include #include #include #include /* Assume SuperLU_MT library was built with compatible index type */ #if defined(SUNDIALS_INT64_T) #define _LONGINT #endif #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default SuperLU_MT solver parameters */ #define SUNSLUMT_ORDERING_DEFAULT 3 /* COLAMD */ /* Interfaces to match 'realtype' with the correct SuperLUMT functions */ #if defined(SUNDIALS_DOUBLE_PRECISION) #ifndef _SLUMT_H #define _SLUMT_H #include "slu_mt_ddefs.h" #endif #define xgstrs dgstrs #define pxgstrf pdgstrf #define pxgstrf_init pdgstrf_init #define xCreate_Dense_Matrix dCreate_Dense_Matrix #define xCreate_CompCol_Matrix dCreate_CompCol_Matrix #elif defined(SUNDIALS_SINGLE_PRECISION) #ifndef _SLUMT_H #define _SLUMT_H #include "slu_mt_sdefs.h" #endif #define xgstrs sgstrs #define pxgstrf psgstrf #define pxgstrf_init psgstrf_init #define xCreate_Dense_Matrix sCreate_Dense_Matrix #define xCreate_CompCol_Matrix sCreate_CompCol_Matrix #else /* incompatible sunindextype for SuperLUMT */ #error Incompatible realtype for SuperLUMT #endif /* -------------------------------------------- * SuperLUMT Implementation of SUNLinearSolver * -------------------------------------------- */ struct _SUNLinearSolverContent_SuperLUMT { long int last_flag; int first_factorize; SuperMatrix *A, *AC, *L, *U, *B; Gstat_t *Gstat; sunindextype *perm_r, *perm_c; sunindextype N; int num_threads; realtype diag_pivot_thresh; int ordering; superlumt_options_t *options; }; typedef struct _SUNLinearSolverContent_SuperLUMT *SUNLinearSolverContent_SuperLUMT; /* ------------------------------------------- * Exported Functions for SUNLINSOL_SUPERLUMT * ------------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SuperLUMT(N_Vector y, SUNMatrix A, int num_threads); SUNDIALS_EXPORT int SUNLinSol_SuperLUMTSetOrdering(SUNLinearSolver S, int ordering_choice); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNSuperLUMT(N_Vector y, SUNMatrix A, int num_threads); /* deprecated */ SUNDIALS_EXPORT int SUNSuperLUMTSetOrdering(SUNLinearSolver S, int ordering_choice); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SuperLUMT(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_SuperLUMT(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetup_SuperLUMT(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_SuperLUMT(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT long int SUNLinSolLastFlag_SuperLUMT(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_SuperLUMT(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_SuperLUMT(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_band.h0000644000176200001440000000501413766554457022312 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the band implementation of the * SUNLINSOL module, SUNLINSOL_BAND. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_BAND_H #define _SUNLINSOL_BAND_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* --------------------------------------- * Band Implementation of SUNLinearSolver * --------------------------------------- */ struct _SUNLinearSolverContent_Band { sunindextype N; sunindextype *pivots; long int last_flag; }; typedef struct _SUNLinearSolverContent_Band *SUNLinearSolverContent_Band; /* -------------------------------------- * Exported Functions for SUNLINSOL_BAND * -------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_Band(N_Vector y, SUNMatrix A); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNBandLinearSolver(N_Vector y, SUNMatrix A); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_Band(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_Band(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetup_Band(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_Band(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT long int SUNLinSolLastFlag_Band(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_Band(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_Band(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_spbcgs.h0000644000176200001440000001042113766554457022665 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on code sundials_spbcgs.h by: Peter Brown and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the SPBCGS implementation of the * SUNLINSOL module, SUNLINSOL_SPBCGS. The SPBCGS algorithm is based * on the Scaled Preconditioned Bi-CG-Stabilized method. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_SPBCGS_H #define _SUNLINSOL_SPBCGS_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default SPBCGS solver parameters */ #define SUNSPBCGS_MAXL_DEFAULT 5 /* ----------------------------------------- * SPBCGS Implementation of SUNLinearSolver * ---------------------------------------- */ struct _SUNLinearSolverContent_SPBCGS { int maxl; int pretype; int numiters; realtype resnorm; long int last_flag; ATimesFn ATimes; void* ATData; PSetupFn Psetup; PSolveFn Psolve; void* PData; N_Vector s1; N_Vector s2; N_Vector r; N_Vector r_star; N_Vector p; N_Vector q; N_Vector u; N_Vector Ap; N_Vector vtemp; }; typedef struct _SUNLinearSolverContent_SPBCGS *SUNLinearSolverContent_SPBCGS; /* --------------------------------------- *Exported Functions for SUNLINSOL_SPBCGS * --------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPBCGS(N_Vector y, int pretype, int maxl); SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetPrecType(SUNLinearSolver S, int pretype); SUNDIALS_EXPORT int SUNLinSol_SPBCGSSetMaxl(SUNLinearSolver S, int maxl); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNSPBCGS(N_Vector y, int pretype, int maxl); /* deprecated */ SUNDIALS_EXPORT int SUNSPBCGSSetPrecType(SUNLinearSolver S, int pretype); /* deprecated */ SUNDIALS_EXPORT int SUNSPBCGSSetMaxl(SUNLinearSolver S, int maxl); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPBCGS(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_SPBCGS(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetATimes_SPBCGS(SUNLinearSolver S, void* A_data, ATimesFn ATimes); SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPBCGS(SUNLinearSolver S, void* P_data, PSetupFn Pset, PSolveFn Psol); SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPBCGS(SUNLinearSolver S, N_Vector s1, N_Vector s2); SUNDIALS_EXPORT int SUNLinSolSetup_SPBCGS(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_SPBCGS(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT int SUNLinSolNumIters_SPBCGS(SUNLinearSolver S); SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPBCGS(SUNLinearSolver S); SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPBCGS(SUNLinearSolver S); SUNDIALS_EXPORT long int SUNLinSolLastFlag_SPBCGS(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_SPBCGS(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_SPBCGS(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_spfgmr.h0000644000176200001440000001136313766554457022710 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on code sundials_spfgmr.h by: Daniel R. Reynolds and * Hilari C. Tiedeman @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the SPFGMR implementation of the * SUNLINSOL module, SUNLINSOL_SPFGMR. The SPFGMR algorithm is based * on the Scaled Preconditioned FGMRES (Flexible Generalized Minimal * Residual) method [Y. Saad, SIAM J. Sci. Comput., 1993]. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_SPFGMR_H #define _SUNLINSOL_SPFGMR_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default SPFGMR solver parameters */ #define SUNSPFGMR_MAXL_DEFAULT 5 #define SUNSPFGMR_MAXRS_DEFAULT 0 #define SUNSPFGMR_GSTYPE_DEFAULT MODIFIED_GS /* ----------------------------------------- * SPFGMR Implementation of SUNLinearSolver * ----------------------------------------- */ struct _SUNLinearSolverContent_SPFGMR { int maxl; int pretype; int gstype; int max_restarts; int numiters; realtype resnorm; long int last_flag; ATimesFn ATimes; void* ATData; PSetupFn Psetup; PSolveFn Psolve; void* PData; N_Vector s1; N_Vector s2; N_Vector *V; N_Vector *Z; realtype **Hes; realtype *givens; N_Vector xcor; realtype *yg; N_Vector vtemp; realtype *cv; N_Vector *Xv; }; typedef struct _SUNLinearSolverContent_SPFGMR *SUNLinearSolverContent_SPFGMR; /* ---------------------------------------- * Exported Functions for SUNLINSOL_SPFGMR * ---------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPFGMR(N_Vector y, int pretype, int maxl); SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetPrecType(SUNLinearSolver S, int pretype); SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetGSType(SUNLinearSolver S, int gstype); SUNDIALS_EXPORT int SUNLinSol_SPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNSPFGMR(N_Vector y, int pretype, int maxl); /* deprecated */ SUNDIALS_EXPORT int SUNSPFGMRSetPrecType(SUNLinearSolver S, int pretype); /* deprecated */ SUNDIALS_EXPORT int SUNSPFGMRSetGSType(SUNLinearSolver S, int gstype); /* deprecated */ SUNDIALS_EXPORT int SUNSPFGMRSetMaxRestarts(SUNLinearSolver S, int maxrs); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPFGMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_SPFGMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetATimes_SPFGMR(SUNLinearSolver S, void* A_data, ATimesFn ATimes); SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPFGMR(SUNLinearSolver S, void* P_data, PSetupFn Pset, PSolveFn Psol); SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPFGMR(SUNLinearSolver S, N_Vector s1, N_Vector s2); SUNDIALS_EXPORT int SUNLinSolSetup_SPFGMR(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_SPFGMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT int SUNLinSolNumIters_SPFGMR(SUNLinearSolver S); SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPFGMR(SUNLinearSolver S); SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPFGMR(SUNLinearSolver S); SUNDIALS_EXPORT long int SUNLinSolLastFlag_SPFGMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_SPFGMR(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_SPFGMR(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_dense.h0000644000176200001440000000552313766554457022511 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds, Ashley Crawford @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the dense implementation of the * SUNLINSOL module, SUNLINSOL_DENSE. * * Notes: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype' and 'indextype'. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_DENSE_H #define _SUNLINSOL_DENSE_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ---------------------------------------- * Dense Implementation of SUNLinearSolver * ---------------------------------------- */ struct _SUNLinearSolverContent_Dense { sunindextype N; sunindextype *pivots; long int last_flag; }; typedef struct _SUNLinearSolverContent_Dense *SUNLinearSolverContent_Dense; /* ---------------------------------------- * Exported Functions for SUNLINSOL_DENSE * ---------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_Dense(N_Vector y, SUNMatrix A); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNDenseLinearSolver(N_Vector y, SUNMatrix A); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_Dense(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_Dense(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetup_Dense(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_Dense(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT long int SUNLinSolLastFlag_Dense(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_Dense(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_Dense(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_sptfqmr.h0000644000176200001440000001056213766554457023106 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on code sundials_sptfqmr.h by: Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the SPTFQMR implementation of the * SUNLINSOL module, SUNLINSOL_SPTFQMR. The SPTFQMR algorithm is * based on the Scaled Preconditioned Transpose-free Quasi-Minimum * Residual method. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_SPTFQMR_H #define _SUNLINSOL_SPTFQMR_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default SPTFQMR solver parameters */ #define SUNSPTFQMR_MAXL_DEFAULT 5 /* ------------------------------------------ * SPTFQMR Implementation of SUNLinearSolver * ------------------------------------------ */ struct _SUNLinearSolverContent_SPTFQMR { int maxl; int pretype; int numiters; realtype resnorm; long int last_flag; ATimesFn ATimes; void* ATData; PSetupFn Psetup; PSolveFn Psolve; void* PData; N_Vector s1; N_Vector s2; N_Vector r_star; N_Vector q; N_Vector d; N_Vector v; N_Vector p; N_Vector *r; N_Vector u; N_Vector vtemp1; N_Vector vtemp2; N_Vector vtemp3; }; typedef struct _SUNLinearSolverContent_SPTFQMR *SUNLinearSolverContent_SPTFQMR; /* ------------------------------------- * Exported Functions SUNLINSOL_SPTFQMR * -------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPTFQMR(N_Vector y, int pretype, int maxl); SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetPrecType(SUNLinearSolver S, int pretype); SUNDIALS_EXPORT int SUNLinSol_SPTFQMRSetMaxl(SUNLinearSolver S, int maxl); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNSPTFQMR(N_Vector y, int pretype, int maxl); /* deprecated */ SUNDIALS_EXPORT int SUNSPTFQMRSetPrecType(SUNLinearSolver S, int pretype); /* deprecated */ SUNDIALS_EXPORT int SUNSPTFQMRSetMaxl(SUNLinearSolver S, int maxl); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPTFQMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_SPTFQMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetATimes_SPTFQMR(SUNLinearSolver S, void* A_data, ATimesFn ATimes); SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPTFQMR(SUNLinearSolver S, void* P_data, PSetupFn Pset, PSolveFn Psol); SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPTFQMR(SUNLinearSolver S, N_Vector s1, N_Vector s2); SUNDIALS_EXPORT int SUNLinSolSetup_SPTFQMR(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_SPTFQMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT int SUNLinSolNumIters_SPTFQMR(SUNLinearSolver S); SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPTFQMR(SUNLinearSolver S); SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPTFQMR(SUNLinearSolver S); SUNDIALS_EXPORT long int SUNLinSolLastFlag_SPTFQMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_SPTFQMR(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_SPTFQMR(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_lapackdense.h0000644000176200001440000000640013766554457023660 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the LAPACK dense implementation of the * SUNLINSOL module, SUNLINSOL_LINPACKDENSE. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_LAPDENSE_H #define _SUNLINSOL_LAPDENSE_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Interfaces to match 'realtype' with the correct LAPACK functions */ #if defined(SUNDIALS_DOUBLE_PRECISION) #define xgetrf_f77 dgetrf_f77 #define xgetrs_f77 dgetrs_f77 #elif defined(SUNDIALS_SINGLE_PRECISION) #define xgetrf_f77 sgetrf_f77 #define xgetrs_f77 sgetrs_f77 #else #error Incompatible realtype for LAPACK; disable LAPACK and rebuild #endif /* Catch to disable LAPACK linear solvers with incompatible sunindextype */ #if defined(SUNDIALS_INT32_T) #else /* incompatible sunindextype for LAPACK */ #error Incompatible sunindextype for LAPACK; disable LAPACK and rebuild #endif /* ----------------------------------------------- * LAPACK dense implementation of SUNLinearSolver * ----------------------------------------------- */ struct _SUNLinearSolverContent_LapackDense { sunindextype N; sunindextype *pivots; long int last_flag; }; typedef struct _SUNLinearSolverContent_LapackDense *SUNLinearSolverContent_LapackDense; /* --------------------------------------------- * Exported Functions for SUNLINSOL_LAPACKDENSE * --------------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_LapackDense(N_Vector y, SUNMatrix A); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNLapackDense(N_Vector y, SUNMatrix A); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_LapackDense(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_LapackDense(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetup_LapackDense(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_LapackDense(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT long int SUNLinSolLastFlag_LapackDense(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_LapackDense(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_LapackDense(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_spgmr.h0000644000176200001440000001120713766554457022537 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on code sundials_spgmr.h by: Scott D. Cohen, * Alan C. Hindmarsh and Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the SPGMR implementation of the * SUNLINSOL module, SUNLINSOL_SPGMR. The SPGMR algorithm is based * on the Scaled Preconditioned GMRES (Generalized Minimal Residual) * method. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_SPGMR_H #define _SUNLINSOL_SPGMR_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default SPGMR solver parameters */ #define SUNSPGMR_MAXL_DEFAULT 5 #define SUNSPGMR_MAXRS_DEFAULT 0 #define SUNSPGMR_GSTYPE_DEFAULT MODIFIED_GS /* ---------------------------------------- * SPGMR Implementation of SUNLinearSolver * ---------------------------------------- */ struct _SUNLinearSolverContent_SPGMR { int maxl; int pretype; int gstype; int max_restarts; int numiters; realtype resnorm; long int last_flag; ATimesFn ATimes; void* ATData; PSetupFn Psetup; PSolveFn Psolve; void* PData; N_Vector s1; N_Vector s2; N_Vector *V; realtype **Hes; realtype *givens; N_Vector xcor; realtype *yg; N_Vector vtemp; realtype *cv; N_Vector *Xv; }; typedef struct _SUNLinearSolverContent_SPGMR *SUNLinearSolverContent_SPGMR; /* --------------------------------------- * Exported Functions for SUNLINSOL_SPGMR * --------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_SPGMR(N_Vector y, int pretype, int maxl); SUNDIALS_EXPORT int SUNLinSol_SPGMRSetPrecType(SUNLinearSolver S, int pretype); SUNDIALS_EXPORT int SUNLinSol_SPGMRSetGSType(SUNLinearSolver S, int gstype); SUNDIALS_EXPORT int SUNLinSol_SPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNSPGMR(N_Vector y, int pretype, int maxl); /* deprecated */ SUNDIALS_EXPORT int SUNSPGMRSetPrecType(SUNLinearSolver S, int pretype); /* deprecated */ SUNDIALS_EXPORT int SUNSPGMRSetGSType(SUNLinearSolver S, int gstype); /* deprecated */ SUNDIALS_EXPORT int SUNSPGMRSetMaxRestarts(SUNLinearSolver S, int maxrs); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_SPGMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_SPGMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetATimes_SPGMR(SUNLinearSolver S, void* A_data, ATimesFn ATimes); SUNDIALS_EXPORT int SUNLinSolSetPreconditioner_SPGMR(SUNLinearSolver S, void* P_data, PSetupFn Pset, PSolveFn Psol); SUNDIALS_EXPORT int SUNLinSolSetScalingVectors_SPGMR(SUNLinearSolver S, N_Vector s1, N_Vector s2); SUNDIALS_EXPORT int SUNLinSolSetup_SPGMR(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_SPGMR(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT int SUNLinSolNumIters_SPGMR(SUNLinearSolver S); SUNDIALS_EXPORT realtype SUNLinSolResNorm_SPGMR(SUNLinearSolver S); SUNDIALS_EXPORT N_Vector SUNLinSolResid_SPGMR(SUNLinearSolver S); SUNDIALS_EXPORT long int SUNLinSolLastFlag_SPGMR(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_SPGMR(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_SPGMR(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_klu.h0000644000176200001440000001171613766554457022207 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * Based on sundials_klu_impl.h and arkode_klu.h/cvode_klu.h/... * code, written by Carol S. Woodward @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the KLU implementation of the * SUNLINSOL module, SUNLINSOL_KLU. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_KLU_H #define _SUNLINSOL_KLU_H #include #include #include #include #ifndef _KLU_H #include #endif #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Default KLU solver parameters */ #define SUNKLU_ORDERING_DEFAULT 1 /* COLAMD */ #define SUNKLU_REINIT_FULL 1 #define SUNKLU_REINIT_PARTIAL 2 /* Interfaces to match 'sunindextype' with the correct KLU types/functions */ #if defined(SUNDIALS_INT64_T) #define sun_klu_symbolic klu_l_symbolic #define sun_klu_numeric klu_l_numeric #define sun_klu_common klu_l_common #define sun_klu_analyze klu_l_analyze #define sun_klu_factor klu_l_factor #define sun_klu_refactor klu_l_refactor #define sun_klu_rcond klu_l_rcond #define sun_klu_condest klu_l_condest #define sun_klu_defaults klu_l_defaults #define sun_klu_free_symbolic klu_l_free_symbolic #define sun_klu_free_numeric klu_l_free_numeric #elif defined(SUNDIALS_INT32_T) #define sun_klu_symbolic klu_symbolic #define sun_klu_numeric klu_numeric #define sun_klu_common klu_common #define sun_klu_analyze klu_analyze #define sun_klu_factor klu_factor #define sun_klu_refactor klu_refactor #define sun_klu_rcond klu_rcond #define sun_klu_condest klu_condest #define sun_klu_defaults klu_defaults #define sun_klu_free_symbolic klu_free_symbolic #define sun_klu_free_numeric klu_free_numeric #else /* incompatible sunindextype for KLU */ #error Incompatible sunindextype for KLU #endif #if defined(SUNDIALS_DOUBLE_PRECISION) #else #error Incompatible realtype for KLU #endif /* -------------------------------------- * KLU Implementation of SUNLinearSolver * -------------------------------------- */ /* Create a typedef for the KLU solver function pointer to suppress compiler * warning messages about sunindextype vs internal KLU index types. */ typedef sunindextype (*KLUSolveFn)(sun_klu_symbolic*, sun_klu_numeric*, sunindextype, sunindextype, double*, sun_klu_common*); struct _SUNLinearSolverContent_KLU { long int last_flag; int first_factorize; sun_klu_symbolic *symbolic; sun_klu_numeric *numeric; sun_klu_common common; KLUSolveFn klu_solver; }; typedef struct _SUNLinearSolverContent_KLU *SUNLinearSolverContent_KLU; /* ------------------------------------- * Exported Functions for SUNLINSOL_KLU * ------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_KLU(N_Vector y, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSol_KLUReInit(SUNLinearSolver S, SUNMatrix A, sunindextype nnz, int reinit_type); SUNDIALS_EXPORT int SUNLinSol_KLUSetOrdering(SUNLinearSolver S, int ordering_choice); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNKLU(N_Vector y, SUNMatrix A); /* deprecated */ SUNDIALS_EXPORT int SUNKLUReInit(SUNLinearSolver S, SUNMatrix A, sunindextype nnz, int reinit_type); /* deprecated */ SUNDIALS_EXPORT int SUNKLUSetOrdering(SUNLinearSolver S, int ordering_choice); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_KLU(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_KLU(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetup_KLU(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_KLU(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT long int SUNLinSolLastFlag_KLU(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_KLU(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_KLU(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunlinsol/sunlinsol_lapackband.h0000644000176200001440000000634313766554457023474 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the LAPACK band implementation of the * SUNLINSOL module, SUNLINSOL_LAPACKBAND. * * Note: * - The definition of the generic SUNLinearSolver structure can * be found in the header file sundials_linearsolver.h. * ----------------------------------------------------------------- */ #ifndef _SUNLINSOL_LAPBAND_H #define _SUNLINSOL_LAPBAND_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* Interfaces to match 'realtype' with the correct LAPACK functions */ #if defined(SUNDIALS_DOUBLE_PRECISION) #define xgbtrf_f77 dgbtrf_f77 #define xgbtrs_f77 dgbtrs_f77 #elif defined(SUNDIALS_SINGLE_PRECISION) #define xgbtrf_f77 sgbtrf_f77 #define xgbtrs_f77 sgbtrs_f77 #else #error Incompatible realtype for LAPACK; disable LAPACK and rebuild #endif /* Catch to disable LAPACK linear solvers with incompatible sunindextype */ #if defined(SUNDIALS_INT32_T) #else /* incompatible sunindextype for LAPACK */ #error Incompatible sunindextype for LAPACK; disable LAPACK and rebuild #endif /* ---------------------------------------------- * LAPACK band implementation of SUNLinearSolver * ---------------------------------------------- */ struct _SUNLinearSolverContent_LapackBand { sunindextype N; sunindextype *pivots; long int last_flag; }; typedef struct _SUNLinearSolverContent_LapackBand *SUNLinearSolverContent_LapackBand; /* -------------------------------------------- * Exported Functions for SUNLINSOL_LAPACKBAND * -------------------------------------------- */ SUNDIALS_EXPORT SUNLinearSolver SUNLinSol_LapackBand(N_Vector y, SUNMatrix A); /* deprecated */ SUNDIALS_EXPORT SUNLinearSolver SUNLapackBand(N_Vector y, SUNMatrix A); SUNDIALS_EXPORT SUNLinearSolver_Type SUNLinSolGetType_LapackBand(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolInitialize_LapackBand(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSetup_LapackBand(SUNLinearSolver S, SUNMatrix A); SUNDIALS_EXPORT int SUNLinSolSolve_LapackBand(SUNLinearSolver S, SUNMatrix A, N_Vector x, N_Vector b, realtype tol); SUNDIALS_EXPORT long int SUNLinSolLastFlag_LapackBand(SUNLinearSolver S); SUNDIALS_EXPORT int SUNLinSolSpace_LapackBand(SUNLinearSolver S, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int SUNLinSolFree_LapackBand(SUNLinearSolver S); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunmatrix/0000755000176200001440000000000013766554135017124 5ustar liggesusersStanHeaders/inst/include/sunmatrix/sunmatrix_dense.h0000644000176200001440000000707713766554457022527 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner @ LLNL * Based on code sundials_direct.h by: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the dense implementation of the * SUNMATRIX module, SUNMATRIX_DENSE. * * Notes: * - The definition of the generic SUNMatrix structure can be found * in the header file sundials_matrix.h. * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype' and 'indextype'. * ----------------------------------------------------------------- */ #ifndef _SUNMATRIX_DENSE_H #define _SUNMATRIX_DENSE_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ---------------------------------- * Dense implementation of SUNMatrix * ---------------------------------- */ struct _SUNMatrixContent_Dense { sunindextype M; sunindextype N; realtype *data; sunindextype ldata; realtype **cols; }; typedef struct _SUNMatrixContent_Dense *SUNMatrixContent_Dense; /* ------------------------------------ * Macros for access to SUNMATRIX_DENSE * ------------------------------------ */ #define SM_CONTENT_D(A) ( (SUNMatrixContent_Dense)(A->content) ) #define SM_ROWS_D(A) ( SM_CONTENT_D(A)->M ) #define SM_COLUMNS_D(A) ( SM_CONTENT_D(A)->N ) #define SM_LDATA_D(A) ( SM_CONTENT_D(A)->ldata ) #define SM_DATA_D(A) ( SM_CONTENT_D(A)->data ) #define SM_COLS_D(A) ( SM_CONTENT_D(A)->cols ) #define SM_COLUMN_D(A,j) ( (SM_CONTENT_D(A)->cols)[j] ) #define SM_ELEMENT_D(A,i,j) ( (SM_CONTENT_D(A)->cols)[j][i] ) /* --------------------------------------- * Exported Functions for SUNMATRIX_DENSE * --------------------------------------- */ SUNDIALS_EXPORT SUNMatrix SUNDenseMatrix(sunindextype M, sunindextype N); SUNDIALS_EXPORT void SUNDenseMatrix_Print(SUNMatrix A, FILE* outfile); SUNDIALS_EXPORT sunindextype SUNDenseMatrix_Rows(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNDenseMatrix_Columns(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNDenseMatrix_LData(SUNMatrix A); SUNDIALS_EXPORT realtype* SUNDenseMatrix_Data(SUNMatrix A); SUNDIALS_EXPORT realtype** SUNDenseMatrix_Cols(SUNMatrix A); SUNDIALS_EXPORT realtype* SUNDenseMatrix_Column(SUNMatrix A, sunindextype j); SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_Dense(SUNMatrix A); SUNDIALS_EXPORT SUNMatrix SUNMatClone_Dense(SUNMatrix A); SUNDIALS_EXPORT void SUNMatDestroy_Dense(SUNMatrix A); SUNDIALS_EXPORT int SUNMatZero_Dense(SUNMatrix A); SUNDIALS_EXPORT int SUNMatCopy_Dense(SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT int SUNMatScaleAdd_Dense(realtype c, SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT int SUNMatScaleAddI_Dense(realtype c, SUNMatrix A); SUNDIALS_EXPORT int SUNMatMatvec_Dense(SUNMatrix A, N_Vector x, N_Vector y); SUNDIALS_EXPORT int SUNMatSpace_Dense(SUNMatrix A, long int *lenrw, long int *leniw); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunmatrix/sunmatrix_band.h0000644000176200001440000001071013766554457022321 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner @ LLNL * Based on code sundials_direct.h by: Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the band implementation of the * SUNMATRIX module, SUNMATRIX_BAND. * * Notes: * - The definition of the generic SUNMatrix structure can be found * in the header file sundials_matrix.h. * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype' and 'indextype'. * ----------------------------------------------------------------- */ #ifndef _SUNMATRIX_BAND_H #define _SUNMATRIX_BAND_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* --------------------------------- * Band implementation of SUNMatrix * --------------------------------- */ struct _SUNMatrixContent_Band { sunindextype M; sunindextype N; sunindextype ldim; sunindextype mu; sunindextype ml; sunindextype s_mu; realtype *data; sunindextype ldata; realtype **cols; }; typedef struct _SUNMatrixContent_Band *SUNMatrixContent_Band; /* ------------------------------------ * Macros for access to SUNMATRIX_BAND * ------------------------------------ */ #define SM_CONTENT_B(A) ( (SUNMatrixContent_Band)(A->content) ) #define SM_ROWS_B(A) ( SM_CONTENT_B(A)->M ) #define SM_COLUMNS_B(A) ( SM_CONTENT_B(A)->N ) #define SM_LDATA_B(A) ( SM_CONTENT_B(A)->ldata ) #define SM_UBAND_B(A) ( SM_CONTENT_B(A)->mu ) #define SM_LBAND_B(A) ( SM_CONTENT_B(A)->ml ) #define SM_SUBAND_B(A) ( SM_CONTENT_B(A)->s_mu ) #define SM_LDIM_B(A) ( SM_CONTENT_B(A)->ldim ) #define SM_DATA_B(A) ( SM_CONTENT_B(A)->data ) #define SM_COLS_B(A) ( SM_CONTENT_B(A)->cols ) #define SM_COLUMN_B(A,j) ( ((SM_CONTENT_B(A)->cols)[j])+SM_SUBAND_B(A) ) #define SM_COLUMN_ELEMENT_B(col_j,i,j) (col_j[(i)-(j)]) #define SM_ELEMENT_B(A,i,j) ( (SM_CONTENT_B(A)->cols)[j][(i)-(j)+SM_SUBAND_B(A)] ) /* ---------------------------------------- * Exported Functions for SUNMATRIX_BAND * ---------------------------------------- */ SUNDIALS_EXPORT SUNMatrix SUNBandMatrix(sunindextype N, sunindextype mu, sunindextype ml); SUNDIALS_EXPORT SUNMatrix SUNBandMatrixStorage(sunindextype N, sunindextype mu, sunindextype ml, sunindextype smu); SUNDIALS_EXPORT void SUNBandMatrix_Print(SUNMatrix A, FILE* outfile); SUNDIALS_EXPORT sunindextype SUNBandMatrix_Rows(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNBandMatrix_Columns(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNBandMatrix_LowerBandwidth(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNBandMatrix_UpperBandwidth(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNBandMatrix_StoredUpperBandwidth(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNBandMatrix_LDim(SUNMatrix A); SUNDIALS_EXPORT realtype* SUNBandMatrix_Data(SUNMatrix A); SUNDIALS_EXPORT realtype** SUNBandMatrix_Cols(SUNMatrix A); SUNDIALS_EXPORT realtype* SUNBandMatrix_Column(SUNMatrix A, sunindextype j); SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_Band(SUNMatrix A); SUNDIALS_EXPORT SUNMatrix SUNMatClone_Band(SUNMatrix A); SUNDIALS_EXPORT void SUNMatDestroy_Band(SUNMatrix A); SUNDIALS_EXPORT int SUNMatZero_Band(SUNMatrix A); SUNDIALS_EXPORT int SUNMatCopy_Band(SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT int SUNMatScaleAdd_Band(realtype c, SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT int SUNMatScaleAddI_Band(realtype c, SUNMatrix A); SUNDIALS_EXPORT int SUNMatMatvec_Band(SUNMatrix A, N_Vector x, N_Vector y); SUNDIALS_EXPORT int SUNMatSpace_Band(SUNMatrix A, long int *lenrw, long int *leniw); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunmatrix/sunmatrix_sparse.h0000644000176200001440000001156113766554457022717 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Daniel Reynolds @ SMU * David Gardner @ LLNL * Based on code sundials_sparse.h by: Carol Woodward and * Slaven Peles @ LLNL, and Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the sparse implementation of the * SUNMATRIX module, SUNMATRIX_SPARSE. * * Notes: * - The definition of the generic SUNMatrix structure can be found * in the header file sundials_matrix.h. * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype' and 'indextype'. * ----------------------------------------------------------------- */ #ifndef _SUNMATRIX_SPARSE_H #define _SUNMATRIX_SPARSE_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ------------------------ * Matrix Type Definitions * ------------------------ */ #define CSC_MAT 0 #define CSR_MAT 1 /* ------------------------------------------ * Sparse Implementation of SUNMATRIX_SPARSE * ------------------------------------------ */ struct _SUNMatrixContent_Sparse { sunindextype M; sunindextype N; sunindextype NNZ; sunindextype NP; realtype *data; int sparsetype; sunindextype *indexvals; sunindextype *indexptrs; /* CSC indices */ sunindextype **rowvals; sunindextype **colptrs; /* CSR indices */ sunindextype **colvals; sunindextype **rowptrs; }; typedef struct _SUNMatrixContent_Sparse *SUNMatrixContent_Sparse; /* --------------------------------------- * Macros for access to SUNMATRIX_SPARSE * --------------------------------------- */ #define SM_CONTENT_S(A) ( (SUNMatrixContent_Sparse)(A->content) ) #define SM_ROWS_S(A) ( SM_CONTENT_S(A)->M ) #define SM_COLUMNS_S(A) ( SM_CONTENT_S(A)->N ) #define SM_NNZ_S(A) ( SM_CONTENT_S(A)->NNZ ) #define SM_NP_S(A) ( SM_CONTENT_S(A)->NP ) #define SM_SPARSETYPE_S(A) ( SM_CONTENT_S(A)->sparsetype ) #define SM_DATA_S(A) ( SM_CONTENT_S(A)->data ) #define SM_INDEXVALS_S(A) ( SM_CONTENT_S(A)->indexvals ) #define SM_INDEXPTRS_S(A) ( SM_CONTENT_S(A)->indexptrs ) /* ---------------------------------------- * Exported Functions for SUNMATRIX_SPARSE * ---------------------------------------- */ SUNDIALS_EXPORT SUNMatrix SUNSparseMatrix(sunindextype M, sunindextype N, sunindextype NNZ, int sparsetype); SUNDIALS_EXPORT SUNMatrix SUNSparseFromDenseMatrix(SUNMatrix A, realtype droptol, int sparsetype); SUNDIALS_EXPORT SUNMatrix SUNSparseFromBandMatrix(SUNMatrix A, realtype droptol, int sparsetype); SUNDIALS_EXPORT int SUNSparseMatrix_Realloc(SUNMatrix A); SUNDIALS_EXPORT int SUNSparseMatrix_Reallocate(SUNMatrix A, sunindextype NNZ); SUNDIALS_EXPORT void SUNSparseMatrix_Print(SUNMatrix A, FILE* outfile); SUNDIALS_EXPORT sunindextype SUNSparseMatrix_Rows(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNSparseMatrix_Columns(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNSparseMatrix_NNZ(SUNMatrix A); SUNDIALS_EXPORT sunindextype SUNSparseMatrix_NP(SUNMatrix A); SUNDIALS_EXPORT int SUNSparseMatrix_SparseType(SUNMatrix A); SUNDIALS_EXPORT realtype* SUNSparseMatrix_Data(SUNMatrix A); SUNDIALS_EXPORT sunindextype* SUNSparseMatrix_IndexValues(SUNMatrix A); SUNDIALS_EXPORT sunindextype* SUNSparseMatrix_IndexPointers(SUNMatrix A); SUNDIALS_EXPORT SUNMatrix_ID SUNMatGetID_Sparse(SUNMatrix A); SUNDIALS_EXPORT SUNMatrix SUNMatClone_Sparse(SUNMatrix A); SUNDIALS_EXPORT void SUNMatDestroy_Sparse(SUNMatrix A); SUNDIALS_EXPORT int SUNMatZero_Sparse(SUNMatrix A); SUNDIALS_EXPORT int SUNMatCopy_Sparse(SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT int SUNMatScaleAdd_Sparse(realtype c, SUNMatrix A, SUNMatrix B); SUNDIALS_EXPORT int SUNMatScaleAddI_Sparse(realtype c, SUNMatrix A); SUNDIALS_EXPORT int SUNMatMatvec_Sparse(SUNMatrix A, N_Vector x, N_Vector y); SUNDIALS_EXPORT int SUNMatSpace_Sparse(SUNMatrix A, long int *lenrw, long int *leniw); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/0000755000176200001440000000000013766554135016552 5ustar liggesusersStanHeaders/inst/include/nvector/nvector_openmp.h0000644000176200001440000002141213766554457021770 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner and Carol S. Woodward @ LLNL * ----------------------------------------------------------------- * Acknowledgements: This NVECTOR module is based on the NVECTOR * Serial module by Scott D. Cohen, Alan C. * Hindmarsh, Radu Serban, and Aaron Collier * @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the OpenMP implementation of the * NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_OpenMP(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_OPENMP_H #define _NVECTOR_OPENMP_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * OpenMP implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_OpenMP { sunindextype length; /* vector length */ booleantype own_data; /* data ownership flag */ realtype *data; /* data array */ int num_threads; /* number of OpenMP threads */ }; typedef struct _N_VectorContent_OpenMP *N_VectorContent_OpenMP; /* * ----------------------------------------------------------------- * Macros NV_CONTENT_OMP, NV_DATA_OMP, NV_OWN_DATA_OMP, * NV_LENGTH_OMP, and NV_Ith_OMP * ----------------------------------------------------------------- */ #define NV_CONTENT_OMP(v) ( (N_VectorContent_OpenMP)(v->content) ) #define NV_LENGTH_OMP(v) ( NV_CONTENT_OMP(v)->length ) #define NV_NUM_THREADS_OMP(v) ( NV_CONTENT_OMP(v)->num_threads ) #define NV_OWN_DATA_OMP(v) ( NV_CONTENT_OMP(v)->own_data ) #define NV_DATA_OMP(v) ( NV_CONTENT_OMP(v)->data ) #define NV_Ith_OMP(v,i) ( NV_DATA_OMP(v)[i] ) /* * ----------------------------------------------------------------- * Functions exported by nvector_openmp * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_OpenMP(sunindextype vec_length, int num_threads); SUNDIALS_EXPORT N_Vector N_VNewEmpty_OpenMP(sunindextype vec_length, int num_threads); SUNDIALS_EXPORT N_Vector N_VMake_OpenMP(sunindextype vec_length, realtype *v_data, int num_threads); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_OpenMP(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_OpenMP(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_OpenMP(N_Vector *vs, int count); SUNDIALS_EXPORT sunindextype N_VGetLength_OpenMP(N_Vector v); SUNDIALS_EXPORT void N_VPrint_OpenMP(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_OpenMP(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_OpenMP(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_OpenMP(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_OpenMP(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_OpenMP(N_Vector v); SUNDIALS_EXPORT void N_VSpace_OpenMP(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_OpenMP(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_OpenMP(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_OpenMP(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_OpenMP(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_OpenMP(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_OpenMP(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_OpenMP(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_OpenMP(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_OpenMP(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_OpenMP(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_OpenMP(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_OpenMP(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_OpenMP(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_OpenMP(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_OpenMP(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_OpenMP(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_OpenMP(N_Vector x); SUNDIALS_EXPORT void N_VCompare_OpenMP(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_OpenMP(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_OpenMP(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_OpenMP(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_OpenMP(int nvec, realtype* c, N_Vector* V, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_OpenMP(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_OpenMP(int nvec, N_Vector x, N_Vector *Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_OpenMP(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_OpenMP(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_OpenMP(int nvecs, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_OpenMP(int nvecs, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_OpenMP(int nvecs, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_OpenMP(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_OpenMP(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_OpenMP(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_OpenMP(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_petsc.h0000644000176200001440000001766213766554457021624 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the main header file for the PETSc vector wrapper * for NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be * found in the header file sundials_nvector.h. * * - The definition of the type realtype can be found in the * header file sundials_types.h, and it may be changed (at the * build configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type booleantype. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Petsc(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_PETSC_H #define _NVECTOR_PETSC_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * PETSc implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_Petsc { sunindextype local_length; /* copy of local vector length */ sunindextype global_length; /* copy of global vector length */ booleantype own_data; /* ownership of data */ Vec pvec; /* the PETSc Vec object */ MPI_Comm comm; /* copy of MPI communicator */ }; typedef struct _N_VectorContent_Petsc *N_VectorContent_Petsc; /* * ----------------------------------------------------------------- * Functions exported by nvector_petsc * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNewEmpty_Petsc(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VMake_Petsc(Vec v); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Petsc(N_Vector v); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Petsc(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Petsc(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_Petsc(N_Vector *vs, int count); SUNDIALS_EXPORT Vec N_VGetVector_Petsc(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Petsc(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Petsc(N_Vector v, const char fname[]); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Petsc(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Petsc(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Petsc(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Petsc(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Petsc(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT void N_VSetArrayPointer_Petsc(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Petsc(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Petsc(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Petsc(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Petsc(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Petsc(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Petsc(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Petsc(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Petsc(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Petsc(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Petsc(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Petsc(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Petsc(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Petsc(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Petsc(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Petsc(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Petsc(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Petsc(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Petsc(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Petsc(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Petsc(int nvec, realtype* c, N_Vector* X, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_Petsc(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_Petsc(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Petsc(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Petsc(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Petsc(int nvecs, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Petsc(int nvecs, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Petsc(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Petsc(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Petsc(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Petsc(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Petsc(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif /* _NVECTOR_PETSC_H */ StanHeaders/inst/include/nvector/nvector_trilinos.h0000644000176200001440000001125513766554457022341 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the main header file for the Trilinos vector wrapper * for NVECTOR module. * * Part I contains declarations specific to the Trilinos vector wrapper * implementation. * * Part II contains the prototype for the constructor * N_VMake_Trilinos as well as Trilinos-specific prototypes * for various useful vector operations. * * Notes: * * - The definition of the generic N_Vector structure can be * found in the header file sundials_nvector.h. * * - The definition of the type realtype can be found in the * header file sundials_types.h, and it may be changed (at the * build configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type booleantype. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Trilinos(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_TRILINOS_H #define _NVECTOR_TRILINOS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * PART I: N_Vector interface to Trilinos vector * ----------------------------------------------------------------- */ /* * Dummy _N_VectorContent_Trilinos structure is used for * interfacing C with C++ code */ struct _N_VectorContent_Trilinos {}; typedef struct _N_VectorContent_Trilinos *N_VectorContent_Trilinos; /* * ----------------------------------------------------------------- * PART II: functions exported by nvector_Trilinos * * CONSTRUCTORS: * N_VNewEmpty_Trilinos * ----------------------------------------------------------------- */ /* * ----------------------------------------------------------------- * Function : N_VNewEmpty_Trilinos * ----------------------------------------------------------------- * This function creates a new N_Vector wrapper for a Trilinos * vector. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNewEmpty_Trilinos(); /* * ----------------------------------------------------------------- * Trilinos implementations of the vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Trilinos(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Trilinos(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Trilinos(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Trilinos(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Trilinos(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT void N_VLinearSum_Trilinos(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Trilinos(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Trilinos(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Trilinos(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Trilinos(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Trilinos(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Trilinos(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Trilinos(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Trilinos(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Trilinos(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Trilinos(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Trilinos(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Trilinos(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Trilinos(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Trilinos(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Trilinos(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Trilinos(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Trilinos(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Trilinos(N_Vector num, N_Vector denom); #ifdef __cplusplus } #endif #endif /* _NVECTOR_TRILINOS_H */ StanHeaders/inst/include/nvector/cuda/0000755000176200001440000000000013766554135017466 5ustar liggesusersStanHeaders/inst/include/nvector/cuda/Vector.hpp0000644000176200001440000001437513766554457021462 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Slaven Peles, and Cody J. Balos @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- */ /* * Vector class * * Manages vector data layout for CUDA implementation of N_Vector. * */ #ifndef _NVECTOR_CUDA_HPP_ #define _NVECTOR_CUDA_HPP_ #include #include #include #include "ThreadPartitioning.hpp" #include #include #if SUNDIALS_MPI_ENABLED #include #else #include #endif namespace suncudavec { template class Vector : public _N_VectorContent_Cuda { public: Vector(I N, bool use_managed_memory = false, bool allocate_data = true, T* const h_vec = nullptr, T* const d_vec = nullptr) : size_(N), mem_size_(N*sizeof(T)), global_size_(N), ownPartitioning_(true), ownData_(allocate_data), managed_mem_(use_managed_memory), h_vec_(h_vec), d_vec_(d_vec), comm_(0) { // Set partitioning partStream_ = new StreamPartitioning(N, 256); partReduce_ = new ReducePartitioning(N, 256); // Allocate data arrays if (allocate_data) allocate(); } Vector(I N, cudaStream_t stream, bool use_managed_memory = false, bool allocate_data = true, T* const h_vec = nullptr, T* const d_vec = nullptr) : size_(N), mem_size_(N*sizeof(T)), global_size_(N), ownPartitioning_(true), ownData_(allocate_data), managed_mem_(use_managed_memory), h_vec_(h_vec), d_vec_(d_vec), comm_(0) { // Set partitioning partStream_ = new StreamPartitioning(N, 256, stream); partReduce_ = new ReducePartitioning(N, 256, stream); // Allocate data arrays if (allocate_data) allocate(); } Vector(SUNMPI_Comm comm, I N, I Nglobal, bool use_managed_memory = false, bool allocate_data = true, T* const h_vec = nullptr, T* const d_vec = nullptr) : size_(N), mem_size_(N*sizeof(T)), global_size_(Nglobal), ownPartitioning_(true), ownData_(allocate_data), managed_mem_(use_managed_memory), h_vec_(h_vec), d_vec_(d_vec), comm_(comm) { // Set partitioning partStream_ = new StreamPartitioning(N, 256); partReduce_ = new ReducePartitioning(N, 256); // Allocate data arrays if (allocate_data) allocate(); } Vector(SUNMPI_Comm comm, I N, I Nglobal, cudaStream_t stream, bool use_managed_memory = false, bool allocate_data = true, T* const h_vec = nullptr, T* const d_vec = nullptr) : size_(N), mem_size_(N*sizeof(T)), global_size_(Nglobal), ownPartitioning_(true), ownData_(allocate_data), managed_mem_(use_managed_memory), h_vec_(h_vec), d_vec_(d_vec), comm_(comm) { // Set partitioning partStream_ = new StreamPartitioning(N, 256, stream); partReduce_ = new ReducePartitioning(N, 256, stream); // Allocate data arrays if (allocate_data) allocate(); } // Copy constructor does not copy data array values explicit Vector(const Vector& v) : size_(v.size()), mem_size_(size_*sizeof(T)), global_size_(v.global_size_), partStream_(v.partStream_), partReduce_(v.partReduce_), ownPartitioning_(false), ownData_(true), managed_mem_(v.managed_mem_), h_vec_(nullptr), d_vec_(nullptr), comm_(v.comm_) { allocate(); } ~Vector() { cudaError_t err; if (ownPartitioning_) { delete partReduce_; delete partStream_; } if (ownData_) { if (!managed_mem_) free(h_vec_); err = cudaFree(d_vec_); if(err != cudaSuccess) std::cerr << "Failed to free device vector (error code " << err << ")!\n"; d_vec_ = nullptr; h_vec_ = nullptr; } } void allocate() { if (managed_mem_) { allocateManaged(); } else { allocateUnmanaged(); } } void allocateManaged() { cudaError_t err; err = cudaMallocManaged((void**) &d_vec_, mem_size_); if (err != cudaSuccess) std::cerr << "Failed to allocate managed vector (error code " << err << ")!\n"; h_vec_ = d_vec_; } void allocateUnmanaged() { cudaError_t err; h_vec_ = static_cast(malloc(mem_size_)); if(h_vec_ == nullptr) std::cerr << "Failed to allocate host vector!\n"; err = cudaMalloc((void**) &d_vec_, mem_size_); if(err != cudaSuccess) std::cerr << "Failed to allocate device vector (error code " << err << ")!\n"; } int size() const { return size_; } int sizeGlobal() const { return global_size_; } SUNMPI_Comm comm() const { return comm_; } T* host() { return h_vec_; } const T* host() const { return h_vec_; } T* device() { return d_vec_; } const T* device() const { return d_vec_; } bool isManaged() const { return managed_mem_; } void copyToDev() { cudaError_t err = cudaMemcpy(d_vec_, h_vec_, mem_size_, cudaMemcpyHostToDevice); if(err != cudaSuccess) std::cerr << "Failed to copy vector from host to device (error code " << err << ")!\n"; } void copyFromDev() { cudaError_t err = cudaMemcpy(h_vec_, d_vec_, mem_size_, cudaMemcpyDeviceToHost); if(err != cudaSuccess) std::cerr << "Failed to copy vector from device to host (error code " << err << ")!\n"; } ThreadPartitioning& partStream() const { return *partStream_; } ThreadPartitioning& partReduce() const { return *partReduce_; } private: I size_; I mem_size_; I global_size_; T* h_vec_; T* d_vec_; ThreadPartitioning* partStream_; ThreadPartitioning* partReduce_; bool ownPartitioning_; bool ownData_; bool managed_mem_; SUNMPI_Comm comm_; }; } // namespace suncudavec #endif // _NVECTOR_CUDA_HPP_ StanHeaders/inst/include/nvector/cuda/VectorKernels.cuh0000644000176200001440000006325713766554457023001 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- */ #ifndef _VECTOR_KERNELS_CUH_ #define _VECTOR_KERNELS_CUH_ #include #include namespace suncudavec { /* ----------------------------------------------------------------- * The namespace for CUDA kernels * * Reduction CUDA kernels in nvector are based in part on "reduction" * example in NVIDIA Corporation CUDA Samples, and parallel reduction * examples in textbook by J. Cheng at al. "CUDA C Programming". * ----------------------------------------------------------------- */ namespace math_kernels { /* * Sets all elements of the vector X to constant value a. * */ template __global__ void setConstKernel(T a, T *X, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { X[i] = a; } } /* * Computes linear sum (combination) of two vectors. * */ template __global__ void linearSumKernel(T a, const T *X, T b, const T *Y, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = a*X[i] + b*Y[i]; } } /* * Elementwise product of two vectors. * */ template __global__ void prodKernel(const T *X, const T *Y, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = X[i]*Y[i]; } } /* * Elementwise division of two vectors. * */ template __global__ void divKernel(const T *X, const T *Y, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = X[i]/Y[i]; } } /* * Scale vector with scalar value 'a'. * */ template __global__ void scaleKernel(T a, const T *X, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = a*X[i]; } } /* * Stores absolute values of vector X elements into vector Z. * */ template __global__ void absKernel(const T *X, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = abs(X[i]); } } /* * Elementwise inversion. * */ template __global__ void invKernel(const T *X, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = 1.0/(X[i]); } } /* * Add constant 'c' to each vector element. * */ template __global__ void addConstKernel(T a, const T *X, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = a + X[i]; } } /* * Compare absolute values of vector 'X' with constant 'c'. * */ template __global__ void compareKernel(T c, const T *X, T *Z, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { Z[i] = (abs(X[i]) >= c) ? 1.0 : 0.0; } } /* * Sums all elements of the vector. * */ template __global__ void sumReduceKernel(const T *x, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T sum = 0.0; // First reduction step before storing data in shared memory. if (i < n) sum = x[i]; if (i + blockDim.x < n) sum += x[i+blockDim.x]; shmem[tid] = sum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { sum += shmem[tid + j]; shmem[tid] = sum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = sum; } /* * Dot product of two vectors. * */ template __global__ void dotProdKernel(const T *x, const T *y, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T sum = 0.0; // First reduction step before storing data in shared memory. if (i < n) sum = x[i] * y[i]; if (i + blockDim.x < n) sum += ( x[i+blockDim.x] * y[i+blockDim.x]); shmem[tid] = sum; __syncthreads(); // Perform blockwise reduction in shared memory for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { sum += shmem[tid + j]; shmem[tid] = sum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = sum; } /* * Finds max norm the vector. * */ template __global__ void maxNormKernel(const T *x, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T maximum = 0.0; // First reduction step before storing data in shared memory. if (i < n) maximum = abs(x[i]); if (i + blockDim.x < n) maximum = max(abs(x[i+blockDim.x]), maximum); shmem[tid] = maximum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { maximum = max(shmem[tid + j], maximum); shmem[tid] = maximum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = maximum; } /* * Weighted L2 norm squared. * */ template __global__ void wL2NormSquareKernel(const T *x, const T *w, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T sum = 0.0; // First reduction step before storing data in shared memory. if (i < n) sum = x[i] * w[i] * x[i] * w[i]; if (i + blockDim.x < n) sum += ( x[i+blockDim.x] * w[i+blockDim.x] * x[i+blockDim.x] * w[i+blockDim.x] ); shmem[tid] = sum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { sum += shmem[tid + j]; shmem[tid] = sum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = sum; } /* * Weighted L2 norm squared with mask. Vector id specifies the mask. * */ template __global__ void wL2NormSquareMaskKernel(const T *x, const T *w, const T *id, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T sum = 0.0; // First reduction step before storing data in shared memory. if (i < n && id[i] > 0.0) sum = x[i] * w[i] * x[i] * w[i]; if ((i + blockDim.x < n) && (id[i+blockDim.x] > 0.0)) sum += ( x[i+blockDim.x] * w[i+blockDim.x] * x[i+blockDim.x] * w[i+blockDim.x]); shmem[tid] = sum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { sum += shmem[tid + j]; shmem[tid] = sum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = sum; } /* * Finds min value in the vector. * */ template __global__ void findMinKernel(T MAX_VAL, const T *x, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T minimum = MAX_VAL; // First reduction step before storing data in shared memory. if (i < n) minimum = x[i]; if (i + blockDim.x < n) minimum = min((x[i+blockDim.x]), minimum); shmem[tid] = minimum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { minimum = min(shmem[tid + j], minimum); shmem[tid] = minimum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = minimum; } /* * Computes L1 norm of vector * */ template __global__ void L1NormKernel(const T *x, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T sum = 0.0; // First reduction step before storing data in shared memory. if (i < n) sum = abs(x[i]); if (i + blockDim.x < n) sum += abs(x[i+blockDim.x]); shmem[tid] = sum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { sum += shmem[tid + j]; shmem[tid] = sum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = sum; } /* * Vector inverse z[i] = 1/x[i] with check for zeros. Reduction is performed * to flag the result if any x[i] = 0. * */ template __global__ void invTestKernel(const T *x, T *z, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T flag = 0.0; // First reduction step before storing data in shared memory. if (i < n) { if (x[i] == 0.0) { flag = 1.0; } else { flag = 0.0; z[i] = 1.0/x[i]; } } if (i + blockDim.x < n) { if (x[i + blockDim.x] == 0.0) { flag += 1.0; } else { z[i + blockDim.x] = 1.0/x[i + blockDim.x]; } } shmem[tid] = flag; __syncthreads(); // Inverse calculation is done. Perform reduction block-wise in shared // to find if any x[i] = 0. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { flag += shmem[tid + j]; shmem[tid] = flag; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = flag; } /* * Checks if inequality constraints are satisfied. Constraint check * results are stored in vector 'm'. A sum reduction over all elements * of 'm' is performed to find if any of the constraints is violated. * If all constraints are satisfied sum == 0. * */ template __global__ void constrMaskKernel(const T *c, const T *x, T *m, T *out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; T sum = 0.0; // First reduction step before storing data in shared memory. if (i < n){ // test1 = true if constraints violated bool test1 = (std::abs(c[i]) > 1.5 && c[i]*x[i] <= 0.0) || (std::abs(c[i]) > 0.5 && c[i]*x[i] < 0.0); m[i] = test1 ? 1.0 : 0.0; sum = m[i]; } if (i + blockDim.x < n) { // test2 = true if constraints violated bool test2 = (std::abs(c[i + blockDim.x]) > 1.5 && c[i + blockDim.x]*x[i + blockDim.x] <= 0.0) || (std::abs(c[i + blockDim.x]) > 0.5 && c[i + blockDim.x]*x[i + blockDim.x] < 0.0); m[i+blockDim.x] = test2 ? 1.0 : 0.0; sum += m[i+blockDim.x]; } shmem[tid] = sum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { sum += shmem[tid + j]; shmem[tid] = sum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) out[blockIdx.x] = sum; } /* * Finds minimum component-wise quotient. * */ template __global__ void minQuotientKernel(const T MAX_VAL, const T *num, const T *den, T *min_quotient, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; // Initialize "minimum" to maximum floating point value. T minimum = MAX_VAL; const T zero = static_cast(0.0); // Load vector quotient in the shared memory. Skip if the denominator // value is zero. if (i < n && den[i] != zero) minimum = num[i]/den[i]; // First level of reduction is upon storing values to shared memory. if (i + blockDim.x < n && den[i + blockDim.x] != zero) minimum = min(num[i+blockDim.x]/den[i+blockDim.x], minimum); shmem[tid] = minimum; __syncthreads(); // Perform reduction block-wise in shared memory. for (I j = blockDim.x/2; j > 0; j >>= 1) { if (tid < j) { minimum = min(shmem[tid + j], minimum); shmem[tid] = minimum; } __syncthreads(); } // Copy reduction result for each block to global memory if (tid == 0) min_quotient[blockIdx.x] = minimum; } } // namespace math_kernels template inline cudaError_t setConst(T a, Vector& X) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::setConstKernel<<>>(a, X.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t linearSum(T a, const Vector& X, T b, const Vector& Y, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::linearSumKernel<<>>(a, X.device(), b, Y.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t prod(const Vector& X, const Vector& Y, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::prodKernel<<>>(X.device(), Y.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t div(const Vector& X, const Vector& Y, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::divKernel<<>>(X.device(), Y.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t scale(T const a, const Vector& X, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::scaleKernel<<>>(a, X.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t absVal(const Vector& X, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::absKernel<<>>(X.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t inv(const Vector& X, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::invKernel<<>>(X.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t addConst(T const a, const Vector& X, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::addConstKernel<<>>(a, X.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline cudaError_t compare(T const c, const Vector& X, Vector& Z) { // Set partitioning ThreadPartitioning& p = X.partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::compareKernel<<>>(c, X.device(), Z.device(), X.size()); return cudaGetLastError(); } template inline T dotProd(const Vector& x, const Vector& y) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::dotProdKernel<<>>(x.device(), y.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::sumReduceKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T maxNorm(const Vector& x) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::maxNormKernel<<>>(x.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // (Re)run reduction kernel math_kernels::maxNormKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i gpu_result) gpu_result = p.hostBuffer()[i]; } return gpu_result; } template inline T wL2NormSquareMask(const Vector& x, const Vector& w, const Vector& id) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::wL2NormSquareMaskKernel<<>>(x.device(), w.device(), id.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // (Re)run reduction kernel math_kernels::sumReduceKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T findMin(const Vector& x) { T maxVal = std::numeric_limits::max(); // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::findMinKernel<<>>(maxVal, x.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::findMinKernel<<>>(maxVal, p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T wL2NormSquare(const Vector& x, const Vector& y) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::wL2NormSquareKernel<<>>(x.device(), y.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::sumReduceKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T L1Norm(const Vector& x) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::L1NormKernel<<>>(x.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::sumReduceKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T invTest(const Vector& x, Vector& z) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::invTestKernel<<>>(x.device(), z.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::sumReduceKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T constrMask(const Vector& c, const Vector& x, Vector& m) { // Set partitioning ThreadPartitioning& p = x.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::constrMaskKernel<<>>(c.device(), x.device(), m.device(), p.devBuffer(), x.size()); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::sumReduceKernel<<>>(p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i inline T minQuotient(const Vector& num, const Vector& den) { // Starting value for min reduction const T maxVal = std::numeric_limits::max(); // Set partitioning ThreadPartitioning& p = num.partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = p.shmem(); const cudaStream_t stream = p.stream(); math_kernels::minQuotientKernel<<>>(maxVal, num.device(), den.device(), p.devBuffer(), num.size()); // All quotients are computed by now. Find the minimum. unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning p.setPartitioning(n, grid, block, shMemSize); // Rerun reduction kernel math_kernels::findMinKernel<<>>(maxVal, p.devBuffer(), p.devBuffer(), n); n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. p.copyFromDevBuffer(n); T gpu_result = p.hostBuffer()[0]; for (unsigned int i=1; i #include namespace suncudavec { /* ----------------------------------------------------------------- * The namespace for CUDA kernels * * Reduction CUDA kernels in nvector are based in part on "reduction" * example in NVIDIA Corporation CUDA Samples, and parallel reduction * examples in textbook by J. Cheng at al. "CUDA C Programming". * ----------------------------------------------------------------- */ namespace math_kernels { /* * ----------------------------------------------------------------------------- * fused vector operation kernels * ----------------------------------------------------------------------------- */ /* * Computes the linear combination of nv vectors */ template __global__ void linearCombinationKernel(int nv, T* c, T** xd, T* zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { zd[i] = c[0]*xd[0][i]; for (int j=1; j __global__ void scaleAddMultiKernel(int nv, T* c, T* xd, T** yd, T** zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) for (int j=0; j __global__ void dotProdMultiKernel(int nv, T* xd, T** yd, T* out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; // Initialize shared memory to zero for (int k=0; k 0; j >>= 1) { if (tid < j) for (int k=0; k __global__ void sumReduceVectorKernel(int nv, T* x, T* out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; // First reduction step before storing data in shared memory. if (i < n) for (int k=0; k 0; j >>= 1) { if (tid < j) for (int k=0; k __global__ void linearSumVectorArrayKernel(int nv, T a, T** xd, T b, T** yd, T** zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) for (int j=0; j __global__ void scaleVectorArrayKernel(int nv, T* c, T** xd, T** zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) for (int j=0; j __global__ void constVectorArrayKernel(int nv, T c, T** zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) for (int j=0; j __global__ void wL2NormSquareVectorArrayKernel(int nv, T** xd, T** wd, T* out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; // Initialize shared memory to zero for (int k=0; k 0; j >>= 1) { if (tid < j) for (int k=0; k __global__ void wL2NormSquareMaskVectorArrayKernel(int nv, T** xd, T** wd, T* id, T* out, I n) { extern __shared__ T shmem[]; I tid = threadIdx.x; I i = blockIdx.x*(blockDim.x*2) + threadIdx.x; // Initialize shared memory to zero for (int k=0; k 0.0) for (int k=0; k 0.0) for (int k=0; k 0; j >>= 1) { if (tid < j) for (int k=0; k __global__ void scaleAddMultiVectorArrayKernel(int nv, int ns, T* c, T** xd, T** yd, T** zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) for (int k=0; k __global__ void linearCombinationVectorArrayKernel(int nv, int ns, T* c, T** xd, T** zd, I n) { I i = blockDim.x * blockIdx.x + threadIdx.x; if (i < n) { for (int k=0; k inline cudaError_t linearCombination(int nvec, T* c, Vector** X, Vector* Z) { cudaError_t err; // Copy c array to device T* d_c; err = cudaMalloc((void**) &d_c, nvec*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_c, c, nvec*sizeof(T), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Create array of device pointers on host T** h_Xd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = X[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::linearCombinationKernel<<>>( nvec, d_c, d_Xd, Z->device(), Z->size() ); // Free host array delete[] h_Xd; // Free device arrays err = cudaFree(d_c); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Xd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } template inline cudaError_t scaleAddMulti(int nvec, T* c, Vector* X, Vector** Y, Vector** Z) { cudaError_t err; // Copy c array to device T* d_c; err = cudaMalloc((void**) &d_c, nvec*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_c, c, nvec*sizeof(T), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Create array of device pointers on host T** h_Yd = new T*[nvec]; for (int i=0; idevice(); T** h_Zd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Yd; err = cudaMalloc((void**) &d_Yd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Yd, h_Yd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Zd; err = cudaMalloc((void**) &d_Zd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Zd, h_Zd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = Z[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::scaleAddMultiKernel<<>>( nvec, d_c, X->device(), d_Yd, d_Zd, X->size() ); // Free host array delete[] h_Yd; delete[] h_Zd; // Free device arrays err = cudaFree(d_c); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Yd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Zd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } template inline cudaError_t dotProdMulti(int nvec, Vector* x, Vector** Y, T* dots) { cudaError_t err; // Create array of device pointers on host T** h_Yd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Yd; err = cudaMalloc((void**) &d_Yd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Yd, h_Yd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = x->partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = nvec*block*sizeof(T); const cudaStream_t stream = p.stream(); // Allocate reduction buffer on device T* d_buff; err = cudaMalloc((void**) &d_buff, nvec*grid*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); math_kernels::dotProdMultiKernel<<>>( nvec, x->device(), d_Yd, d_buff, x->size() ); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning grid = (n + block - 1)/block; // Rerun reduction kernel math_kernels::sumReduceVectorKernel<<>>( nvec, d_buff, d_buff, n ); // update buffer array working length n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. T* h_buff = new T[nvec*n*sizeof(T)]; err = cudaMemcpy(h_buff, d_buff, nvec*n*sizeof(T), cudaMemcpyDeviceToHost); if (err != cudaSuccess) return cudaGetLastError(); for (int k=0; k inline cudaError_t linearSumVectorArray(int nvec, T a, Vector** X, T b, Vector** Y, Vector** Z) { cudaError_t err; // Create array of device pointers on host T** h_Xd = new T*[nvec]; for (int i=0; idevice(); T** h_Yd = new T*[nvec]; for (int i=0; idevice(); T** h_Zd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Yd; err = cudaMalloc((void**) &d_Yd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Yd, h_Yd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Zd; err = cudaMalloc((void**) &d_Zd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Zd, h_Zd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = Z[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::linearSumVectorArrayKernel<<>>( nvec, a, d_Xd, b, d_Yd, d_Zd, Z[0]->size() ); // Free host array delete[] h_Xd; delete[] h_Yd; delete[] h_Zd; // Free device arrays err = cudaFree(d_Xd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Yd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Zd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } template inline cudaError_t scaleVectorArray(int nvec, T* c, Vector** X, Vector** Z) { cudaError_t err; // Copy c array to device T* d_c; err = cudaMalloc((void**) &d_c, nvec*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_c, c, nvec*sizeof(T), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Create array of device pointers on host T** h_Xd = new T*[nvec]; for (int i=0; idevice(); T** h_Zd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Zd; err = cudaMalloc((void**) &d_Zd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Zd, h_Zd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = Z[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::scaleVectorArrayKernel<<>>( nvec, d_c, d_Xd, d_Zd, Z[0]->size() ); // Free host array delete[] h_Xd; delete[] h_Zd; // Free device arrays err = cudaFree(d_Xd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Zd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } template inline cudaError_t constVectorArray(int nvec, T c, Vector** Z) { cudaError_t err; // Create array of device pointers on host T** h_Zd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Zd; err = cudaMalloc((void**) &d_Zd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Zd, h_Zd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = Z[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::constVectorArrayKernel<<>>( nvec, c, d_Zd, Z[0]->size() ); // Free host array delete[] h_Zd; // Free device arrays err = cudaFree(d_Zd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } template inline cudaError_t wL2NormSquareVectorArray(int nvec, Vector** X, Vector** W, T* nrm) { cudaError_t err; // Create array of device pointers on host T** h_Xd = new T*[nvec]; for (int i=0; idevice(); T** h_Wd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Wd; err = cudaMalloc((void**) &d_Wd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Wd, h_Wd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = X[0]->partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = nvec*block*sizeof(T); const cudaStream_t stream = p.stream(); // Allocate reduction buffer on device T* d_buff; err = cudaMalloc((void**) &d_buff, nvec*grid*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); math_kernels::wL2NormSquareVectorArrayKernel<<>>( nvec, d_Xd, d_Wd, d_buff, X[0]->size() ); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning grid = (n + block - 1)/block; // Rerun reduction kernel math_kernels::sumReduceVectorKernel<<>>( nvec, d_buff, d_buff, n ); // update buffer array working length n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. T* h_buff = new T[nvec*n*sizeof(T)]; err = cudaMemcpy(h_buff, d_buff, nvec*n*sizeof(T), cudaMemcpyDeviceToHost); if (err != cudaSuccess) return cudaGetLastError(); for (int k=0; k inline cudaError_t wL2NormSquareMaskVectorArray(int nvec, Vector** X, Vector** W, Vector* ID, T* nrm) { cudaError_t err; // Create array of device pointers on host T** h_Xd = new T*[nvec]; for (int i=0; idevice(); T** h_Wd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Wd; err = cudaMalloc((void**) &d_Wd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Wd, h_Wd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = X[0]->partReduce(); unsigned grid = p.grid(); unsigned block = p.block(); unsigned shMemSize = nvec*block*sizeof(T); const cudaStream_t stream = p.stream(); // Allocate reduction buffer on device T* d_buff; err = cudaMalloc((void**) &d_buff, nvec*grid*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); math_kernels::wL2NormSquareMaskVectorArrayKernel<<>>( nvec, d_Xd, d_Wd, ID->device(), d_buff, X[0]->size() ); unsigned n = grid; unsigned nmax = 2*block; while (n > nmax) { // Recompute partitioning grid = (n + block - 1)/block; // Rerun reduction kernel math_kernels::sumReduceVectorKernel<<>>( nvec, d_buff, d_buff, n ); // update buffer array working length n = grid; } // Finish reduction on CPU if there are less than two blocks of data left. T* h_buff = new T[nvec*n*sizeof(T)]; err = cudaMemcpy(h_buff, d_buff, nvec*n*sizeof(T), cudaMemcpyDeviceToHost); if (err != cudaSuccess) return cudaGetLastError(); for (int k=0; k inline cudaError_t scaleAddMultiVectorArray(int nvec, int nsum, T* c, Vector** X, Vector** Y, Vector** Z) { cudaError_t err; // Copy c array to device T* d_c; err = cudaMalloc((void**) &d_c, nsum*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_c, c, nsum*sizeof(T), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Create array of device pointers on host T** h_Xd = new T*[nvec]; for (int i=0; idevice(); T** h_Yd = new T*[nsum*nvec]; for (int i=0; idevice(); T** h_Zd = new T*[nsum*nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Yd; err = cudaMalloc((void**) &d_Yd, nsum*nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Yd, h_Yd, nsum*nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Zd; err = cudaMalloc((void**) &d_Zd, nsum*nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Zd, h_Zd, nsum*nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = Z[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::scaleAddMultiVectorArrayKernel<<>>( nvec, nsum, d_c, d_Xd, d_Yd, d_Zd, Z[0]->size() ); // Free host array delete[] h_Xd; delete[] h_Yd; delete[] h_Zd; // Free device arrays err = cudaFree(d_Xd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Yd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Zd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } template inline cudaError_t linearCombinationVectorArray(int nvec, int nsum, T* c, Vector** X, Vector** Z) { cudaError_t err; // Copy c array to device T* d_c; err = cudaMalloc((void**) &d_c, nsum*sizeof(T)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_c, c, nsum*sizeof(T), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Create array of device pointers on host T** h_Xd = new T*[nsum*nvec]; for (int i=0; idevice(); T** h_Zd = new T*[nvec]; for (int i=0; idevice(); // Copy array of device pointers to device from host T** d_Xd; err = cudaMalloc((void**) &d_Xd, nsum*nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Xd, h_Xd, nsum*nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); T** d_Zd; err = cudaMalloc((void**) &d_Zd, nvec*sizeof(T*)); if (err != cudaSuccess) return cudaGetLastError(); err = cudaMemcpy(d_Zd, h_Zd, nvec*sizeof(T*), cudaMemcpyHostToDevice); if (err != cudaSuccess) return cudaGetLastError(); // Set partitioning ThreadPartitioning& p = Z[0]->partStream(); const I grid = p.grid(); const unsigned block = p.block(); const cudaStream_t stream = p.stream(); math_kernels::linearCombinationVectorArrayKernel<<>>( nvec, nsum, d_c, d_Xd, d_Zd, Z[0]->size() ); // Free host array delete[] h_Xd; delete[] h_Zd; // Free device arrays err = cudaFree(d_Xd); if (err != cudaSuccess) return cudaGetLastError(); err = cudaFree(d_Zd); if (err != cudaSuccess) return cudaGetLastError(); return cudaGetLastError(); } } // namespace nvec #endif // _VECTOR_ARRAY_KERNELS_CUH_ StanHeaders/inst/include/nvector/cuda/ThreadPartitioning.hpp0000644000176200001440000001654613766554457024021 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- */ #ifndef _THREAD_PARTITIONING_HPP_ #define _THREAD_PARTITIONING_HPP_ #include #include namespace suncudavec { template class ThreadPartitioning { public: ThreadPartitioning() : block_(1), grid_(1), shMemSize_(0), stream_(0), bufferSize_(0), d_buffer_(nullptr), h_buffer_(nullptr) {} ThreadPartitioning(unsigned block) : block_(block), grid_(1), shMemSize_(0), stream_(0), bufferSize_(0), d_buffer_(nullptr), h_buffer_(nullptr) {} explicit ThreadPartitioning(ThreadPartitioning& p) : block_(p.block_), grid_(p.grid_), shMemSize_(p.shMemSize_), stream_(p.stream_) {} virtual ~ThreadPartitioning(){} unsigned grid() const { return grid_; } unsigned block() const { return block_; } unsigned shmem() const { return shMemSize_; } cudaStream_t stream() const { return stream_; } unsigned int buffSize() { return bufferSize_; } T* devBuffer() { return d_buffer_; } const T* devBuffer() const { return d_buffer_; } T* hostBuffer() { return h_buffer_; } const T* hostBuffer() const { return h_buffer_; } void setStream(const cudaStream_t& stream) { stream_ = stream; } virtual void copyFromDevBuffer(unsigned int n) const { std::cerr << "Trying to copy buffer from base class!\n"; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize, cudaStream_t& stream) { block = 1; grid = 1; shMemSize = 0; stream = 0; std::cerr << "Trying to set partitioning from base class!\n"; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize) { block = 1; grid = 1; shMemSize = 0; std::cerr << "Trying to set partitioning from base class!\n"; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, cudaStream_t& stream) { block = 1; grid = 1; stream = 0; std::cerr << "Trying to set partitioning from base class!\n"; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block) { block = 1; grid = 1; std::cerr << "Trying to set partitioning from base class!\n"; return 0; } protected: unsigned block_; unsigned grid_; unsigned shMemSize_; unsigned bufferSize_; cudaStream_t stream_; T* d_buffer_; T* h_buffer_; }; // class ThreadPartitioning template class StreamPartitioning : public ThreadPartitioning { using ThreadPartitioning::block_; using ThreadPartitioning::grid_; using ThreadPartitioning::stream_; public: StreamPartitioning(I N, unsigned block, cudaStream_t stream) : ThreadPartitioning(block) { grid_ = (N + block_ - 1) / block_; stream_ = stream; } StreamPartitioning(I N, unsigned block) : ThreadPartitioning(block) { grid_ = (N + block_ - 1) / block_; } explicit StreamPartitioning(StreamPartitioning& p) : ThreadPartitioning(p) { } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize, cudaStream_t& stream) { block = block_; grid = (N + block_ - 1) / block_; shMemSize = 0; stream = stream_; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize) { block = block_; grid = (N + block_ - 1) / block_; shMemSize = 0; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, cudaStream_t& stream) { block = block_; grid = (N + block_ - 1) / block_; stream = stream_; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block) { block = block_; grid = (N + block_ - 1) / block_; return 0; } }; // class StreamPartitioning template class ReducePartitioning : public ThreadPartitioning { using ThreadPartitioning::block_; using ThreadPartitioning::grid_; using ThreadPartitioning::shMemSize_; using ThreadPartitioning::stream_; using ThreadPartitioning::bufferSize_; using ThreadPartitioning::d_buffer_; using ThreadPartitioning::h_buffer_; public: ReducePartitioning(I N, unsigned block, cudaStream_t stream) : ThreadPartitioning(block) { grid_ = (N + (block_ * 2 - 1)) / (block_ * 2); shMemSize_ = block_*sizeof(T); stream_ = stream; allocateBuffer(); } ReducePartitioning(I N, unsigned block) : ThreadPartitioning(block) { grid_ = (N + (block_ * 2 - 1)) / (block_ * 2); shMemSize_ = block_*sizeof(T); allocateBuffer(); } explicit ReducePartitioning(ReducePartitioning& p) : ThreadPartitioning(p) { shMemSize_ = p.shMemSize_; allocateBuffer(); } ~ReducePartitioning() { cudaError_t err; if (bufferSize_ > 0) free(h_buffer_); if (bufferSize_ > 0) { err = cudaFree(d_buffer_); if(err != cudaSuccess) std::cerr << "Failed to free device vector (error code " << err << ")!\n"; } } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize, cudaStream_t& stream) { block = block_; grid = (N + (block_ * 2 - 1)) / (block_ * 2); shMemSize = block_ * sizeof(T); stream = stream_; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, unsigned& shMemSize) { block = block_; grid = (N + (block_ * 2 - 1)) / (block_ * 2); shMemSize = block_ * sizeof(T); return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block, cudaStream_t& stream) { block = block_; grid = (N + (block_ * 2 - 1)) / (block_ * 2); stream = stream_; return 0; } virtual int setPartitioning(I N, unsigned& grid, unsigned& block) { block = block_; grid = (N + (block_ * 2 - 1)) / (block_ * 2); return 0; } virtual void copyFromDevBuffer(unsigned int n) const { cudaError_t err = cudaMemcpy(h_buffer_, d_buffer_, n*sizeof(T), cudaMemcpyDeviceToHost); if(err != cudaSuccess) std::cerr << "Failed to copy vector from device to host (error code " << err << ")!\n"; } private: int allocateBuffer() { bufferSize_ = grid_ * sizeof(T); h_buffer_ = static_cast(malloc(bufferSize_)); if(h_buffer_ == NULL) std::cerr << "Failed to allocate host vector!\n"; cudaError_t err; err = cudaMalloc((void**) &d_buffer_, bufferSize_); if(err != cudaSuccess) std::cerr << "Failed to allocate device vector (error code " << err << ")!\n"; return 0; } }; // class ReducePartitioning } // namespace suncudavec #endif // _THREAD_PARTITIONING_HPP_ StanHeaders/inst/include/nvector/trilinos/0000755000176200001440000000000013766554135020415 5ustar liggesusersStanHeaders/inst/include/nvector/trilinos/SundialsTpetraVectorInterface.hpp0000644000176200001440000000344413766554457027110 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * -----------------------------------------------------------------*/ #ifndef _TPETRA_SUNDIALS_INTERFACE_HPP_ #define _TPETRA_SUNDIALS_INTERFACE_HPP_ #include #include namespace Sundials { struct TpetraVectorInterface : public _N_VectorContent_Trilinos { // Typedef of Tpetra vector class to be used with SUNDIALS typedef Tpetra::Vector vector_type; TpetraVectorInterface(Teuchos::RCP rcpvec) { rcpvec_ = rcpvec; } ~TpetraVectorInterface() = default; Teuchos::RCP rcpvec_; }; } // namespace Sundials inline Teuchos::RCP N_VGetVector_Trilinos(N_Vector v) { Sundials::TpetraVectorInterface* iface = reinterpret_cast(v->content); return iface->rcpvec_; } /* * ----------------------------------------------------------------- * Function : N_VMake_Trilinos * ----------------------------------------------------------------- * This function attaches N_Vector functions to a Tpetra vector. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VMake_Trilinos(Teuchos::RCP v); #endif // _TPETRA_SUNDIALS_INTERFACE_HPP_ StanHeaders/inst/include/nvector/trilinos/SundialsTpetraVectorKernels.hpp0000644000176200001440000003341513766554457026614 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * -----------------------------------------------------------------*/ #ifndef _TPETRA_SUNDIALS_VECTOR_KERNELS_HPP_ #define _TPETRA_SUNDIALS_VECTOR_KERNELS_HPP_ #include #include #include namespace Sundials { /** * The namespace contains custom Kokkos-based kernels needed by SUNDIALS * * Kernels are inlined in case this file is included in more than one * translation unit. */ namespace TpetraVector { using Teuchos::outArg; using Teuchos::REDUCE_SUM; using Teuchos::REDUCE_MIN; using Teuchos::REDUCE_MAX; using Teuchos::reduceAll; typedef Sundials::TpetraVectorInterface::vector_type vector_type; typedef vector_type::scalar_type scalar_type; typedef vector_type::mag_type mag_type; typedef vector_type::global_ordinal_type global_ordinal_type; typedef vector_type::local_ordinal_type local_ordinal_type; typedef vector_type::node_type::memory_space memory_space; typedef vector_type::execution_space execution_space; static constexpr scalar_type zero = 0; static constexpr scalar_type half = 0.5; static constexpr scalar_type one = 1.0; static constexpr scalar_type onept5 = 1.5; /*---------------------------------------------------------------- * Streaming vector kernels *---------------------------------------------------------------*/ /// Divide: z(i) = x(i)/y(i) forall i inline void elementWiseDivide(const vector_type& x, const vector_type& y, vector_type& z) { const local_ordinal_type N = x.getLocalLength(); if (x.need_sync()) const_cast(x).sync(); if (y.need_sync()) const_cast(y).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto y_2d = y.getLocalView(); auto y_1d = Kokkos::subview (y_2d, Kokkos::ALL(), 0); auto z_2d = z.getLocalView(); auto z_1d = Kokkos::subview (z_2d, Kokkos::ALL(), 0); z.modify(); Kokkos::parallel_for ("elementWiseDivide", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i) { z_1d(i) = x_1d(i)/y_1d(i); } ); } /// Add constant to all vector elements: z(i) = x(i) + b inline void addConst(const vector_type& x, scalar_type b, vector_type& z) { const local_ordinal_type N = x.getLocalLength(); if (x.need_sync()) const_cast(x).sync(); if (z.need_sync()) const_cast(z).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto z_2d = z.getLocalView(); auto z_1d = Kokkos::subview (z_2d, Kokkos::ALL(), 0); z.modify(); Kokkos::parallel_for ("addConst", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i) { z_1d(i) = x_1d(i) + b; } ); } /// Compare vector elements to c: z(i) = |x(i)| >= c ? 1 : 0 inline void compare(scalar_type c, const vector_type& x, vector_type& z) { const local_ordinal_type N = x.getLocalLength(); if (x.need_sync()) const_cast(x).sync(); if (z.need_sync()) const_cast(z).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto z_2d = z.getLocalView(); auto z_1d = Kokkos::subview (z_2d, Kokkos::ALL(), 0); z.modify(); Kokkos::parallel_for ("compare", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i) { z_1d(i) = std::abs(x_1d(i)) >= c ? one : zero; } ); } /*---------------------------------------------------------------- * Reduction vector kernels *---------------------------------------------------------------*/ /// Weighted root-mean-square norm inline mag_type normWrms(const vector_type& x, const vector_type& w) { const Teuchos::RCP >& comm = x.getMap()->getComm(); const local_ordinal_type N = x.getLocalLength(); const global_ordinal_type Nglob = x.getGlobalLength(); if (x.need_sync()) const_cast(x).sync(); if (w.need_sync()) const_cast(w).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto w_2d = w.getLocalView(); auto w_1d = Kokkos::subview (w_2d, Kokkos::ALL(), 0); mag_type sum = zero; Kokkos::parallel_reduce ("normWrms", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, mag_type &local_sum) { local_sum += x_1d(i)*w_1d(i)*(x_1d(i)*w_1d(i)); }, sum); mag_type globalSum = zero; reduceAll(*comm, REDUCE_SUM, sum, outArg(globalSum)); return std::sqrt(globalSum/static_cast(Nglob)); } /// Weighted root-mean-square norm with mask inline mag_type normWrmsMask(const vector_type& x, const vector_type& w, const vector_type& id) { const Teuchos::RCP >& comm = x.getMap()->getComm(); const local_ordinal_type N = x.getLocalLength(); const global_ordinal_type Nglob = x.getGlobalLength(); if (x.need_sync()) const_cast(x).sync(); if (w.need_sync()) const_cast(w).sync(); if (id.need_sync()) const_cast(id).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto w_2d = w.getLocalView(); auto w_1d = Kokkos::subview (w_2d, Kokkos::ALL(), 0); auto id_2d = id.getLocalView(); auto id_1d = Kokkos::subview (id_2d, Kokkos::ALL(), 0); mag_type sum = zero; Kokkos::parallel_reduce ("normWrmsMask", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, mag_type &local_sum) { if (id_1d(i) > zero) local_sum += x_1d(i)*w_1d(i)*(x_1d(i)*w_1d(i)); }, sum); mag_type globalSum = zero; reduceAll(*comm, REDUCE_SUM, sum, outArg(globalSum)); return std::sqrt(globalSum/static_cast(Nglob)); } /// Find minimum element value in the vector inline scalar_type minElement(const vector_type& x) { using namespace Kokkos; const Teuchos::RCP >& comm = x.getMap()->getComm(); const local_ordinal_type N = x.getLocalLength(); if (x.need_sync()) const_cast(x).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); scalar_type minimum; Min min_reducer(minimum); Kokkos::parallel_reduce ("minElement", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, scalar_type &local_min) { min_reducer.join(local_min, x_1d(i)); }, min_reducer); scalar_type globalMin; reduceAll(*comm, REDUCE_MIN, minimum, outArg(globalMin)); return globalMin; } /// Weighted L2 norm inline mag_type normWL2(const vector_type& x, const vector_type& w) { const Teuchos::RCP >& comm = x.getMap()->getComm(); const local_ordinal_type N = x.getLocalLength(); if (x.need_sync()) const_cast(x).sync(); if (w.need_sync()) const_cast(w).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto w_2d = w.getLocalView(); auto w_1d = Kokkos::subview (w_2d, Kokkos::ALL(), 0); mag_type sum = zero; Kokkos::parallel_reduce ("normWL2", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, mag_type &local_sum) { local_sum += x_1d(i)*w_1d(i)*(x_1d(i)*w_1d(i)); }, sum); mag_type globalSum = zero; reduceAll(*comm, REDUCE_SUM, sum, outArg(globalSum)); return std::sqrt(globalSum); } /// Elementwise inverse, return false if any denominator is zero. inline bool invTest(const vector_type& x, vector_type& z) { using namespace Kokkos; const Teuchos::RCP >& comm = x.getMap()->getComm(); const local_ordinal_type N = x.getLocalLength(); if (x.need_sync()) const_cast(x).sync(); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto z_2d = z.getLocalView(); auto z_1d = Kokkos::subview (z_2d, Kokkos::ALL(), 0); scalar_type minimum; Min min_reducer(minimum); z.modify(); Kokkos::parallel_reduce ("invTest", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, scalar_type &local_min) { static constexpr scalar_type zero = 0; static constexpr scalar_type one = 1.0; if (x_1d(i) == zero) { min_reducer.join(local_min, zero); } else { z_1d(i) = one/x_1d(i); } }, min_reducer); scalar_type globalMin; reduceAll(*comm, REDUCE_MIN, minimum, outArg(globalMin)); return (globalMin > half); } /// Find constraint violations inline bool constraintMask(const vector_type& c, const vector_type& x, vector_type& m) { const Teuchos::RCP >& comm = x.getMap()->getComm(); const local_ordinal_type N = x.getLocalLength(); if (c.need_sync()) const_cast(c).sync(); if (x.need_sync()) const_cast(x).sync(); auto c_2d = c.getLocalView(); auto c_1d = Kokkos::subview (c_2d, Kokkos::ALL(), 0); auto x_2d = x.getLocalView(); auto x_1d = Kokkos::subview (x_2d, Kokkos::ALL(), 0); auto m_2d = m.getLocalView(); auto m_1d = Kokkos::subview (m_2d, Kokkos::ALL(), 0); m.modify(); scalar_type sum = zero; Kokkos::parallel_reduce ("constraintMask", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, scalar_type &local_sum) { const bool test = (abs(c_1d(i)) > onept5 && c_1d(i)*x_1d(i) <= zero) || (abs(c_1d(i)) > half && c_1d(i)*x_1d(i) < zero); m_1d(i) = test ? one : zero; local_sum += m_1d(i); }, sum); scalar_type globalSum = zero; reduceAll(*comm, REDUCE_SUM, sum, outArg(globalSum)); return (globalSum < half); } /// Minimum quotient: min_i(num(i)/den(i)) inline scalar_type minQuotient(const vector_type& num, const vector_type& den) { using namespace Kokkos; const Teuchos::RCP >& comm = num.getMap()->getComm(); const local_ordinal_type N = num.getLocalLength(); if (num.need_sync()) const_cast(num).sync(); if (den.need_sync()) const_cast(den).sync(); auto num_2d = num.getLocalView(); auto num_1d = Kokkos::subview (num_2d, Kokkos::ALL(), 0); auto den_2d = den.getLocalView(); auto den_1d = Kokkos::subview (den_2d, Kokkos::ALL(), 0); scalar_type minimum; Min min_reducer(minimum); Kokkos::parallel_reduce ("minQuotient", Kokkos::RangePolicy(0, N), KOKKOS_LAMBDA (const local_ordinal_type &i, scalar_type &local_min) { if (den_1d(i) != zero) min_reducer.join(local_min, num_1d(i)/den_1d(i)); }, min_reducer); scalar_type globalMin; reduceAll(*comm, REDUCE_MIN, minimum, outArg(globalMin)); return globalMin; } } // namespace TpetraVector } // namespace Sundials #endif // _TPETRA_SUNDIALS_VECTOR_KERNELS_HPP_ StanHeaders/inst/include/nvector/nvector_raja.h0000644000176200001440000001541113766554457021411 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the RAJA implementation of the * NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Raja(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_RAJA_H #define _NVECTOR_RAJA_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * RAJA implementation of N_Vector * ----------------------------------------------------------------- */ /* RAJA implementation of the N_Vector 'content' structure contains the length of the vector, a pointer to an array of 'realtype' components, and a flag indicating ownership of the data */ struct _N_VectorContent_Raja {}; typedef struct _N_VectorContent_Raja *N_VectorContent_Raja; /* * ----------------------------------------------------------------- * Functions exported by nvector_raja * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Raja(sunindextype length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Raja(); SUNDIALS_EXPORT N_Vector N_VMake_Raja(N_VectorContent_Raja c); SUNDIALS_EXPORT sunindextype N_VGetLength_Raja(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_Raja(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_Raja(N_Vector v); SUNDIALS_EXPORT void N_VCopyToDevice_Raja(N_Vector v); SUNDIALS_EXPORT void N_VCopyFromDevice_Raja(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Raja(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Raja(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Raja(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Raja(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Raja(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Raja(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Raja(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Raja(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Raja(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Raja(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Raja(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Raja(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Raja(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Raja(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Raja(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Raja(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Raja(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Raja(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Raja(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Raja(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Raja(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Raja(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Raja(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Raja(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Raja(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Raja(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Raja(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Raja(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Raja(int nvec, realtype* c, N_Vector* X, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_Raja(int nvec, realtype* c, N_Vector x, N_Vector* Y, N_Vector* Z); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Raja(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Raja(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Raja(int nvec, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Raja(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Raja(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Raja(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/raja/0000755000176200001440000000000013766554135017467 5ustar liggesusersStanHeaders/inst/include/nvector/raja/Vector.hpp0000644000176200001440000000571013766554457021454 0ustar liggesusers/* * ----------------------------------------------------------------- * Programmer(s): Slaven Peles @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- */ /* * Vector class * * Manages vector data layout for RAJA implementation of N_Vector. * */ #ifndef _NVECTOR_RAJA_HPP_ #define _NVECTOR_RAJA_HPP_ #include #include #include #include #if SUNDIALS_MPI_ENABLED #include #else #include #endif namespace sunrajavec { template class Vector : public _N_VectorContent_Raja { public: Vector(I N) : size_(N), mem_size_(N*sizeof(T)), global_size_(N), comm_(0) { allocate(); } Vector(SUNMPI_Comm comm, I N, I Nglobal) : size_(N), mem_size_(N*sizeof(T)), global_size_(Nglobal), comm_(comm) { allocate(); } // Copy constructor does not copy values explicit Vector(const Vector& v) : size_(v.size()), mem_size_(size_*sizeof(T)), global_size_(v.global_size_), comm_(v.comm_) { allocate(); } ~Vector() { cudaError_t err; free(h_vec_); err = cudaFree(d_vec_); if(err != cudaSuccess) std::cout << "Failed to free device vector (error code " << err << ")!\n"; } void allocate() { cudaError_t err; h_vec_ = static_cast(malloc(mem_size_)); if(h_vec_ == NULL) std::cout << "Failed to allocate host vector!\n"; err = cudaMalloc((void**) &d_vec_, mem_size_); if(err != cudaSuccess) std::cout << "Failed to allocate device vector (error code " << err << ")!\n"; } int size() const { return size_; } int sizeGlobal() const { return global_size_; } SUNMPI_Comm comm() { return comm_; } T* host() { return h_vec_; } const T* host() const { return h_vec_; } T* device() { return d_vec_; } const T* device() const { return d_vec_; } void copyToDev() { cudaError_t err = cudaMemcpy(d_vec_, h_vec_, mem_size_, cudaMemcpyHostToDevice); if(err != cudaSuccess) std::cerr << "Failed to copy vector from host to device (error code " << err << ")!\n"; } void copyFromDev() { cudaError_t err = cudaMemcpy(h_vec_, d_vec_, mem_size_, cudaMemcpyDeviceToHost); if(err != cudaSuccess) std::cerr << "Failed to copy vector from device to host (error code " << err << ")!\n"; } private: I size_; I mem_size_; I global_size_; T* h_vec_; T* d_vec_; SUNMPI_Comm comm_; }; } // namespace sunrajavec #endif // _NVECTOR_RAJA_HPP_ StanHeaders/inst/include/nvector/nvector_openmpdev.h0000644000176200001440000002213713766554457022474 0ustar liggesusers/* ------------------------------------------------------------------- * Programmer(s): David J. Gardner and Shelby Lockhart @ LLNL * ------------------------------------------------------------------- * Acknowledgements: This NVECTOR module is based on the NVECTOR * Serial module by Scott D. Cohen, Alan C. * Hindmarsh, Radu Serban, and Aaron Collier * @ LLNL * ------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the OpenMP 4.5+ implementation of the * NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_OpenMPDEV(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_OPENMP_H #define _NVECTOR_OPENMP_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * OpenMPDEV implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_OpenMPDEV { sunindextype length; /* vector length */ booleantype own_data; /* data ownership flag */ realtype *host_data; /* host data array */ realtype *dev_data; /* device data array */ }; typedef struct _N_VectorContent_OpenMPDEV *N_VectorContent_OpenMPDEV; /* * ----------------------------------------------------------------- * Macros NV_CONTENT_OMPDEV, NV_DATA_HOST_OMPDEV, NV_OWN_DATA_OMPDEV, * NV_LENGTH_OMPDEV, and NV_Ith_OMPDEV * ----------------------------------------------------------------- */ #define NV_CONTENT_OMPDEV(v) ( (N_VectorContent_OpenMPDEV)(v->content) ) #define NV_LENGTH_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->length ) #define NV_OWN_DATA_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->own_data ) #define NV_DATA_HOST_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->host_data ) #define NV_DATA_DEV_OMPDEV(v) ( NV_CONTENT_OMPDEV(v)->dev_data ) /* * ----------------------------------------------------------------- * Functions exported by nvector_openmpdev * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_OpenMPDEV(sunindextype vec_length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_OpenMPDEV(sunindextype vec_length); SUNDIALS_EXPORT N_Vector N_VMake_OpenMPDEV(sunindextype vec_length, realtype *h_data, realtype *v_data); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_OpenMPDEV(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_OpenMPDEV(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_OpenMPDEV(N_Vector *vs, int count); SUNDIALS_EXPORT sunindextype N_VGetLength_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT void N_VPrint_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_OpenMPDEV(N_Vector v, FILE *outfile); SUNDIALS_EXPORT void N_VCopyToDevice_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT void N_VCopyFromDevice_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_OpenMPDEV(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_OpenMPDEV(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_OpenMPDEV(N_Vector v); SUNDIALS_EXPORT void N_VSpace_OpenMPDEV(N_Vector v, sunindextype *lrw, sunindextype *liw); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_OpenMPDEV(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_OpenMPDEV(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_OpenMPDEV(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_OpenMPDEV(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_OpenMPDEV(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_OpenMPDEV(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_OpenMPDEV(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_OpenMPDEV(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_OpenMPDEV(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_OpenMPDEV(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_OpenMPDEV(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_OpenMPDEV(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_OpenMPDEV(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_OpenMPDEV(N_Vector x); SUNDIALS_EXPORT void N_VCompare_OpenMPDEV(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_OpenMPDEV(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_OpenMPDEV(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_OpenMPDEV(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_OpenMPDEV(int nvec, realtype* c, N_Vector* V, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_OpenMPDEV(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_OpenMPDEV(int nvec, N_Vector x, N_Vector *Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_OpenMPDEV(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_OpenMPDEV(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_OpenMPDEV(int nvecs, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_OpenMPDEV(int nvecs, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_OpenMPDEV(int nvecs, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_OpenMPDEV(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_OpenMPDEV(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_OpenMPDEV(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_OpenMPDEV(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_parallel.h0000644000176200001440000002257113766554457022275 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the main header file for the MPI-enabled implementation * of the NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be * found in the header file sundials_nvector.h. * * - The definition of the type realtype can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type booleantype. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Parallel(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_PARALLEL_H #define _NVECTOR_PARALLEL_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * Parallel implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_Parallel { sunindextype local_length; /* local vector length */ sunindextype global_length; /* global vector length */ booleantype own_data; /* ownership of data */ realtype *data; /* local data array */ MPI_Comm comm; /* pointer to MPI communicator */ }; typedef struct _N_VectorContent_Parallel *N_VectorContent_Parallel; /* * ----------------------------------------------------------------- * Macros NV_CONTENT_P, NV_DATA_P, NV_OWN_DATA_P, * NV_LOCLENGTH_P, NV_GLOBLENGTH_P,NV_COMM_P, and NV_Ith_P * ----------------------------------------------------------------- */ #define NV_CONTENT_P(v) ( (N_VectorContent_Parallel)(v->content) ) #define NV_LOCLENGTH_P(v) ( NV_CONTENT_P(v)->local_length ) #define NV_GLOBLENGTH_P(v) ( NV_CONTENT_P(v)->global_length ) #define NV_OWN_DATA_P(v) ( NV_CONTENT_P(v)->own_data ) #define NV_DATA_P(v) ( NV_CONTENT_P(v)->data ) #define NV_COMM_P(v) ( NV_CONTENT_P(v)->comm ) #define NV_Ith_P(v,i) ( NV_DATA_P(v)[i] ) /* * ----------------------------------------------------------------- * Functions exported by nvector_parallel * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Parallel(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Parallel(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VMake_Parallel(MPI_Comm comm, sunindextype local_length, sunindextype global_length, realtype *v_data); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Parallel(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Parallel(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_Parallel(N_Vector *vs, int count); SUNDIALS_EXPORT sunindextype N_VGetLength_Parallel(N_Vector v); SUNDIALS_EXPORT sunindextype N_VGetLocalLength_Parallel(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Parallel(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Parallel(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Parallel(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Parallel(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Parallel(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Parallel(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Parallel(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Parallel(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Parallel(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Parallel(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Parallel(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Parallel(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Parallel(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Parallel(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Parallel(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Parallel(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Parallel(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Parallel(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Parallel(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Parallel(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Parallel(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Parallel(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Parallel(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Parallel(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Parallel(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Parallel(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Parallel(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Parallel(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Parallel(int nvec, realtype* c, N_Vector* V, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_Parallel(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_Parallel(int nvec, N_Vector x, N_Vector *Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Parallel(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Parallel(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Parallel(int nvecs, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Parallel(int nvecs, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Parallel(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Parallel(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Parallel(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Parallel(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Parallel(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_pthreads.h0000644000176200001440000002450713766554457022314 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------- * Acknowledgements: This NVECTOR module is based on the NVECTOR * Serial module by Scott D. Cohen, Alan C. * Hindmarsh, Radu Serban, and Aaron Collier * @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the POSIX Threads (Pthreads) * implementation of the NVECTOR module using LOCAL data structs * to share data between threads. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Pthreads(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_PTHREADS_H #define _NVECTOR_PTHREADS_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * Pthreads implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_Pthreads { sunindextype length; /* vector length */ booleantype own_data; /* data ownership flag */ realtype *data; /* data array */ int num_threads; /* number of POSIX threads */ }; typedef struct _N_VectorContent_Pthreads *N_VectorContent_Pthreads; /* Structure to hold parallelization information for each thread when calling "companion" functions to compute vector operations. The start and end vector (loop) indices are unique to each thread, the realtype variables are the same for each thread, and the mutex variable is used to lock variables in reductions. */ struct _Pthreads_Data{ sunindextype start; /* starting index for loop */ sunindextype end; /* ending index for loop */ realtype c1, c2; /* scalar values */ realtype *v1, *v2, *v3; /* vector data */ realtype *global_val; /* shared global variable */ pthread_mutex_t *global_mutex; /* lock for shared variable */ int nvec; /* number of vectors in fused op */ int nsum; /* number of sums in fused op */ realtype* cvals; /* scalar values in fused op */ N_Vector x1; /* vector array in fused op */ N_Vector x2; /* vector array in fused op */ N_Vector x3; /* vector array in fused op */ N_Vector* Y1; /* vector array in fused op */ N_Vector* Y2; /* vector array in fused op */ N_Vector* Y3; /* vector array in fused op */ N_Vector** ZZ1; /* array of vector arrays in fused op */ N_Vector** ZZ2; /* array of vector arrays in fused op */ }; typedef struct _Pthreads_Data Pthreads_Data; /* * ----------------------------------------------------------------- * Macros NV_CONTENT_PT, NV_DATA_PT, NV_OWN_DATA_PT, * NV_LENGTH_PT, and NV_Ith_PT * ----------------------------------------------------------------- */ #define NV_CONTENT_PT(v) ( (N_VectorContent_Pthreads)(v->content) ) #define NV_LENGTH_PT(v) ( NV_CONTENT_PT(v)->length ) #define NV_NUM_THREADS_PT(v) ( NV_CONTENT_PT(v)->num_threads ) #define NV_OWN_DATA_PT(v) ( NV_CONTENT_PT(v)->own_data ) #define NV_DATA_PT(v) ( NV_CONTENT_PT(v)->data ) #define NV_Ith_PT(v,i) ( NV_DATA_PT(v)[i] ) /* * ----------------------------------------------------------------- * Functions exported by nvector_Pthreads * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Pthreads(sunindextype vec_length, int n_threads); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Pthreads(sunindextype vec_length, int n_threads); SUNDIALS_EXPORT N_Vector N_VMake_Pthreads(sunindextype vec_length, int n_threads, realtype *v_data); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Pthreads(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Pthreads(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_Pthreads(N_Vector *vs, int count); SUNDIALS_EXPORT sunindextype N_VGetLength_Pthreads(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Pthreads(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Pthreads(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Pthreads(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Pthreads(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Pthreads(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Pthreads(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Pthreads(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Pthreads(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Pthreads(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Pthreads(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Pthreads(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Pthreads(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Pthreads(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Pthreads(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Pthreads(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Pthreads(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Pthreads(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Pthreads(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Pthreads(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Pthreads(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Pthreads(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Pthreads(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Pthreads(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Pthreads(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Pthreads(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Pthreads(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Pthreads(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Pthreads(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Pthreads(int nvec, realtype* c, N_Vector* X, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_Pthreads(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_Pthreads(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Pthreads(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Pthreads(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Pthreads(int nvec, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Pthreads(int nvec, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Pthreads(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Pthreads(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Pthreads(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Pthreads(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Pthreads(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_cuda.h0000644000176200001440000001732113766554457021412 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Slaven Peles and Cody J. Balos @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the CUDA implementation of the * NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definitions of the types 'realtype' and 'sunindextype' can * be found in the header file sundials_types.h, and it may be * changed (at the configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Cuda(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_CUDA_H #define _NVECTOR_CUDA_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * CUDA implementation of N_Vector * ----------------------------------------------------------------- */ /* * CUDA implementation of the N_Vector 'content' is in C++ class * Vector. The class inherits from structure _N_VectorContent_Cuda * to create C <--> C++ interface. */ struct _N_VectorContent_Cuda {}; typedef struct _N_VectorContent_Cuda *N_VectorContent_Cuda; /* * ----------------------------------------------------------------- * Functions exported by nvector_cuda * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Cuda(sunindextype length); SUNDIALS_EXPORT N_Vector N_VNewManaged_Cuda(sunindextype length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Cuda(); SUNDIALS_EXPORT N_Vector N_VMake_Cuda(sunindextype length, realtype *h_vdata, realtype *d_vdata); SUNDIALS_EXPORT N_Vector N_VMakeManaged_Cuda(sunindextype length, realtype *vdata); SUNDIALS_EXPORT sunindextype N_VGetLength_Cuda(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_Cuda(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_Cuda(N_Vector v); SUNDIALS_EXPORT booleantype N_VIsManagedMemory_Cuda(N_Vector x); SUNDIALS_EXPORT void N_VSetCudaStream_Cuda(N_Vector x, cudaStream_t *stream); SUNDIALS_EXPORT void N_VCopyToDevice_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VCopyFromDevice_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Cuda(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Cuda(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Cuda(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Cuda(N_Vector v, sunindextype *lrw, sunindextype *liw); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Cuda(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Cuda(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Cuda(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Cuda(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Cuda(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Cuda(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Cuda(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Cuda(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Cuda(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Cuda(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Cuda(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Cuda(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Cuda(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Cuda(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Cuda(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Cuda(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Cuda(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Cuda(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Cuda(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Cuda(int nvec, realtype* c, N_Vector* X, N_Vector Z); SUNDIALS_EXPORT int N_VScaleAddMulti_Cuda(int nvec, realtype* c, N_Vector X, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_Cuda(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Cuda(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Cuda(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Cuda(int nvec, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Cuda(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Cuda(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Cuda(int nvec, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Cuda(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Cuda(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_mpiraja.h0000644000176200001440000001703213766554457022120 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Cody Balos @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the MPI+RAJA implementation of the * NVECTOR module. * * Part I contains declarations specific to the RAJA * implementation of the supplied NVECTOR module. * * Part II contains the prototype for the constructor N_VNew_Raja * as well as implementation-specific prototypes for various useful * vector operations. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Raja(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_RAJA_H #define _NVECTOR_RAJA_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * MPI+RAJA implementation of N_Vector * ----------------------------------------------------------------- */ /* RAJA implementation of the N_Vector 'content' structure contains the length of the vector, a pointer to an array of 'realtype' components, and a flag indicating ownership of the data */ struct _N_VectorContent_Raja {}; typedef struct _N_VectorContent_Raja *N_VectorContent_Raja; /* * ----------------------------------------------------------------- * Functions exported by nvector_mpiraja * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Raja(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Raja(); SUNDIALS_EXPORT N_Vector N_VMake_Raja(N_VectorContent_Raja c); SUNDIALS_EXPORT sunindextype N_VGetLength_Raja(N_Vector v); SUNDIALS_EXPORT sunindextype N_VGetLocalLength_Raja(N_Vector v); SUNDIALS_EXPORT MPI_Comm N_VGetMPIComm_Raja(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_Raja(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_Raja(N_Vector v); SUNDIALS_EXPORT void N_VCopyToDevice_Raja(N_Vector v); SUNDIALS_EXPORT void N_VCopyFromDevice_Raja(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Raja(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Raja(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Raja(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Raja(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Raja(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Raja(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Raja(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Raja(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Raja(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Raja(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Raja(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Raja(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Raja(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Raja(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Raja(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Raja(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Raja(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Raja(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Raja(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Raja(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Raja(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Raja(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Raja(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Raja(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Raja(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Raja(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Raja(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Raja(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Raja(int nvec, realtype* c, N_Vector* X, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_Raja(int nvec, realtype* c, N_Vector x, N_Vector* Y, N_Vector* Z); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Raja(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Raja(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Raja(int nvec, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Raja(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Raja(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Raja(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Raja(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_serial.h0000644000176200001440000002042113766554457021750 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the serial implementation of the * NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definition of the type 'realtype' can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Serial(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_SERIAL_H #define _NVECTOR_SERIAL_H #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * SERIAL implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_Serial { sunindextype length; /* vector length */ booleantype own_data; /* data ownership flag */ realtype *data; /* data array */ }; typedef struct _N_VectorContent_Serial *N_VectorContent_Serial; /* * ----------------------------------------------------------------- * Macros NV_CONTENT_S, NV_DATA_S, NV_OWN_DATA_S, * NV_LENGTH_S, and NV_Ith_S * ----------------------------------------------------------------- */ #define NV_CONTENT_S(v) ( (N_VectorContent_Serial)(v->content) ) #define NV_LENGTH_S(v) ( NV_CONTENT_S(v)->length ) #define NV_OWN_DATA_S(v) ( NV_CONTENT_S(v)->own_data ) #define NV_DATA_S(v) ( NV_CONTENT_S(v)->data ) #define NV_Ith_S(v,i) ( NV_DATA_S(v)[i] ) /* * ----------------------------------------------------------------- * Functions exported by nvector_serial * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Serial(sunindextype vec_length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Serial(sunindextype vec_length); SUNDIALS_EXPORT N_Vector N_VMake_Serial(sunindextype vec_length, realtype *v_data); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_Serial(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_Serial(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_Serial(N_Vector *vs, int count); SUNDIALS_EXPORT sunindextype N_VGetLength_Serial(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Serial(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Serial(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_Serial(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Serial(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Serial(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Serial(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Serial(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_Serial(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_Serial(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Serial(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Serial(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Serial(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Serial(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Serial(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Serial(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Serial(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Serial(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Serial(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Serial(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Serial(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Serial(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Serial(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Serial(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Serial(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Serial(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Serial(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Serial(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Serial(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Serial(int nvec, realtype* c, N_Vector* V, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_Serial(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_Serial(int nvec, N_Vector x, N_Vector *Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Serial(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Serial(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Serial(int nvecs, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Serial(int nvecs, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Serial(int nvecs, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Serial(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Serial(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Serial(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Serial(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_mpicuda.h0000644000176200001440000002054213766554457022117 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Cody Balos @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the MPI+CUDA implementation of the * NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be found * in the header file sundials_nvector.h. * * - The definitions of the types 'realtype' and 'sunindextype' can * be found in the header file sundials_types.h, and it may be * changed (at the configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type 'booleantype'. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_Cuda(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_CUDA_H #define _NVECTOR_CUDA_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * MPI+CUDA implementation of N_Vector * ----------------------------------------------------------------- */ /* * CUDA implementation of the N_Vector 'content' is in C++ class * Vector. The class inherits from structure _N_VectorContent_Cuda * to create C <--> C++ interface. */ struct _N_VectorContent_Cuda {}; typedef struct _N_VectorContent_Cuda *N_VectorContent_Cuda; /* * ----------------------------------------------------------------- * Functions exported by nvector_mpicuda * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNew_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VNewManaged_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VNewEmpty_Cuda(); SUNDIALS_EXPORT N_Vector N_VMake_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length, realtype *h_vdata, realtype *d_vdata); SUNDIALS_EXPORT N_Vector N_VMakeManaged_Cuda(MPI_Comm comm, sunindextype local_length, sunindextype global_length, realtype *vdata); SUNDIALS_EXPORT sunindextype N_VGetLength_Cuda(N_Vector v); SUNDIALS_EXPORT sunindextype N_VGetLocalLength_Cuda(N_Vector v); SUNDIALS_EXPORT MPI_Comm N_VGetMPIComm_Cuda(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetHostArrayPointer_Cuda(N_Vector v); SUNDIALS_EXPORT realtype *N_VGetDeviceArrayPointer_Cuda(N_Vector v); SUNDIALS_EXPORT booleantype N_VIsManagedMemory_Cuda(N_Vector x); SUNDIALS_EXPORT void N_VSetCudaStream_Cuda(N_Vector x, cudaStream_t *stream); SUNDIALS_EXPORT void N_VCopyToDevice_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VCopyFromDevice_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VPrint_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_Cuda(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_Cuda(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_Cuda(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_Cuda(N_Vector v); SUNDIALS_EXPORT void N_VSpace_Cuda(N_Vector v, sunindextype *lrw, sunindextype *liw); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_Cuda(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_Cuda(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_Cuda(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_Cuda(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_Cuda(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_Cuda(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_Cuda(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_Cuda(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_Cuda(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_Cuda(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_Cuda(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_Cuda(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_Cuda(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_Cuda(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_Cuda(N_Vector x); SUNDIALS_EXPORT void N_VCompare_Cuda(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_Cuda(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_Cuda(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_Cuda(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_Cuda(int nvec, realtype* c, N_Vector* X, N_Vector Z); SUNDIALS_EXPORT int N_VScaleAddMulti_Cuda(int nvec, realtype* c, N_Vector X, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_Cuda(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_Cuda(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_Cuda(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_Cuda(int nvec, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_Cuda(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_Cuda(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_Cuda(int nvec, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_Cuda(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_Cuda(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_Cuda(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/nvector/nvector_parhyp.h0000644000176200001440000002041713766554457022001 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Jean M. Sexton @ SMU * Slaven Peles @ LLNL * ----------------------------------------------------------------- * Based on work by: Scott D. Cohen, Alan C. Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the main header file for the ParHyp implementation * of the NVECTOR module. * * Notes: * * - The definition of the generic N_Vector structure can be * found in the header file sundials_nvector.h. * * - The definition of the type realtype can be found in the * header file sundials_types.h, and it may be changed (at the * configuration stage) according to the user's needs. * The sundials_types.h file also contains the definition * for the type booleantype. * * - N_Vector arguments to arithmetic vector operations need not * be distinct. For example, the following call: * * N_VLinearSum_ParHyp(a,x,b,y,y); * * (which stores the result of the operation a*x+b*y in y) * is legal. * -----------------------------------------------------------------*/ #ifndef _NVECTOR_PARHYP_H #define _NVECTOR_PARHYP_H #include #include #include #include /* hypre header files */ #include <_hypre_parcsr_mv.h> #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* * ----------------------------------------------------------------- * ParHyp implementation of N_Vector * ----------------------------------------------------------------- */ struct _N_VectorContent_ParHyp { sunindextype local_length; /* local vector length */ sunindextype global_length; /* global vector length */ booleantype own_parvector; /* ownership of HYPRE vector */ MPI_Comm comm; /* pointer to MPI communicator */ HYPRE_ParVector x; /* the actual HYPRE_ParVector object */ }; typedef struct _N_VectorContent_ParHyp *N_VectorContent_ParHyp; /* * ----------------------------------------------------------------- * Functions exported by nvector_parhyp * ----------------------------------------------------------------- */ SUNDIALS_EXPORT N_Vector N_VNewEmpty_ParHyp(MPI_Comm comm, sunindextype local_length, sunindextype global_length); SUNDIALS_EXPORT N_Vector N_VMake_ParHyp(HYPRE_ParVector x); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArray_ParHyp(int count, N_Vector w); SUNDIALS_EXPORT N_Vector *N_VCloneVectorArrayEmpty_ParHyp(int count, N_Vector w); SUNDIALS_EXPORT void N_VDestroyVectorArray_ParHyp(N_Vector *vs, int count); SUNDIALS_EXPORT HYPRE_ParVector N_VGetVector_ParHyp(N_Vector v); SUNDIALS_EXPORT void N_VPrint_ParHyp(N_Vector v); SUNDIALS_EXPORT void N_VPrintFile_ParHyp(N_Vector v, FILE *outfile); SUNDIALS_EXPORT N_Vector_ID N_VGetVectorID_ParHyp(N_Vector v); SUNDIALS_EXPORT N_Vector N_VCloneEmpty_ParHyp(N_Vector w); SUNDIALS_EXPORT N_Vector N_VClone_ParHyp(N_Vector w); SUNDIALS_EXPORT void N_VDestroy_ParHyp(N_Vector v); SUNDIALS_EXPORT void N_VSpace_ParHyp(N_Vector v, sunindextype *lrw, sunindextype *liw); SUNDIALS_EXPORT realtype *N_VGetArrayPointer_ParHyp(N_Vector v); SUNDIALS_EXPORT void N_VSetArrayPointer_ParHyp(realtype *v_data, N_Vector v); /* standard vector operations */ SUNDIALS_EXPORT void N_VLinearSum_ParHyp(realtype a, N_Vector x, realtype b, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VConst_ParHyp(realtype c, N_Vector z); SUNDIALS_EXPORT void N_VProd_ParHyp(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VDiv_ParHyp(N_Vector x, N_Vector y, N_Vector z); SUNDIALS_EXPORT void N_VScale_ParHyp(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAbs_ParHyp(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VInv_ParHyp(N_Vector x, N_Vector z); SUNDIALS_EXPORT void N_VAddConst_ParHyp(N_Vector x, realtype b, N_Vector z); SUNDIALS_EXPORT realtype N_VDotProd_ParHyp(N_Vector x, N_Vector y); SUNDIALS_EXPORT realtype N_VMaxNorm_ParHyp(N_Vector x); SUNDIALS_EXPORT realtype N_VWrmsNorm_ParHyp(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VWrmsNormMask_ParHyp(N_Vector x, N_Vector w, N_Vector id); SUNDIALS_EXPORT realtype N_VMin_ParHyp(N_Vector x); SUNDIALS_EXPORT realtype N_VWL2Norm_ParHyp(N_Vector x, N_Vector w); SUNDIALS_EXPORT realtype N_VL1Norm_ParHyp(N_Vector x); SUNDIALS_EXPORT void N_VCompare_ParHyp(realtype c, N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VInvTest_ParHyp(N_Vector x, N_Vector z); SUNDIALS_EXPORT booleantype N_VConstrMask_ParHyp(N_Vector c, N_Vector x, N_Vector m); SUNDIALS_EXPORT realtype N_VMinQuotient_ParHyp(N_Vector num, N_Vector denom); /* fused vector operations */ SUNDIALS_EXPORT int N_VLinearCombination_ParHyp(int nvec, realtype* c, N_Vector* X, N_Vector z); SUNDIALS_EXPORT int N_VScaleAddMulti_ParHyp(int nvec, realtype* a, N_Vector x, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VDotProdMulti_ParHyp(int nvec, N_Vector x, N_Vector* Y, realtype* dotprods); /* vector array operations */ SUNDIALS_EXPORT int N_VLinearSumVectorArray_ParHyp(int nvec, realtype a, N_Vector* X, realtype b, N_Vector* Y, N_Vector* Z); SUNDIALS_EXPORT int N_VScaleVectorArray_ParHyp(int nvec, realtype* c, N_Vector* X, N_Vector* Z); SUNDIALS_EXPORT int N_VConstVectorArray_ParHyp(int nvecs, realtype c, N_Vector* Z); SUNDIALS_EXPORT int N_VWrmsNormVectorArray_ParHyp(int nvecs, N_Vector* X, N_Vector* W, realtype* nrm); SUNDIALS_EXPORT int N_VWrmsNormMaskVectorArray_ParHyp(int nvec, N_Vector* X, N_Vector* W, N_Vector id, realtype* nrm); SUNDIALS_EXPORT int N_VScaleAddMultiVectorArray_ParHyp(int nvec, int nsum, realtype* a, N_Vector* X, N_Vector** Y, N_Vector** Z); SUNDIALS_EXPORT int N_VLinearCombinationVectorArray_ParHyp(int nvec, int nsum, realtype* c, N_Vector** X, N_Vector* Z); /* * ----------------------------------------------------------------- * Enable / disable fused vector operations * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int N_VEnableFusedOps_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombination_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMulti_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableDotProdMulti_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearSumVectorArray_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleVectorArray_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableConstVectorArray_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormVectorArray_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableWrmsNormMaskVectorArray_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableScaleAddMultiVectorArray_ParHyp(N_Vector v, booleantype tf); SUNDIALS_EXPORT int N_VEnableLinearCombinationVectorArray_ParHyp(N_Vector v, booleantype tf); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/kinsol/0000755000176200001440000000000013766554135016371 5ustar liggesusersStanHeaders/inst/include/kinsol/kinsol_bbdpre.h0000644000176200001440000000421013766554457021363 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the KINBBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks. * -----------------------------------------------------------------*/ #ifndef _KINBBDPRE_H #define _KINBBDPRE_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* KINBBDPRE return values */ #define KINBBDPRE_SUCCESS 0 #define KINBBDPRE_PDATA_NULL -11 #define KINBBDPRE_FUNC_UNRECVR -12 /* User-supplied function Types */ typedef int (*KINBBDCommFn)(sunindextype Nlocal, N_Vector u, void *user_data); typedef int (*KINBBDLocalFn)(sunindextype Nlocal, N_Vector uu, N_Vector gval, void *user_data); /* Exported Functions */ SUNDIALS_EXPORT int KINBBDPrecInit(void *kinmem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dq_rel_uu, KINBBDLocalFn gloc, KINBBDCommFn gcomm); /* Optional output functions */ SUNDIALS_EXPORT int KINBBDPrecGetWorkSpace(void *kinmem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int KINBBDPrecGetNumGfnEvals(void *kinmem, long int *ngevalsBBDP); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/kinsol/kinsol_ls.h0000644000176200001440000001112113766554457020542 0ustar liggesusers/* ---------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Scott Cohen, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ---------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ---------------------------------------------------------------- * This is the header file for KINSOL's linear solver interface. * ----------------------------------------------------------------*/ #ifndef _KINLS_H #define _KINLS_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================== KINLS Constants ==================================================================*/ #define KINLS_SUCCESS 0 #define KINLS_MEM_NULL -1 #define KINLS_LMEM_NULL -2 #define KINLS_ILL_INPUT -3 #define KINLS_MEM_FAIL -4 #define KINLS_PMEM_NULL -5 #define KINLS_JACFUNC_ERR -6 #define KINLS_SUNMAT_FAIL -7 #define KINLS_SUNLS_FAIL -8 /*=============================================================== KINLS user-supplied function prototypes ===============================================================*/ typedef int (*KINLsJacFn)(N_Vector u, N_Vector fu, SUNMatrix J, void *user_data, N_Vector tmp1, N_Vector tmp2); typedef int (*KINLsPrecSetupFn)(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, void *user_data); typedef int (*KINLsPrecSolveFn)(N_Vector uu, N_Vector uscale, N_Vector fval, N_Vector fscale, N_Vector vv, void *user_data); typedef int (*KINLsJacTimesVecFn)(N_Vector v, N_Vector Jv, N_Vector uu, booleantype *new_uu, void *J_data); /*================================================================== KINLS Exported functions ==================================================================*/ SUNDIALS_EXPORT int KINSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A); /*----------------------------------------------------------------- Optional inputs to the KINLS linear solver interface -----------------------------------------------------------------*/ SUNDIALS_EXPORT int KINSetJacFn(void *kinmem, KINLsJacFn jac); SUNDIALS_EXPORT int KINSetPreconditioner(void *kinmem, KINLsPrecSetupFn psetup, KINLsPrecSolveFn psolve); SUNDIALS_EXPORT int KINSetJacTimesVecFn(void *kinmem, KINLsJacTimesVecFn jtv); /*----------------------------------------------------------------- Optional outputs from the KINLS linear solver interface -----------------------------------------------------------------*/ SUNDIALS_EXPORT int KINGetLinWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int KINGetNumJacEvals(void *kinmem, long int *njevals); SUNDIALS_EXPORT int KINGetNumLinFuncEvals(void *kinmem, long int *nfevals); SUNDIALS_EXPORT int KINGetNumPrecEvals(void *kinmem, long int *npevals); SUNDIALS_EXPORT int KINGetNumPrecSolves(void *kinmem, long int *npsolves); SUNDIALS_EXPORT int KINGetNumLinIters(void *kinmem, long int *nliters); SUNDIALS_EXPORT int KINGetNumLinConvFails(void *kinmem, long int *nlcfails); SUNDIALS_EXPORT int KINGetNumJtimesEvals(void *kinmem, long int *njvevals); SUNDIALS_EXPORT int KINGetNumLinFuncEvals(void *kinmem, long int *nfevals); SUNDIALS_EXPORT int KINGetLastLinFlag(void *kinmem, long int *flag); SUNDIALS_EXPORT char *KINGetLinReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/kinsol/kinsol_direct.h0000644000176200001440000000352513766554457021407 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated direct linear solver interface in * KINSOL; these routines now just wrap the updated KINSOL generic * linear solver interface in kinsol_ls.h. * -----------------------------------------------------------------*/ #ifndef _KINDLS_H #define _KINDLS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Function Types (typedefs for equivalent types in kinsol_ls.h) =================================================================*/ typedef KINLsJacFn KINDlsJacFn; /*=================================================================== Exported Functions (wrappers for equivalent routines in kinsol_ls.h) ===================================================================*/ int KINDlsSetLinearSolver(void *kinmem, SUNLinearSolver LS, SUNMatrix A); int KINDlsSetJacFn(void *kinmem, KINDlsJacFn jac); int KINDlsGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw); int KINDlsGetNumJacEvals(void *kinmem, long int *njevals); int KINDlsGetNumFuncEvals(void *kinmem, long int *nfevals); int KINDlsGetLastFlag(void *kinmem, long int *flag); char *KINDlsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/kinsol/kinsol_spils.h0000644000176200001440000000467713766554457021300 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Scott Cohen, Alan Hindmarsh, Radu Serban, * and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated Scaled Preconditioned Iterative * Linear Solver interface in KINSOL; these routines now just wrap * the updated KINSOL generic linear solver interface in kinsol_ls.h. * -----------------------------------------------------------------*/ #ifndef _KINSPILS_H #define _KINSPILS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*=============================================================== Function Types (typedefs for equivalent types in kinsol_ls.h) ===============================================================*/ typedef KINLsPrecSetupFn KINSpilsPrecSetupFn; typedef KINLsPrecSolveFn KINSpilsPrecSolveFn; typedef KINLsJacTimesVecFn KINSpilsJacTimesVecFn; /*==================================================================== Exported Functions (wrappers for equivalent routines in kinsol_ls.h) ====================================================================*/ int KINSpilsSetLinearSolver(void *kinmem, SUNLinearSolver LS); int KINSpilsSetPreconditioner(void *kinmem, KINSpilsPrecSetupFn psetup, KINSpilsPrecSolveFn psolve); int KINSpilsSetJacTimesVecFn(void *kinmem, KINSpilsJacTimesVecFn jtv); int KINSpilsGetWorkSpace(void *kinmem, long int *lenrwLS, long int *leniwLS); int KINSpilsGetNumPrecEvals(void *kinmem, long int *npevals); int KINSpilsGetNumPrecSolves(void *kinmem, long int *npsolves); int KINSpilsGetNumLinIters(void *kinmem, long int *nliters); int KINSpilsGetNumConvFails(void *kinmem, long int *nlcfails); int KINSpilsGetNumJtimesEvals(void *kinmem, long int *njvevals); int KINSpilsGetNumFuncEvals(void *kinmem, long int *nfevals); int KINSpilsGetLastFlag(void *kinmem, long int *flag); char *KINSpilsGetReturnFlagName(long int flag); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/kinsol/kinsol.h0000644000176200001440000001303213766554457020047 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Allan Taylor, Alan Hindmarsh, Radu Serban, and * Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the main KINSOL solver. * -----------------------------------------------------------------*/ #ifndef _KINSOL_H #define _KINSOL_H #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ----------------- * KINSOL Constants * ----------------- */ /* return values */ #define KIN_SUCCESS 0 #define KIN_INITIAL_GUESS_OK 1 #define KIN_STEP_LT_STPTOL 2 #define KIN_WARNING 99 #define KIN_MEM_NULL -1 #define KIN_ILL_INPUT -2 #define KIN_NO_MALLOC -3 #define KIN_MEM_FAIL -4 #define KIN_LINESEARCH_NONCONV -5 #define KIN_MAXITER_REACHED -6 #define KIN_MXNEWT_5X_EXCEEDED -7 #define KIN_LINESEARCH_BCFAIL -8 #define KIN_LINSOLV_NO_RECOVERY -9 #define KIN_LINIT_FAIL -10 #define KIN_LSETUP_FAIL -11 #define KIN_LSOLVE_FAIL -12 #define KIN_SYSFUNC_FAIL -13 #define KIN_FIRST_SYSFUNC_ERR -14 #define KIN_REPTD_SYSFUNC_ERR -15 #define KIN_VECTOROP_ERR -16 /* Enumeration for eta choice */ #define KIN_ETACHOICE1 1 #define KIN_ETACHOICE2 2 #define KIN_ETACONSTANT 3 /* Enumeration for global strategy */ #define KIN_NONE 0 #define KIN_LINESEARCH 1 #define KIN_PICARD 2 #define KIN_FP 3 /* ------------------------------ * User-Supplied Function Types * ------------------------------ */ typedef int (*KINSysFn)(N_Vector uu, N_Vector fval, void *user_data ); typedef void (*KINErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); typedef void (*KINInfoHandlerFn)(const char *module, const char *function, char *msg, void *user_data); /* ------------------- * Exported Functions * ------------------- */ /* Creation function */ SUNDIALS_EXPORT void *KINCreate(void); /* Initialization function */ SUNDIALS_EXPORT int KINInit(void *kinmem, KINSysFn func, N_Vector tmpl); /* Solver function */ SUNDIALS_EXPORT int KINSol(void *kinmem, N_Vector uu, int strategy, N_Vector u_scale, N_Vector f_scale); /* Optional input functions */ SUNDIALS_EXPORT int KINSetErrHandlerFn(void *kinmem, KINErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int KINSetErrFile(void *kinmem, FILE *errfp); SUNDIALS_EXPORT int KINSetInfoHandlerFn(void *kinmem, KINInfoHandlerFn ihfun, void *ih_data); SUNDIALS_EXPORT int KINSetInfoFile(void *kinmem, FILE *infofp); SUNDIALS_EXPORT int KINSetUserData(void *kinmem, void *user_data); SUNDIALS_EXPORT int KINSetPrintLevel(void *kinmemm, int printfl); SUNDIALS_EXPORT int KINSetMAA(void *kinmem, long int maa); SUNDIALS_EXPORT int KINSetNumMaxIters(void *kinmem, long int mxiter); SUNDIALS_EXPORT int KINSetNoInitSetup(void *kinmem, booleantype noInitSetup); SUNDIALS_EXPORT int KINSetNoResMon(void *kinmem, booleantype noNNIResMon); SUNDIALS_EXPORT int KINSetMaxSetupCalls(void *kinmem, long int msbset); SUNDIALS_EXPORT int KINSetMaxSubSetupCalls(void *kinmem, long int msbsetsub); SUNDIALS_EXPORT int KINSetEtaForm(void *kinmem, int etachoice); SUNDIALS_EXPORT int KINSetEtaConstValue(void *kinmem, realtype eta); SUNDIALS_EXPORT int KINSetEtaParams(void *kinmem, realtype egamma, realtype ealpha); SUNDIALS_EXPORT int KINSetResMonParams(void *kinmem, realtype omegamin, realtype omegamax); SUNDIALS_EXPORT int KINSetResMonConstValue(void *kinmem, realtype omegaconst); SUNDIALS_EXPORT int KINSetNoMinEps(void *kinmem, booleantype noMinEps); SUNDIALS_EXPORT int KINSetMaxNewtonStep(void *kinmem, realtype mxnewtstep); SUNDIALS_EXPORT int KINSetMaxBetaFails(void *kinmem, long int mxnbcf); SUNDIALS_EXPORT int KINSetRelErrFunc(void *kinmem, realtype relfunc); SUNDIALS_EXPORT int KINSetFuncNormTol(void *kinmem, realtype fnormtol); SUNDIALS_EXPORT int KINSetScaledStepTol(void *kinmem, realtype scsteptol); SUNDIALS_EXPORT int KINSetConstraints(void *kinmem, N_Vector constraints); SUNDIALS_EXPORT int KINSetSysFunc(void *kinmem, KINSysFn func); /* Optional output functions */ SUNDIALS_EXPORT int KINGetWorkSpace(void *kinmem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int KINGetNumNonlinSolvIters(void *kinmem, long int *nniters); SUNDIALS_EXPORT int KINGetNumFuncEvals(void *kinmem, long int *nfevals); SUNDIALS_EXPORT int KINGetNumBetaCondFails(void *kinmem, long int *nbcfails); SUNDIALS_EXPORT int KINGetNumBacktrackOps(void *kinmem, long int *nbacktr); SUNDIALS_EXPORT int KINGetFuncNorm(void *kinmem, realtype *fnorm); SUNDIALS_EXPORT int KINGetStepLength(void *kinmem, realtype *steplength); SUNDIALS_EXPORT char *KINGetReturnFlagName(long int flag); /* Free function */ SUNDIALS_EXPORT void KINFree(void **kinmem); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunnonlinsol/0000755000176200001440000000000013766554135017633 5ustar liggesusersStanHeaders/inst/include/sunnonlinsol/sunnonlinsol_newton.h0000644000176200001440000001126413766554457024152 0ustar liggesusers/* ----------------------------------------------------------------------------- * Programmer(s): David J. Gardner @ LLNL * ----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------------------- * This is the header file for the SUNNonlinearSolver module implementation of * Newton's method. * * Part I defines the solver-specific content structure. * * Part II contains prototypes for the solver constructor and operations. * ---------------------------------------------------------------------------*/ #ifndef _SUNNONLINSOL_NEWTON_H #define _SUNNONLINSOL_NEWTON_H #include "sundials/sundials_types.h" #include "sundials/sundials_nvector.h" #include "sundials/sundials_nonlinearsolver.h" #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ----------------------------------------------------------------------------- * I. Content structure * ---------------------------------------------------------------------------*/ struct _SUNNonlinearSolverContent_Newton { /* functions provided by the integrator */ SUNNonlinSolSysFn Sys; /* nonlinear system residual function */ SUNNonlinSolLSetupFn LSetup; /* linear solver setup function */ SUNNonlinSolLSolveFn LSolve; /* linear solver solve function */ SUNNonlinSolConvTestFn CTest; /* nonlinear solver convergence test function */ /* nonlinear solver variables */ N_Vector delta; /* Newton update vector */ booleantype jcur; /* Jacobian status, current = SUNTRUE / stale = SUNFALSE */ int curiter; /* current number of iterations in a solve attempt */ int maxiters; /* maximum number of iterations in a solve attempt */ long int niters; /* total number of nonlinear iterations across all solves */ long int nconvfails; /* total number of convergence failures across all solves */ }; typedef struct _SUNNonlinearSolverContent_Newton *SUNNonlinearSolverContent_Newton; /* ----------------------------------------------------------------------------- * II: Exported functions * ---------------------------------------------------------------------------*/ /* Constructor to create solver and allocates memory */ SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_Newton(N_Vector y); SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_NewtonSens(int count, N_Vector y); /* core functions */ SUNDIALS_EXPORT SUNNonlinearSolver_Type SUNNonlinSolGetType_Newton(SUNNonlinearSolver NLS); SUNDIALS_EXPORT int SUNNonlinSolInitialize_Newton(SUNNonlinearSolver NLS); SUNDIALS_EXPORT int SUNNonlinSolSolve_Newton(SUNNonlinearSolver NLS, N_Vector y0, N_Vector y, N_Vector w, realtype tol, booleantype callLSetup, void *mem); SUNDIALS_EXPORT int SUNNonlinSolFree_Newton(SUNNonlinearSolver NLS); /* set functions */ SUNDIALS_EXPORT int SUNNonlinSolSetSysFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn); SUNDIALS_EXPORT int SUNNonlinSolSetLSetupFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolLSetupFn LSetupFn); SUNDIALS_EXPORT int SUNNonlinSolSetLSolveFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolLSolveFn LSolveFn); SUNDIALS_EXPORT int SUNNonlinSolSetConvTestFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolConvTestFn CTestFn); SUNDIALS_EXPORT int SUNNonlinSolSetMaxIters_Newton(SUNNonlinearSolver NLS, int maxiters); /* get functions */ SUNDIALS_EXPORT int SUNNonlinSolGetNumIters_Newton(SUNNonlinearSolver NLS, long int *niters); SUNDIALS_EXPORT int SUNNonlinSolGetCurIter_Newton(SUNNonlinearSolver NLS, int *iter); SUNDIALS_EXPORT int SUNNonlinSolGetNumConvFails_Newton(SUNNonlinearSolver NLS, long int *nconvfails); SUNDIALS_EXPORT int SUNNonlinSolGetSysFn_Newton(SUNNonlinearSolver NLS, SUNNonlinSolSysFn *SysFn); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/sunnonlinsol/sunnonlinsol_fixedpoint.h0000644000176200001440000001177213766554457025015 0ustar liggesusers/*----------------------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU *----------------------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End *----------------------------------------------------------------------------- * This is the header file for the SUNNonlinearSolver module implementation of * the Anderson-accelerated fixed-point method. * * Part I defines the solver-specific content structure. * * Part II contains prototypes for the solver constructor and operations. *---------------------------------------------------------------------------*/ #ifndef _SUNNONLINSOL_FIXEDPOINT_H #define _SUNNONLINSOL_FIXEDPOINT_H #include "sundials/sundials_types.h" #include "sundials/sundials_nvector.h" #include "sundials/sundials_nonlinearsolver.h" #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------------------------------------------------------------------- I. Content structure ---------------------------------------------------------------------------*/ struct _SUNNonlinearSolverContent_FixedPoint { /* functions provided by the integrator */ SUNNonlinSolSysFn Sys; /* fixed-point iteration function */ SUNNonlinSolConvTestFn CTest; /* convergence test function */ /* nonlinear solver variables */ int m; /* number of acceleration vectors to use */ int *imap; /* array of length m */ realtype *R; /* array of length m*m */ realtype *gamma; /* array of length m */ realtype *cvals; /* array of length m+1 for fused vector op */ N_Vector *df; /* vector array of length m */ N_Vector *dg; /* vector array of length m */ N_Vector *q; /* vector array of length m */ N_Vector *Xvecs; /* array of length m+1 for fused vector op */ N_Vector yprev; /* temporary vectors for performing solve */ N_Vector gy; N_Vector fold; N_Vector gold; N_Vector delta; /* correction vector (change between 2 iterates) */ int curiter; /* current iteration number in a solve attempt */ int maxiters; /* maximum number of iterations per solve attempt */ long int niters; /* total number of iterations across all solves */ long int nconvfails; /* total number of convergence failures */ }; typedef struct _SUNNonlinearSolverContent_FixedPoint *SUNNonlinearSolverContent_FixedPoint; /* ----------------------------------------------------------------------------- II: Exported functions ---------------------------------------------------------------------------*/ /* Constructor to create solver and allocates memory */ SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_FixedPoint(N_Vector y, int m); SUNDIALS_EXPORT SUNNonlinearSolver SUNNonlinSol_FixedPointSens(int count, N_Vector y, int m); /* core functions */ SUNDIALS_EXPORT SUNNonlinearSolver_Type SUNNonlinSolGetType_FixedPoint(SUNNonlinearSolver NLS); SUNDIALS_EXPORT int SUNNonlinSolInitialize_FixedPoint(SUNNonlinearSolver NLS); SUNDIALS_EXPORT int SUNNonlinSolSolve_FixedPoint(SUNNonlinearSolver NLS, N_Vector y0, N_Vector y, N_Vector w, realtype tol, booleantype callSetup, void *mem); SUNDIALS_EXPORT int SUNNonlinSolFree_FixedPoint(SUNNonlinearSolver NLS); /* set functions */ SUNDIALS_EXPORT int SUNNonlinSolSetSysFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolSysFn SysFn); SUNDIALS_EXPORT int SUNNonlinSolSetConvTestFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolConvTestFn CTestFn); SUNDIALS_EXPORT int SUNNonlinSolSetMaxIters_FixedPoint(SUNNonlinearSolver NLS, int maxiters); /* get functions */ SUNDIALS_EXPORT int SUNNonlinSolGetNumIters_FixedPoint(SUNNonlinearSolver NLS, long int *niters); SUNDIALS_EXPORT int SUNNonlinSolGetCurIter_FixedPoint(SUNNonlinearSolver NLS, int *iter); SUNDIALS_EXPORT int SUNNonlinSolGetNumConvFails_FixedPoint(SUNNonlinearSolver NLS, long int *nconvfails); SUNDIALS_EXPORT int SUNNonlinSolGetSysFn_FixedPoint(SUNNonlinearSolver NLS, SUNNonlinSolSysFn *SysFn); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/src/0000755000176200001440000000000013766554464015666 5ustar liggesusersStanHeaders/inst/include/src/stan/0000755000176200001440000000000013766554456016634 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/0000755000176200001440000000000013766554456017555 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/ast_def.cpp0000644000176200001440000001631213766554456021671 0ustar liggesusers#ifndef STAN_LANG_AST_DEF_CPP #define STAN_LANG_AST_DEF_CPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/src/stan/lang/grammars/0000755000176200001440000000000013766554456021366 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/grammars/statement_2_grammar.hpp0000644000176200001440000000246613766554456026042 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_STATEMENT_2_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_STATEMENT_2_GRAMMAR_HPP #include #include #include #include #include #include namespace stan { namespace lang { template struct statement_grammar; // _r1 var_scope // _r2 true if in loop (allowing break/continue) template struct statement_2_grammar : boost::spirit::qi::grammar > { variable_map& var_map_; std::stringstream& error_msgs_; expression_grammar expression_g; statement_grammar& statement_g; statement_2_grammar(variable_map& var_map, std::stringstream& error_msgs, statement_grammar& sg); boost::spirit::qi::rule > conditional_statement_r; boost::spirit::qi::rule > statement_2_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/expression_grammar_def.hpp0000644000176200001440000000742313766554456026630 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_EXPRESSION_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_EXPRESSION_GRAMMAR_DEF_HPP #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::conditional_op, (stan::lang::expression, cond_)(stan::lang::expression, true_val_)(stan::lang::expression, false_val_)) namespace stan { namespace lang { template expression_grammar::expression_grammar(variable_map& var_map, std::stringstream& error_msgs) : expression_grammar::base_type(expression_r), var_map_(var_map), error_msgs_(error_msgs), expression07_g(var_map, error_msgs, *this) { using boost::spirit::qi::_1; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::eps; using boost::spirit::qi::labels::_r1; using boost::spirit::qi::lit; using boost::spirit::qi::no_skip; expression_r.name("expression"); expression_r %= (expression15_r(_r1) >> no_skip[!char_('?')] > eps) | conditional_op_r(_r1); conditional_op_r.name("conditional op expression, cond ? t_val : f_val "); conditional_op_r %= expression15_r(_r1) >> lit("?") >> expression_r(_r1) >> lit(":") >> expression_r(_r1)[validate_conditional_op_f( _val, _r1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs))]; expression15_r.name("expression"); expression15_r = expression14_r(_r1)[assign_lhs_f(_val, _1)] > *(lit("||") > expression14_r( _r1)[binary_op_f(_val, _1, "||", "logical_or", boost::phoenix::ref(error_msgs))]); expression14_r.name("expression"); expression14_r = expression10_r(_r1)[assign_lhs_f(_val, _1)] > *(lit("&&") > expression10_r( _r1)[binary_op_f(_val, _1, "&&", "logical_and", boost::phoenix::ref(error_msgs))]); expression10_r.name("expression"); expression10_r = expression09_r(_r1)[assign_lhs_f(_val, _1)] > *((lit("==") > expression09_r( _r1)[binary_op_f(_val, _1, "==", "logical_eq", boost::phoenix::ref(error_msgs))]) | (lit("!=") > expression09_r( _r1)[binary_op_f(_val, _1, "!=", "logical_neq", boost::phoenix::ref(error_msgs))])); expression09_r.name("expression"); expression09_r = expression07_g(_r1)[assign_lhs_f(_val, _1)] > *((lit("<=") > expression07_g( _r1)[binary_op_f(_val, _1, "<", "logical_lte", boost::phoenix::ref(error_msgs))]) | (lit("<") > expression07_g( _r1)[binary_op_f(_val, _1, "<=", "logical_lt", boost::phoenix::ref(error_msgs))]) | (lit(">=") > expression07_g( _r1)[binary_op_f(_val, _1, ">", "logical_gte", boost::phoenix::ref(error_msgs))]) | (lit(">") > expression07_g( _r1)[binary_op_f(_val, _1, ">=", "logical_gt", boost::phoenix::ref(error_msgs))])); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/local_var_decls_grammar_def.hpp0000644000176200001440000001245413766554456027545 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_LOCAL_VAR_DECLS_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_LOCAL_VAR_DECLS_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::local_var_decl, (stan::lang::local_var_type, type_)(std::string, name_)(stan::lang::expression, def_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::matrix_local_type, (stan::lang::expression, M_)(stan::lang::expression, N_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::row_vector_local_type, (stan::lang::expression, N_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::vector_local_type, (stan::lang::expression, N_)) namespace stan { namespace lang { template local_var_decls_grammar::local_var_decls_grammar( variable_map& var_map, std::stringstream& error_msgs) : local_var_decls_grammar::base_type(local_var_decls_r), var_map_(var_map), error_msgs_(error_msgs), expression_g(var_map, error_msgs), expression07_g(var_map, error_msgs, expression_g) { using boost::spirit::qi::_1; using boost::spirit::qi::_2; using boost::spirit::qi::_3; using boost::spirit::qi::_4; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::eps; using boost::spirit::qi::lexeme; using boost::spirit::qi::lit; using boost::spirit::qi::no_skip; using boost::spirit::qi::raw; using boost::spirit::qi::labels::_r1; using boost::phoenix::begin; using boost::phoenix::end; local_var_decls_r.name("variable declarations"); local_var_decls_r %= *(local_var_decl_r(_r1)); local_var_decl_r.name("variable declaration"); local_var_decl_r = (raw[array_local_var_decl_r(_r1)[assign_lhs_f(_val, _1)]] [add_line_number_f(_val, begin(_1), end(_1))] | raw[single_local_var_decl_r(_r1)[assign_lhs_f(_val, _1)]] [add_line_number_f(_val, begin(_1), end(_1))]) > eps[add_to_var_map_f(_val, boost::phoenix::ref(var_map_), _pass, _r1, boost::phoenix::ref(error_msgs_)), validate_definition_f(_r1, _val, _pass, boost::phoenix::ref(error_msgs_))] > lit(';'); array_local_var_decl_r.name("array local var declaration"); array_local_var_decl_r = (local_element_type_r(_r1) >> local_identifier_r >> local_dims_r(_r1) >> local_opt_def_r(_r1))[validate_array_local_var_decl_f( _val, _1, _2, _3, _4, _pass, boost::phoenix::ref(error_msgs_))]; single_local_var_decl_r.name("single-element local var declaration"); single_local_var_decl_r %= local_element_type_r(_r1) > local_identifier_r > local_opt_def_r(_r1) > eps[validate_single_local_var_decl_f( _val, _pass, boost::phoenix::ref(error_msgs_))]; local_element_type_r.name("local var element type declaration"); local_element_type_r %= local_int_type_r(_r1) | local_double_type_r(_r1) | local_vector_type_r(_r1) | local_row_vector_type_r(_r1) | local_matrix_type_r(_r1); local_int_type_r.name("integer type"); local_int_type_r %= lit("int") >> no_skip[!char_("a-zA-Z0-9_")]; local_double_type_r.name("real type"); local_double_type_r %= lit("real") >> no_skip[!char_("a-zA-Z0-9_")]; local_vector_type_r.name("vector type"); local_vector_type_r %= (lit("vector") >> no_skip[!char_("a-zA-Z0-9_")]) > local_dim1_r(_r1); local_row_vector_type_r.name("row vector type"); local_row_vector_type_r %= (lit("row_vector") >> no_skip[!char_("a-zA-Z0-9_")]) > local_dim1_r(_r1); local_matrix_type_r.name("matrix type"); local_matrix_type_r %= (lit("matrix") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('[') > local_int_expr_r(_r1) > lit(',') > local_int_expr_r(_r1) > lit(']'); local_dims_r.name("array dimensions"); local_dims_r %= lit('[') > (local_int_expr_r(_r1) % ',') > lit(']'); local_opt_def_r.name("variable definition (optional)"); local_opt_def_r %= -local_def_r(_r1); local_def_r.name("variable definition"); local_def_r %= lit('=') > expression_g(_r1); local_dim1_r.name( "vector length declaration:" " integer expression in square brackets"); local_dim1_r %= lit('[') > local_int_expr_r(_r1) > lit(']'); local_int_expr_r.name("integer expression"); local_int_expr_r %= expression_g( _r1)[validate_int_expr_f(_1, _pass, boost::phoenix::ref(error_msgs_))]; local_identifier_r.name("identifier"); local_identifier_r %= local_identifier_name_r[validate_identifier_f( _val, _pass, boost::phoenix::ref(error_msgs_))]; local_identifier_name_r.name("identifier subrule"); local_identifier_name_r %= lexeme[char_("a-zA-Z") >> *char_("a-zA-Z0-9_.")]; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/common_adaptors_def.hpp0000644000176200001440000000057613766554456026112 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_COMMON_ADAPTORS_DEF_HPP #define STAN_LANG_GRAMMARS_COMMON_ADAPTORS_DEF_HPP #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::range, (stan::lang::expression, low_)(stan::lang::expression, high_)) #endif StanHeaders/inst/include/src/stan/lang/grammars/block_var_decls_grammar_def.hpp0000644000176200001440000003227113766554456027544 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_BLOCK_VAR_DECLS_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_BLOCK_VAR_DECLS_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::block_var_decl, (stan::lang::block_var_type, type_)(std::string, name_)(stan::lang::expression, def_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::double_block_type, (stan::lang::range, bounds_)(stan::lang::offset_multiplier, ls_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::int_block_type, (stan::lang::range, bounds_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::matrix_block_type, (stan::lang::range, bounds_)(stan::lang::offset_multiplier, ls_)(stan::lang::expression, M_)(stan::lang::expression, N_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::row_vector_block_type, (stan::lang::range, bounds_)(stan::lang::offset_multiplier, ls_)(stan::lang::expression, N_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::vector_block_type, (stan::lang::range, bounds_)(stan::lang::offset_multiplier, ls_)(stan::lang::expression, N_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::cholesky_factor_corr_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::cholesky_factor_cov_block_type, (stan::lang::expression, M_)(stan::lang::expression, N_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::corr_matrix_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::cov_matrix_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::ordered_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::positive_ordered_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::simplex_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::unit_vector_block_type, (stan::lang::expression, K_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::offset_multiplier, (stan::lang::expression, offset_)(stan::lang::expression, multiplier_)) namespace stan { namespace lang { template block_var_decls_grammar::block_var_decls_grammar( variable_map &var_map, std::stringstream &error_msgs) : block_var_decls_grammar::base_type(var_decls_r), var_map_(var_map), error_msgs_(error_msgs), expression_g(var_map, error_msgs), expression07_g(var_map, error_msgs, expression_g) { using boost::spirit::qi::_1; using boost::spirit::qi::_2; using boost::spirit::qi::_3; using boost::spirit::qi::_4; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::eps; using boost::spirit::qi::lexeme; using boost::spirit::qi::lit; using boost::spirit::qi::no_skip; using boost::spirit::qi::raw; using boost::spirit::qi::labels::_r1; using boost::phoenix::begin; using boost::phoenix::end; var_decls_r.name("variable declarations"); var_decls_r %= *(var_decl_r(_r1)); // _r1 var scope var_decl_r.name("variable declaration"); var_decl_r = (raw[array_var_decl_r(_r1)[assign_lhs_f(_val, _1)]] [add_line_number_f(_val, begin(_1), end(_1))] | raw[single_var_decl_r(_r1)[assign_lhs_f(_val, _1)]] [add_line_number_f(_val, begin(_1), end(_1))]) > eps[add_to_var_map_f(_val, boost::phoenix::ref(var_map_), _pass, _r1, boost::phoenix::ref(error_msgs_)), validate_definition_f(_r1, _val, _pass, boost::phoenix::ref(error_msgs_))] > lit(';'); array_var_decl_r.name("array block var declaration"); array_var_decl_r = (element_type_r(_r1) >> identifier_r >> dims_r(_r1) >> opt_def_r(_r1))[validate_array_block_var_decl_f( _val, _1, _2, _3, _4, _pass, boost::phoenix::ref(error_msgs_))]; single_var_decl_r.name("single-element block var declaration"); single_var_decl_r %= element_type_r(_r1) > identifier_r > opt_def_r(_r1) > eps[validate_single_block_var_decl_f( _val, _pass, boost::phoenix::ref(error_msgs_))]; element_type_r.name("block var element type declaration"); element_type_r %= (int_type_r(_r1) | double_range_type_r(_r1) | double_offset_multiplier_type_r(_r1) | vector_range_type_r(_r1) | vector_offset_multiplier_type_r(_r1) | row_vector_range_type_r(_r1) | row_vector_offset_multiplier_type_r(_r1) | matrix_range_type_r(_r1) | matrix_offset_multiplier_type_r(_r1) | ordered_type_r(_r1) | positive_ordered_type_r(_r1) | simplex_type_r(_r1) | unit_vector_type_r(_r1) | corr_matrix_type_r(_r1) | cov_matrix_type_r(_r1) | cholesky_factor_corr_type_r(_r1) | cholesky_factor_cov_type_r(_r1)); int_type_r.name("integer type"); int_type_r %= (lit("int") >> no_skip[!char_("a-zA-Z0-9_")]) > -range_brackets_int_r(_r1); double_range_type_r.name("real range type"); double_range_type_r %= (lit("real") >> no_skip[!char_("a-zA-Z0-9_")]) >> range_brackets_double_r(_r1) > empty_offset_multiplier_r(_r1); double_offset_multiplier_type_r.name("real offset_multiplier type"); double_offset_multiplier_type_r %= (lit("real") >> no_skip[!char_("a-zA-Z0-9_")]) > empty_range_r(_r1) > -offset_multiplier_brackets_double_r(_r1); vector_range_type_r.name("vector range type"); vector_range_type_r %= (lit("vector") >> no_skip[!char_("a-zA-Z0-9_")]) >> range_brackets_double_r(_r1) > empty_offset_multiplier_r(_r1) > dim1_r(_r1); vector_offset_multiplier_type_r.name("vector offset_multiplier type"); vector_offset_multiplier_type_r %= (lit("vector") >> no_skip[!char_("a-zA-Z0-9_")]) > empty_range_r(_r1) > -offset_multiplier_brackets_double_r(_r1) > dim1_r(_r1); row_vector_range_type_r.name("row vector range type"); row_vector_range_type_r %= (lit("row_vector") >> no_skip[!char_("a-zA-Z0-9_")]) >> range_brackets_double_r(_r1) > empty_offset_multiplier_r(_r1) > dim1_r(_r1); row_vector_offset_multiplier_type_r.name("row vector offset_multiplier type"); row_vector_offset_multiplier_type_r %= (lit("row_vector") >> no_skip[!char_("a-zA-Z0-9_")]) > empty_range_r(_r1) > -offset_multiplier_brackets_double_r(_r1) > dim1_r(_r1); matrix_range_type_r.name("matrix range type"); matrix_range_type_r %= (lit("matrix") >> no_skip[!char_("a-zA-Z0-9_")]) >> range_brackets_double_r(_r1) > empty_offset_multiplier_r(_r1) > lit('[') > int_data_expr_r(_r1) > lit(',') > int_data_expr_r(_r1) > lit(']'); matrix_offset_multiplier_type_r.name("matrix offset_multiplier type"); matrix_offset_multiplier_type_r %= (lit("matrix") >> no_skip[!char_("a-zA-Z0-9_")]) > empty_range_r(_r1) > -offset_multiplier_brackets_double_r(_r1) > lit('[') > int_data_expr_r(_r1) > lit(',') > int_data_expr_r(_r1) > lit(']'); ordered_type_r.name("ordered type"); ordered_type_r %= (lit("ordered") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); positive_ordered_type_r.name("positive ordered type"); positive_ordered_type_r %= (lit("positive_ordered") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); simplex_type_r.name("simplex type"); simplex_type_r %= (lit("simplex") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); unit_vector_type_r.name("unit_vector type"); unit_vector_type_r %= (lit("unit_vector") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); corr_matrix_type_r.name("correlation matrix type"); corr_matrix_type_r %= (lit("corr_matrix") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); cov_matrix_type_r.name("covarience matrix type"); cov_matrix_type_r %= (lit("cov_matrix") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); cholesky_factor_corr_type_r.name( "cholesky factor of" " a correlation matrix type"); cholesky_factor_corr_type_r %= (lit("cholesky_factor_corr") >> no_skip[!char_("a-zA-Z0-9_")]) > dim1_r(_r1); cholesky_factor_cov_type_r.name( "cholesky factor of" " a covariance matrix type"); cholesky_factor_cov_type_r %= (lit("cholesky_factor_cov") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('[') > int_data_expr_r(_r1) > -(lit(',') > int_data_expr_r(_r1)) > lit(']') > eps[copy_square_cholesky_dimension_if_necessary_f(_val)]; // _r1 var scope dims_r.name("array dimensions"); dims_r %= lit('[') > (int_data_expr_r(_r1) % ',') > lit(']'); // _r1 var scope opt_def_r.name("variable definition (optional)"); opt_def_r %= -def_r(_r1); // _r1 var scope def_r.name("variable definition"); def_r %= lit('=') > expression_g(_r1); // _r1 var scope range_brackets_int_r.name("integer range expression pair, brackets"); range_brackets_int_r = lit('<')[empty_range_f(_val, boost::phoenix::ref(error_msgs_))] > (((lit("lower") > lit('=') > expression07_g(_r1)[set_int_range_lower_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))]) > -(lit(',') > lit("upper") > lit('=') > expression07_g(_r1)[set_int_range_upper_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))])) | (lit("upper") > lit('=') > expression07_g(_r1)[set_int_range_upper_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))])) > lit('>'); // _r1 var scope range_brackets_double_r.name("real range expression pair, brackets"); range_brackets_double_r = lit('<')[empty_range_f(_val, boost::phoenix::ref(error_msgs_))] >> (((lit("lower") > lit('=') > expression07_g(_r1)[set_double_range_lower_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))]) > -(lit(',') > lit("upper") > lit('=') > expression07_g(_r1)[set_double_range_upper_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))])) | (lit("upper") > lit('=') > expression07_g(_r1)[set_double_range_upper_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))])) > lit('>'); // _r1 var scope empty_range_r.name("empty range expression pair"); empty_range_r = eps[empty_range_f(_val, boost::phoenix::ref(error_msgs_))]; // _r1 var scope offset_multiplier_brackets_double_r.name( "real offset-multiplier expression pair, brackets"); offset_multiplier_brackets_double_r = lit('<')[empty_offset_multiplier_f(_val, boost::phoenix::ref(error_msgs_))] > (((lit("offset") > lit('=') > expression07_g(_r1)[set_double_offset_multiplier_offset_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))]) > -(lit(',') > lit("multiplier") > lit('=') > expression07_g(_r1)[set_double_offset_multiplier_multiplier_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))])) | (lit("multiplier") > lit('=') > expression07_g(_r1)[set_double_offset_multiplier_multiplier_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))])) > lit('>'); // _r1 var scope empty_offset_multiplier_r.name("empty offset-multiplier expression pair"); empty_offset_multiplier_r = eps[empty_offset_multiplier_f(_val, boost::phoenix::ref(error_msgs_))]; // _r1 var scope dim1_r.name( "vector length declaration:" " data-only integer expression in square brackets"); dim1_r %= lit('[') > int_data_expr_r(_r1) > lit(']'); // _r1 var scope int_data_expr_r.name("data-only integer expression"); int_data_expr_r %= expression_g(_r1)[validate_int_data_only_expr_f( _1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))]; identifier_r.name("identifier"); identifier_r %= identifier_name_r[validate_identifier_f( _val, _pass, boost::phoenix::ref(error_msgs_))]; identifier_name_r.name("identifier subrule"); identifier_name_r %= lexeme[char_("a-zA-Z") >> *char_("a-zA-Z0-9_.")]; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/bare_type_grammar.hpp0000644000176200001440000000270313766554456025561 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_BARE_TYPE_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_BARE_TYPE_GRAMMAR_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { template struct bare_type_grammar : boost::spirit::qi::grammar > { std::stringstream& error_msgs_; bare_type_grammar(std::stringstream& error_msgs); boost::spirit::qi::rule > bare_type_r; boost::spirit::qi::rule > array_bare_type_r; boost::spirit::qi::rule > single_bare_type_r; boost::spirit::qi::rule > type_identifier_r; boost::spirit::qi::rule > bare_dims_r; boost::spirit::qi::rule > end_bare_types_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/functions_grammar.hpp0000644000176200001440000000402613766554456025617 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_FUNCTIONS_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_FUNCTIONS_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct functions_grammar : boost::spirit::qi::grammar(), whitespace_grammar > { variable_map& var_map_; std::set > functions_declared_; std::set > functions_defined_; std::stringstream& error_msgs_; statement_grammar statement_g; bare_type_grammar bare_type_g; functions_grammar(variable_map& var_map, std::stringstream& error_msgs, bool allow_undefined = false); boost::spirit::qi::rule(), whitespace_grammar > functions_r; boost::spirit::qi::rule, function_decl_def(), whitespace_grammar > function_r; boost::spirit::qi::rule(), whitespace_grammar > arg_decls_r; boost::spirit::qi::rule, var_decl(), whitespace_grammar > arg_decl_r; boost::spirit::qi::rule > identifier_r; boost::spirit::qi::rule > close_arg_decls_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/statement_2_grammar_def.hpp0000644000176200001440000000432313766554456026652 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_STATEMENT_2_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_STATEMENT_2_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { template statement_2_grammar::statement_2_grammar( variable_map& var_map, std::stringstream& error_msgs, statement_grammar& sg) : statement_2_grammar::base_type(statement_2_r), var_map_(var_map), error_msgs_(error_msgs), expression_g(var_map, error_msgs), statement_g(sg) { using boost::spirit::qi::_1; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::labels::_r1; using boost::spirit::qi::labels::_r2; using boost::spirit::qi::lit; using boost::spirit::qi::no_skip; // _r1 var_scope // _r2 true if in loop (allowing break/continue) statement_2_r.name("statement"); statement_2_r %= conditional_statement_r(_r1, _r2); // _r1 var_scope // _r2 true if in loop (allowing break/continue) conditional_statement_r.name("if-else statement"); conditional_statement_r = (lit("if") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > expression_g(_r1)[add_conditional_condition_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))] > lit(')') > statement_g(_r1, _r2)[add_conditional_body_f(_val, _1)] > *(((lit("else") >> no_skip[!char_("a-zA-Z0-9_")]) >> (lit("if") >> no_skip[!char_("a-zA-Z0-9_")])) > lit('(') > expression_g(_r1)[add_conditional_condition_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))] > lit(')') > statement_g(_r1, _r2)[add_conditional_body_f(_val, _1)]) > -((lit("else") >> no_skip[!char_("a-zA-Z0-9_")]) > statement_g(_r1, _r2)[add_conditional_body_f(_val, _1)]); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/statement_2_grammar_inst.cpp0000644000176200001440000000033513766554456027063 0ustar liggesusers#include #include namespace stan { namespace lang { template struct statement_2_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/iterator_typedefs.hpp0000644000176200001440000000067313766554456025641 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_ITERATOR_TYPEDEFS_HPP #define STAN_LANG_GRAMMARS_ITERATOR_TYPEDEFS_HPP #include #include #include namespace stan { namespace lang { typedef std::string::const_iterator input_iterator_t; typedef boost::spirit::line_pos_iterator pos_iterator_t; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/expression_grammar.hpp0000644000176200001440000000343113766554456026005 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_EXPRESSION_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_EXPRESSION_GRAMMAR_HPP #include #include #include #include #include #include namespace stan { namespace lang { template struct expression07_grammar; template struct expression_grammar : public boost::spirit::qi::grammar > { variable_map& var_map_; std::stringstream& error_msgs_; expression07_grammar expression07_g; expression_grammar(variable_map& var_map, std::stringstream& error_msgs); boost::spirit::qi::rule > expression_r; boost::spirit::qi::rule > expression09_r; boost::spirit::qi::rule > expression10_r; boost::spirit::qi::rule > expression14_r; boost::spirit::qi::rule > expression15_r; boost::spirit::qi::rule< Iterator, boost::spirit::qi::locals, conditional_op(scope), whitespace_grammar > conditional_op_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/expression_grammar_inst.cpp0000644000176200001440000000033313766554456027033 0ustar liggesusers#include #include namespace stan { namespace lang { template struct expression_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/expression07_grammar_inst.cpp0000644000176200001440000000033713766554456027206 0ustar liggesusers#include #include namespace stan { namespace lang { template struct expression07_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/local_var_decls_grammar.hpp0000644000176200001440000000660213766554456026725 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_LOCAL_VAR_DECLS_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_LOCAL_VAR_DECLS_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct local_var_decls_grammar : boost::spirit::qi::grammar(scope), whitespace_grammar > { local_var_decls_grammar(variable_map& var_map, std::stringstream& error_msgs); variable_map& var_map_; std::stringstream& error_msgs_; expression_grammar expression_g; expression07_grammar expression07_g; // disallows comparisons boost::spirit::qi::rule(scope), whitespace_grammar > local_var_decls_r; boost::spirit::qi::rule > local_var_decl_r; boost::spirit::qi::rule > array_local_var_decl_r; boost::spirit::qi::rule > single_local_var_decl_r; boost::spirit::qi::rule > local_element_type_r; boost::spirit::qi::rule > local_double_type_r; boost::spirit::qi::rule > local_int_type_r; boost::spirit::qi::rule > local_matrix_type_r; boost::spirit::qi::rule > local_row_vector_type_r; boost::spirit::qi::rule > local_vector_type_r; boost::spirit::qi::rule > local_identifier_r; boost::spirit::qi::rule > local_identifier_name_r; boost::spirit::qi::rule > local_opt_def_r; boost::spirit::qi::rule > local_def_r; boost::spirit::qi::rule > local_dim1_r; boost::spirit::qi::rule > local_int_expr_r; boost::spirit::qi::rule(scope), whitespace_grammar > local_dims_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/program_grammar.hpp0000644000176200001440000000603613766554456025261 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_PROGRAM_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_PROGRAM_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct program_grammar : boost::spirit::qi::grammar > { std::string model_name_; const io::program_reader& reader_; variable_map var_map_; std::stringstream error_msgs_; expression_grammar expression_g; block_var_decls_grammar block_var_decls_g; statement_grammar statement_g; functions_grammar functions_g; program_grammar(const std::string& model_name, const io::program_reader& reader, bool allow_undefined = false); boost::spirit::qi::rule, std::vector(), whitespace_grammar > data_var_decls_r; boost::spirit::qi::rule< Iterator, boost::spirit::qi::locals, std::pair, std::vector >(), whitespace_grammar > derived_data_var_decls_r; boost::spirit::qi::rule< Iterator, boost::spirit::qi::locals, std::pair, std::vector >(), whitespace_grammar > derived_var_decls_r; boost::spirit::qi::rule< Iterator, boost::spirit::qi::locals, std::pair, std::vector >(), whitespace_grammar > generated_var_decls_r; boost::spirit::qi::rule, statement(), whitespace_grammar > model_r; boost::spirit::qi::rule, std::vector(), whitespace_grammar > param_var_decls_r; boost::spirit::qi::rule > program_r; boost::spirit::qi::rule > end_var_decls_r; boost::spirit::qi::rule > end_var_decls_statements_r; boost::spirit::qi::rule > end_var_definitions_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/indexes_grammar_inst.cpp0000644000176200001440000000034213766554456026273 0ustar liggesusers#include #include namespace stan { namespace lang { template struct stan::lang::indexes_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/term_grammar_def.hpp0000644000176200001440000004020113766554456025367 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_TERM_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_TERM_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT( stan::lang::index_op, (stan::lang::expression, expr_)(std::vector >, dimss_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::index_op_sliced, (stan::lang::expression, expr_)(std::vector, idxs_)) BOOST_FUSION_ADAPT_STRUCT( stan::lang::integrate_1d, (std::string, function_name_)(stan::lang::expression, lb_)(stan::lang::expression, ub_)(stan::lang::expression, theta_)( stan::lang::expression, x_r_)(stan::lang::expression, x_i_)(stan::lang::expression, rel_tol_)) BOOST_FUSION_ADAPT_STRUCT( stan::lang::integrate_ode, (std::string, integration_function_name_)(std::string, system_function_name_)( stan::lang::expression, y0_)(stan::lang::expression, t0_)(stan::lang::expression, ts_)( stan::lang::expression, theta_)(stan::lang::expression, x_)(stan::lang::expression, x_int_)) BOOST_FUSION_ADAPT_STRUCT( stan::lang::integrate_ode_control, (std::string, integration_function_name_)(std::string, system_function_name_)( stan::lang::expression, y0_)(stan::lang::expression, t0_)(stan::lang::expression, ts_)(stan::lang::expression, theta_)( stan::lang::expression, x_)(stan::lang::expression, x_int_)(stan::lang::expression, rel_tol_)(stan::lang::expression, abs_tol_)(stan::lang::expression, max_num_steps_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::algebra_solver, (std::string, system_function_name_)(stan::lang::expression, y_)( stan::lang::expression, theta_)(stan::lang::expression, x_r_)(stan::lang::expression, x_i_)) BOOST_FUSION_ADAPT_STRUCT( stan::lang::algebra_solver_control, (std::string, system_function_name_)(stan::lang::expression, y_)(stan::lang::expression, theta_)( stan::lang::expression, x_r_)(stan::lang::expression, x_i_)(stan::lang::expression, rel_tol_)(stan::lang::expression, fun_tol_)(stan::lang::expression, max_num_steps_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::map_rect, (std::string, fun_name_)(stan::lang::expression, shared_params_)( stan::lang::expression, job_params_)(stan::lang::expression, job_data_r_)(stan::lang::expression, job_data_i_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::fun, (std::string, name_)(std::vector, args_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::array_expr, (std::vector, args_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::row_vector_expr, (std::vector, args_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::int_literal, (int, val_)(stan::lang::bare_expr_type, type_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::double_literal, (double, val_)(stan::lang::bare_expr_type, type_)) namespace stan { namespace lang { template term_grammar::term_grammar(variable_map& var_map, std::stringstream& error_msgs, expression_grammar& eg) : term_grammar::base_type(term_r), var_map_(var_map), error_msgs_(error_msgs), expression_g(eg), indexes_g(var_map, error_msgs, eg) { using boost::spirit::qi::_1; using boost::spirit::qi::_a; using boost::spirit::qi::_b; using boost::spirit::qi::_c; using boost::spirit::qi::_d; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::double_; using boost::spirit::qi::eps; using boost::spirit::qi::hold; using boost::spirit::qi::int_; using boost::spirit::qi::lexeme; using boost::spirit::qi::lit; using boost::spirit::qi::no_skip; using boost::spirit::qi::raw; using boost::spirit::qi::string; using boost::spirit::qi::labels::_r1; using boost::phoenix::begin; using boost::phoenix::end; term_r.name("expression"); term_r = (negated_factor_r(_r1)[assign_lhs_f(_val, _1)] >> *((lit('*') > negated_factor_r(_r1)[multiplication_f( _val, _1, boost::phoenix::ref(error_msgs_))]) | (lit('/') > negated_factor_r(_r1)[division_f( _val, _1, boost::phoenix::ref(error_msgs_))]) | (lit('%') > negated_factor_r(_r1)[modulus_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))]) | (lit('\\') > negated_factor_r(_r1)[left_division_f( _val, _pass, _1, boost::phoenix::ref(error_msgs_))]) | (lit(".*") > negated_factor_r(_r1)[elt_multiplication_f( _val, _1, boost::phoenix::ref(error_msgs_))]) | (lit("./") > negated_factor_r(_r1)[elt_division_f( _val, _1, boost::phoenix::ref(error_msgs_))]))); negated_factor_r.name("expression"); negated_factor_r = lit('-') >> negated_factor_r(_r1)[negate_expr_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))] | lit('!') >> negated_factor_r(_r1)[logical_negate_expr_f( _val, _1, boost::phoenix::ref(error_msgs_))] | lit('+') >> negated_factor_r(_r1)[assign_lhs_f(_val, _1)] | exponentiated_factor_r(_r1)[assign_lhs_f(_val, _1)]; exponentiated_factor_r.name("expression"); exponentiated_factor_r = idx_factor_r(_r1)[assign_lhs_f(_val, _1)] >> -(lit('^') > negated_factor_r(_r1)[exponentiation_f( _val, _1, _r1, _pass, boost::phoenix::ref(error_msgs_))]); idx_factor_r.name("expression"); idx_factor_r = factor_r(_r1)[assign_lhs_f(_val, _1)] > *(((+dims_r(_r1))[assign_lhs_f(_a, _1)] > eps[add_expression_dimss_f(_val, _a, _pass, boost::phoenix::ref(error_msgs_))]) | (indexes_g(_r1)[assign_lhs_f(_b, _1)] > eps[add_idxs_f(_val, _b, _pass, boost::phoenix::ref(error_msgs_))]) | (lit("'") > eps[transpose_f(_val, _pass, boost::phoenix::ref(error_msgs_))])); integrate_ode_control_r.name("expression"); integrate_ode_control_r %= ((string("integrate_ode_rk45") >> no_skip[!char_("a-zA-Z0-9_")]) | (string("integrate_ode_bdf") >> no_skip[!char_("a-zA-Z0-9_")]) | (string("integrate_ode_adams") >> no_skip[!char_("a-zA-Z0-9_")])) >> lit('(') // >> allows backtracking to non-control >> identifier_r // 1) system function name (function only) >> lit(',') >> expression_g(_r1) // 2) y0 >> lit(',') >> expression_g(_r1) // 3) t0 >> lit(',') >> expression_g(_r1) // 4) ts >> lit(',') >> expression_g(_r1) // 5) theta >> lit(',') >> expression_g(_r1) // 6) x (data only) >> lit(',') >> expression_g(_r1) // 7) x_int (data only) >> lit(',') >> expression_g(_r1) // 8) relative tolerance (data only) >> lit(',') >> expression_g(_r1) // 9) absolute tolerance (data only) >> lit(',') >> expression_g(_r1) // 10) maximum number of steps (data only) > lit(')')[validate_integrate_ode_control_f( _val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; integrate_ode_r.name("expression"); integrate_ode_r %= ((string("integrate_ode_rk45") >> no_skip[!char_("a-zA-Z0-9_")]) | (string("integrate_ode_bdf") >> no_skip[!char_("a-zA-Z0-9_")]) | (string("integrate_ode_adams") >> no_skip[!char_("a-zA-Z0-9_")]) | (string("integrate_ode") >> no_skip[!char_("a-zA-Z0-9_")])[deprecated_integrate_ode_f( boost::phoenix::ref(error_msgs_))]) > lit('(') > identifier_r // 1) system function name (function only) > lit(',') > expression_g(_r1) // 2) y0 > lit(',') > expression_g(_r1) // 3) t0 > lit(',') > expression_g(_r1) // 4) ts > lit(',') > expression_g(_r1) // 5) theta > lit(',') > expression_g(_r1) // 6) x (data only) > lit(',') > expression_g(_r1) // 7) x_int (data only) > lit(')')[validate_integrate_ode_f( _val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; algebra_solver_control_r.name("expression"); algebra_solver_control_r %= lit("algebra_solver") >> lit('(') >> identifier_r // 1) system function name (function only) >> lit(',') >> expression_g(_r1) // 2) y >> lit(',') >> expression_g(_r1) // 3) theta >> lit(',') >> expression_g(_r1) // 4) x_r (data only) >> lit(',') >> expression_g(_r1) // 5) x_i (data only) >> lit(',') >> expression_g(_r1) // 6) relative tolerance (data only) >> lit(',') >> expression_g(_r1) // 7) function tolerance (data only) >> lit(',') >> expression_g(_r1) // 8) maximum number of steps (data only) > lit(')')[validate_algebra_solver_control_f( _val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; algebra_solver_r.name("expression"); algebra_solver_r %= (lit("algebra_solver") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > identifier_r // 1) system function name (function only) > lit(',') > expression_g(_r1) // 2) y > lit(',') > expression_g(_r1) // 3) theta > lit(',') > expression_g(_r1) // 4) x_r (data only) > lit(',') > expression_g(_r1) // 5) x_i (data only) > lit(')')[validate_algebra_solver_f( _val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; map_rect_r.name("map_rect"); map_rect_r %= (lit("map_rect") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > identifier_r // 1) mapped function name > lit(',') > expression_g(_r1) // 2) shared param vector > lit(',') > expression_g(_r1) // 3) job-specific param vector > lit(',') > expression_g(_r1) // 4) job-specific real data vector > lit(',') > expression_g(_r1) // 4) job-specific integer data vector > lit(')')[validate_map_rect_f(_val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; integrate_1d_r.name("integrate_1d"); integrate_1d_r %= (lit("integrate_1d") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > identifier_r // 1) integrated function name > lit(',') > expression_g(_r1) // 2) integration lower bound > lit(',') > expression_g(_r1) // 3) integration upper bound > lit(',') > expression_g(_r1) // 4) parameters > lit(',') > expression_g(_r1) // 5) real data > lit(',') > expression_g(_r1) // 6) integer data > lit(',') > expression_g(_r1) // 7) relative tolerance > lit(')')[validate_integrate_1d_f(_val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; factor_r.name("expression"); factor_r = integrate_1d_r(_r1)[assign_lhs_f(_val, _1)] | integrate_ode_control_r(_r1)[assign_lhs_f(_val, _1)] | integrate_ode_r(_r1)[assign_lhs_f(_val, _1)] | algebra_solver_control_r(_r1)[assign_lhs_f(_val, _1)] | algebra_solver_r(_r1)[assign_lhs_f(_val, _1)] | map_rect_r(_r1)[assign_lhs_f(_val, _1)] | (fun_r(_r1)[assign_lhs_f(_b, _1)] > eps[set_fun_type_named_f(_val, _b, _r1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))]) | (variable_r[assign_lhs_f(_a, _1)] > eps[set_var_type_f(_a, _val, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_), _pass)]) | int_literal_r[assign_lhs_f(_val, _1)] | str_double_literal_r[assign_lhs_f(_val, _1)] | (array_expr_r(_r1)[assign_lhs_f(_c, _1)] > eps[infer_array_expr_type_f(_val, _c, _r1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))]) | (vec_expr_r(_r1)[assign_lhs_f(_d, _1)] > eps[infer_vec_or_matrix_expr_type_f( _val, _d, _r1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))]) | (lit('(') > expression_g(_r1)[assign_lhs_f(_val, _1)] > lit(')')); str_double_literal_r.name("double literal"); str_double_literal_r = raw[double_literal_r][add_literal_string_f(_val, begin(_1), end(_1))]; int_literal_r.name("integer literal"); int_literal_r %= int_ >> !(lit('.') | lit('e') | lit('E')); double_literal_r.name("real literal"); double_literal_r %= double_; fun_r.name("function and argument expressions"); fun_r %= (hold[identifier_r[is_prob_fun_f(_1, _pass)]] >> &lit('(') > prob_args_r(_r1)) | (identifier_r >> args_r(_r1)); identifier_r.name("identifier"); identifier_r %= lexeme[char_("a-zA-Z") >> *char_("a-zA-Z0-9_.")]; prob_args_r.name("probability function argument"); prob_args_r %= (lit('(') >> lit(')')) | hold[lit('(') >> expression_g(_r1) >> lit(')')] | (lit('(') >> expression_g(_r1) >> (lit(',')[require_vbar_f( _pass, boost::phoenix::ref(error_msgs_))] | (eps > lit('|'))) >> (expression_g(_r1) % ',') >> lit(')')); args_r.name("function arguments"); args_r %= (lit('(') >> lit(')')) | (lit('(') >> (expression_g(_r1) % ',') >> lit(')')); dim_r.name("array dimension (integer expression)"); dim_r %= expression_g(_r1) >> eps[validate_int_expr_silent_f(_val, _pass)]; dims_r.name("array dimensions"); dims_r %= lit('[') >> (dim_r(_r1) % ',') >> lit(']'); variable_r.name("variable name"); variable_r %= identifier_r > !lit('('); // negative lookahead to prevent // failure in fun to try to evaluate // as variable [cleaner error msgs] array_expr_r.name("array expression"); array_expr_r %= lit('{') >> expression_g(_r1) % ',' >> lit('}'); vec_expr_r.name("row vector or matrix expression"); vec_expr_r %= lit('[') >> expression_g(_r1) % ',' >> lit(']'); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/term_grammar.hpp0000644000176200001440000001034413766554456024556 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_TERM_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_TERM_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct expression_grammar; template struct indexes_grammar; template struct term_grammar : public boost::spirit::qi::grammar > { term_grammar(variable_map& var_map, std::stringstream& error_msgs, expression_grammar& eg); variable_map& var_map_; std::stringstream& error_msgs_; expression_grammar& expression_g; indexes_grammar indexes_g; boost::spirit::qi::rule(scope), whitespace_grammar > args_r; boost::spirit::qi::rule > array_expr_r; boost::spirit::qi::rule > vec_expr_r; boost::spirit::qi::rule > dim_r; boost::spirit::qi::rule(scope), whitespace_grammar > dims_r; boost::spirit::qi::rule > double_literal_r; boost::spirit::qi::rule > exponentiated_factor_r; boost::spirit::qi::rule< Iterator, boost::spirit::qi::locals, expression(scope), whitespace_grammar > factor_r; boost::spirit::qi::rule > fun_r; boost::spirit::qi::rule > integrate_ode_r; boost::spirit::qi::rule > integrate_ode_control_r; boost::spirit::qi::rule > algebra_solver_r; boost::spirit::qi::rule > algebra_solver_control_r; boost::spirit::qi::rule > map_rect_r; boost::spirit::qi::rule > integrate_1d_r; boost::spirit::qi::rule > identifier_r; boost::spirit::qi::rule< Iterator, expression(scope), boost::spirit::qi::locals >, std::vector >, whitespace_grammar > idx_factor_r; boost::spirit::qi::rule > int_literal_r; boost::spirit::qi::rule > negated_factor_r; boost::spirit::qi::rule(scope), whitespace_grammar > prob_args_r; boost::spirit::qi::rule > str_double_literal_r; boost::spirit::qi::rule > term_r; boost::spirit::qi::rule > variable_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/term_grammar_inst.cpp0000644000176200001440000000031713766554456025605 0ustar liggesusers#include #include namespace stan { namespace lang { template struct term_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/bare_type_grammar_inst.cpp0000644000176200001440000000035013766554456026605 0ustar liggesusers#include #include namespace stan { namespace lang { template struct stan::lang::bare_type_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/statement_grammar_def.hpp0000644000176200001440000003344313766554456026436 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_STATEMENT_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_STATEMENT_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::assgn, (stan::lang::variable, lhs_var_)(std::vector, idxs_)(std::string, op_)(stan::lang::expression, rhs_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::distribution, (std::string, family_)(std::vector, args_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::for_statement, (std::string, variable_)(stan::lang::range, range_)( stan::lang::statement, statement_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::for_array_statement, (std::string, variable_)(stan::lang::expression, expression_)(stan::lang::statement, statement_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::for_matrix_statement, (std::string, variable_)(stan::lang::expression, expression_)(stan::lang::statement, statement_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::return_statement, (stan::lang::expression, return_value_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::break_continue_statement, (std::string, generate_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::print_statement, (std::vector, printables_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::reject_statement, (std::vector, printables_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::increment_log_prob_statement, (stan::lang::expression, log_prob_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::sample, (stan::lang::expression, expr_)(stan::lang::distribution, dist_)(stan::lang::range, truncation_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::statements, (std::vector, local_decl_)(std::vector, statements_)) namespace stan { namespace lang { template statement_grammar::statement_grammar(variable_map& var_map, std::stringstream& error_msgs) : statement_grammar::base_type(statement_r), var_map_(var_map), error_msgs_(error_msgs), expression_g(var_map, error_msgs), local_var_decls_g(var_map, error_msgs), statement_2_g(var_map, error_msgs, *this), indexes_g(var_map, error_msgs, expression_g) { using boost::spirit::qi::_1; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::eps; using boost::spirit::qi::lexeme; using boost::spirit::qi::lit; using boost::spirit::qi::no_skip; using boost::spirit::qi::raw; using boost::spirit::qi::string; using boost::spirit::qi::labels::_a; using boost::spirit::qi::labels::_b; using boost::spirit::qi::labels::_r1; using boost::spirit::qi::labels::_r2; using boost::phoenix::begin; using boost::phoenix::end; // _r1 var scope // _r2 true if in loop (allowing break/continue) // raw[ ] just to wrap to get line numbers statement_r.name("statement"); statement_r = raw[statement_sub_r(_r1, _r2)[assign_lhs_f(_val, _1)]] [add_line_number_f(_val, begin(_1), end(_1))]; statement_sub_r.name("statement"); statement_sub_r %= no_op_statement_r // key ";" | statement_seq_r(_r1, _r2) // key "{" | increment_log_prob_statement_r(_r1) // key "increment_log_prob" | increment_target_statement_r(_r1) // key "target" | for_statement_r(_r1) // key "for" | for_array_statement_r(_r1) // key "for" | for_matrix_statement_r(_r1) // key "for" | while_statement_r(_r1) // key "while" | break_continue_statement_r(_r2) // key "break", "continue" | statement_2_g(_r1, _r2) // key "if" | print_statement_r(_r1) // key "print" | reject_statement_r(_r1) // key "reject" | void_return_statement_r(_r1) // key "return" | return_statement_r(_r1) // key "return" | assgn_r(_r1) // var[idxs] = expr | sample_r(_r1) // expression "~" | expression_g(_r1) // expression [expression_as_statement_f(_pass, _1, boost::phoenix::ref(error_msgs_))]; // _r1 = var scope, _r2 = true if in loop, _a var_decls, _b local scope statement_seq_r.name("sequence of statements"); statement_seq_r %= lit('{') > eps[reset_var_scope_f(_b, _r1)] > local_var_decls_r(_b)[assign_lhs_f(_a, _1)] > *statement_r(_b, _r2) > lit('}') > eps[unscope_locals_f(_a, boost::phoenix::ref(var_map_))]; local_var_decls_r %= local_var_decls_g(_r1); // _r1 = var scope increment_log_prob_statement_r.name("increment log prob statement"); increment_log_prob_statement_r %= (lit("increment_log_prob") >> no_skip[!char_("a-zA-Z0-9_")]) > eps[deprecate_increment_log_prob_f(boost::phoenix::ref(error_msgs_))] > eps[validate_allow_sample_f(_r1, _pass, boost::phoenix::ref(error_msgs_))] > lit('(') > expression_g(_r1)[validate_non_void_expression_f( _1, _pass, boost::phoenix::ref(error_msgs_))] > lit(')') > lit(';'); // just variant syntax for increment_log_prob_r (see above) // _r1 = var scope increment_target_statement_r.name("increment target statement"); increment_target_statement_r %= (lit("target") >> lit("+=")) > eps[validate_allow_sample_f(_r1, _pass, boost::phoenix::ref(error_msgs_))] > expression_g(_r1)[validate_non_void_expression_f( _1, _pass, boost::phoenix::ref(error_msgs_))] > lit(';'); // _r1 = var scope while_statement_r.name("while statement"); while_statement_r = (lit("while") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > expression_g(_r1)[add_while_condition_f( _val, _1, _pass, boost::phoenix::ref(error_msgs_))] > lit(')') > statement_r(_r1, true)[add_while_body_f(_val, _1)]; // _r1 = true if in loop break_continue_statement_r.name("break or continue statement"); break_continue_statement_r %= (string("break") | string("continue")) > eps[validate_in_loop_f(_r1, _pass, boost::phoenix::ref(error_msgs_))] > lit(';'); // _r1 = var scope for_statement_r.name("for statement"); for_statement_r %= lit("for") >> no_skip[!char_("a-zA-Z0-9_")] >> lit('(') >> identifier_r[store_loop_identifier_f( _1, _a, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))] >> lit("in") >> (range_r(_r1) > lit(')')) >> (eps[add_loop_identifier_f(_a, _r1, boost::phoenix::ref(var_map_))] > statement_r(_r1, true)) > eps[remove_loop_identifier_f(_a, boost::phoenix::ref(var_map_))]; // _r1 = var scope for_array_statement_r.name("for statement, loop over array"); for_array_statement_r %= lit("for") >> no_skip[!char_("a-zA-Z0-9_")] >> lit('(') >> identifier_r[store_loop_identifier_f( _1, _a, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))] >> lit("in") >> (expression_rhs_r(_r1)[add_array_loop_identifier_f( _1, _a, _r1, _pass, boost::phoenix::ref(var_map_))] > lit(')')) >> (eps > statement_r(_r1, true)) > eps[remove_loop_identifier_f(_a, boost::phoenix::ref(var_map_))]; // _r1 = var scope for_matrix_statement_r.name("for statement, loop over vector or matrix"); for_matrix_statement_r %= (lit("for") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > identifier_r[store_loop_identifier_f( _1, _a, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))] > lit("in") > expression_rhs_r(_r1)[add_matrix_loop_identifier_f( _1, _a, _r1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))] > lit(')') > statement_r(_r1, true) > eps[remove_loop_identifier_f(_a, boost::phoenix::ref(var_map_))]; // _r1 = var scope print_statement_r.name("print statement"); print_statement_r %= (lit("print") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > (printable_r(_r1) % ',') > lit(')'); // _r1 = var scope reject_statement_r.name("reject statement"); reject_statement_r %= (lit("reject") >> no_skip[!char_("a-zA-Z0-9_")]) > lit('(') > (printable_r(_r1) % ',') > lit(')'); // _r1 = var scope printable_r.name("printable"); printable_r %= printable_string_r | expression_g(_r1)[non_void_expression_f( _1, _pass, boost::phoenix::ref(error_msgs_))]; printable_string_r.name("printable quoted string"); printable_string_r %= lit('"') > no_skip[*char_("a-zA-Z0-9/~!@#$%^&*()`_+-={}|[]:;'<>?,./ ")] > lit('"'); identifier_r.name("identifier"); identifier_r %= (lexeme[char_("a-zA-Z") >> *char_("a-zA-Z0-9_.")]); // _r1 = var scope range_r.name("range expression pair, colon"); range_r %= expression_g(_r1)[validate_int_expr_silent_f(_1, _pass)] >> lit(':') >> expression_g(_r1)[validate_int_expr_f( _1, _pass, boost::phoenix::ref(error_msgs_))]; // _r1 = var scope assgn_r.name("assignment statement"); assgn_r %= identifier_r[set_lhs_var_assgn_f(_val, _1, _pass, boost::phoenix::ref(var_map_))] >> opt_idxs_r(_r1) >> assignment_operator_r >> (eps[validate_lhs_var_assgn_f(_val, _r1, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))] > expression_rhs_r(_r1))[validate_assgn_f( _val, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))] > lit(';'); assignment_operator_r.name("assignment operator"); assignment_operator_r %= (string("=") >> no_skip[!char_("=")]) | string("+=") | string("-=") | string("*=") | string("/=") | string(".*=") | string("./=") | string("<-")[deprecate_old_assignment_op_f( _val, boost::phoenix::ref(error_msgs_))]; // _r1 = var scope expression_rhs_r.name("expression assignable to left-hand side"); expression_rhs_r %= expression_g(_r1); // _r1 = var scope opt_idxs_r.name("array indexes (optional)"); opt_idxs_r %= *idxs_r(_r1); idxs_r.name("array indexes"); idxs_r %= indexes_g(_r1); // _r1 = var scope sample_r.name("distribution of expression"); sample_r %= (expression_g(_r1) >> lit('~')) > eps[validate_allow_sample_f(_r1, _pass, boost::phoenix::ref(error_msgs_))] > distribution_r(_r1) > -truncation_range_r(_r1) > lit(';') > eps[validate_sample_f(_val, boost::phoenix::ref(var_map_), _pass, boost::phoenix::ref(error_msgs_))]; // _r1 = var scope distribution_r.name("distribution and parameters"); distribution_r %= (identifier_r >> lit('(') >> -(expression_g(_r1) % ',')) > lit(')'); // _r1 = var scope truncation_range_r.name("range pair"); truncation_range_r %= lit('T') > lit('[') > -expression_g(_r1) > lit(',') > -expression_g(_r1) > lit(']'); // _r1 = var scope void_return_statement_r.name("void return statement"); void_return_statement_r = lit("return")[set_void_return_f(_val)] >> lit(';')[validate_void_return_allowed_f( _r1, _pass, boost::phoenix::ref(error_msgs_))]; // _r1 = var scope return_statement_r.name("return statement"); return_statement_r %= (lit("return") >> no_skip[!char_("a-zA-Z0-9_")]) > (expression_g(_r1) | (eps[non_void_return_msg_f( _r1, _pass, boost::phoenix::ref(error_msgs_))] > expression_g(_r1))) > lit(';')[validate_return_allowed_f( _r1, _pass, boost::phoenix::ref(error_msgs_))]; no_op_statement_r.name("no op statement"); no_op_statement_r %= lit(';')[set_no_op_f(_val)]; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/whitespace_grammar_inst.cpp0000644000176200001440000000033313766554456026770 0ustar liggesusers#include #include namespace stan { namespace lang { template struct whitespace_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/block_var_decls_grammar.hpp0000644000176200001440000001333213766554456026723 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_BLOCK_VAR_DECLS_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_BLOCK_VAR_DECLS_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct block_var_decls_grammar : boost::spirit::qi::grammar(scope), whitespace_grammar> { block_var_decls_grammar(variable_map &var_map, std::stringstream &error_msgs); variable_map &var_map_; std::stringstream &error_msgs_; expression_grammar expression_g; expression07_grammar expression07_g; // disallows comparisons boost::spirit::qi::rule(scope), whitespace_grammar> var_decls_r; boost::spirit::qi::rule> var_decl_r; boost::spirit::qi::rule> array_var_decl_r; boost::spirit::qi::rule> single_var_decl_r; boost::spirit::qi::rule> element_type_r; boost::spirit::qi::rule> double_range_type_r; boost::spirit::qi::rule> double_offset_multiplier_type_r; boost::spirit::qi::rule> int_type_r; boost::spirit::qi::rule> matrix_range_type_r; boost::spirit::qi::rule> matrix_offset_multiplier_type_r; boost::spirit::qi::rule> row_vector_range_type_r; boost::spirit::qi::rule> row_vector_offset_multiplier_type_r; boost::spirit::qi::rule> vector_range_type_r; boost::spirit::qi::rule> vector_offset_multiplier_type_r; boost::spirit::qi::rule> cholesky_factor_corr_type_r; boost::spirit::qi::rule> cholesky_factor_cov_type_r; boost::spirit::qi::rule> corr_matrix_type_r; boost::spirit::qi::rule> cov_matrix_type_r; boost::spirit::qi::rule> ordered_type_r; boost::spirit::qi::rule> positive_ordered_type_r; boost::spirit::qi::rule> simplex_type_r; boost::spirit::qi::rule> unit_vector_type_r; boost::spirit::qi::rule> identifier_r; boost::spirit::qi::rule> identifier_name_r; boost::spirit::qi::rule> opt_def_r; boost::spirit::qi::rule> def_r; boost::spirit::qi::rule> range_brackets_double_r; boost::spirit::qi::rule> empty_range_r; boost::spirit::qi::rule> offset_multiplier_brackets_double_r; boost::spirit::qi::rule> empty_offset_multiplier_r; boost::spirit::qi::rule> range_brackets_int_r; boost::spirit::qi::rule> dim1_r; boost::spirit::qi::rule> int_data_expr_r; boost::spirit::qi::rule(scope), whitespace_grammar> dims_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/whitespace_grammar.hpp0000644000176200001440000000075313766554456025746 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_WHITESPACE_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_WHITESPACE_GRAMMAR_HPP #include #include namespace stan { namespace lang { template struct whitespace_grammar : public boost::spirit::qi::grammar { explicit whitespace_grammar(std::stringstream& ss); std::stringstream& error_msgs_; boost::spirit::qi::rule whitespace; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/statement_grammar_inst.cpp0000644000176200001440000000033113766554456026636 0ustar liggesusers#include #include namespace stan { namespace lang { template struct statement_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/functions_grammar_inst.cpp0000644000176200001440000000033113766554456026642 0ustar liggesusers#include #include namespace stan { namespace lang { template struct functions_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/program_grammar_def.hpp0000644000176200001440000001303413766554456026073 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_PROGRAM_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_PROGRAM_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include // hack to pass pair into macro below to adapt; in namespace to hide struct DUMMY_STRUCT { typedef std::pair, std::vector > type; }; BOOST_FUSION_ADAPT_STRUCT( stan::lang::program, (std::vector, function_decl_defs_)(std::vector, data_decl_)(DUMMY_STRUCT::type, derived_data_decl_)( std::vector, parameter_decl_)(DUMMY_STRUCT::type, derived_decl_)( stan::lang::statement, statement_)(DUMMY_STRUCT::type, generated_decl_)) namespace stan { namespace lang { template program_grammar::program_grammar(const std::string& model_name, const io::program_reader& reader, bool allow_undefined) : program_grammar::base_type(program_r), model_name_(model_name), reader_(reader), var_map_(), error_msgs_(), expression_g(var_map_, error_msgs_), block_var_decls_g(var_map_, error_msgs_), statement_g(var_map_, error_msgs_), functions_g(var_map_, error_msgs_, allow_undefined) { using boost::spirit::qi::_1; using boost::spirit::qi::_2; using boost::spirit::qi::_3; using boost::spirit::qi::eps; using boost::spirit::qi::labels::_a; using boost::spirit::qi::lit; using boost::spirit::qi::on_error; using boost::spirit::qi::rethrow; // add model_name to var_map with special origin var_map_.add(model_name, var_decl(), scope(model_name_origin, true)); program_r.name("program"); program_r %= -functions_g > -data_var_decls_r > -derived_data_var_decls_r > -param_var_decls_r > eps[add_params_var_f(boost::phoenix::ref(var_map_))] > -derived_var_decls_r > -model_r > eps[remove_params_var_f(boost::phoenix::ref(var_map_))] > -generated_var_decls_r; model_r.name("model declaration (or perhaps an earlier block)"); model_r %= lit("model") > eps[set_var_scope_local_f(_a, model_name_origin)] > statement_g(_a, false); end_var_decls_r.name( "one of the following:\n" " a variable declaration, beginning with type,\n" " (int, real, vector, row_vector, matrix, unit_vector,\n" " simplex, ordered, positive_ordered,\n" " corr_matrix, cov_matrix,\n" " cholesky_corr, cholesky_cov\n" " or '}' to close variable declarations"); end_var_decls_r %= lit('}'); end_var_decls_statements_r.name( "one of the following:\n" " a variable declaration, beginning with type\n" " (int, real, vector, row_vector, matrix, unit_vector,\n" " simplex, ordered, positive_ordered,\n" " corr_matrix, cov_matrix,\n" " cholesky_corr, cholesky_cov\n" " or a \n" " or '}' to close variable declarations and definitions"); end_var_decls_statements_r %= lit('}'); end_var_definitions_r.name( "expected another statement or '}'" " to close declarations"); end_var_definitions_r %= lit('}'); data_var_decls_r.name("data variable declarations"); data_var_decls_r %= (lit("data") > lit('{')) > eps[set_var_scope_f(_a, data_origin)] > block_var_decls_g(_a) > end_var_decls_r; derived_data_var_decls_r.name("transformed data block"); derived_data_var_decls_r %= ((lit("transformed") >> lit("data")) > lit('{')) > eps[set_var_scope_f(_a, transformed_data_origin)] > block_var_decls_g(_a) > ((statement_g(_a, false) > *statement_g(_a, false) > end_var_definitions_r) | (*statement_g(_a, false) > end_var_decls_statements_r)); param_var_decls_r.name("parameter variable declarations"); param_var_decls_r %= (lit("parameters") > lit('{')) > eps[set_var_scope_f(_a, parameter_origin)] > block_var_decls_g(_a) > end_var_decls_r; derived_var_decls_r.name("derived variable declarations"); derived_var_decls_r %= (lit("transformed") > lit("parameters") > lit('{')) > eps[set_var_scope_f(_a, transformed_parameter_origin)] > block_var_decls_g(_a) > *statement_g(_a, false) > end_var_decls_statements_r; generated_var_decls_r.name("generated variable declarations"); generated_var_decls_r %= (lit("generated") > lit("quantities") > lit('{')) > eps[set_var_scope_f(_a, derived_origin)] > block_var_decls_g(_a) > *statement_g(_a, false) > end_var_decls_statements_r; on_error(program_r, program_error_f(_1, _2, _3, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_), boost::phoenix::ref(reader_))); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/expression07_grammar.hpp0000644000176200001440000000233713766554456026160 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_EXPRESSION07_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_EXPRESSION07_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct term_grammar; template struct expression_grammar; template struct expression07_grammar : public boost::spirit::qi::grammar > { expression07_grammar(variable_map& var_map, std::stringstream& error_msgs, expression_grammar& eg); // global parser information variable_map& var_map_; std::stringstream& error_msgs_; // nested grammars term_grammar term_g; boost::spirit::qi::rule > expression07_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/statement_grammar.hpp0000644000176200001440000001243513766554456025616 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_STATEMENT_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_STATEMENT_GRAMMAR_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template struct statement_grammar : boost::spirit::qi::grammar > { statement_grammar(variable_map& var_map, std::stringstream& error_msgs); variable_map& var_map_; std::stringstream& error_msgs_; expression_grammar expression_g; local_var_decls_grammar local_var_decls_g; statement_2_grammar statement_2_g; indexes_grammar indexes_g; boost::spirit::qi::rule > assgn_r; boost::spirit::qi::rule > assignment_operator_r; boost::spirit::qi::rule > distribution_r; boost::spirit::qi::rule > increment_log_prob_statement_r; boost::spirit::qi::rule > increment_target_statement_r; boost::spirit::qi::rule, for_statement(scope), whitespace_grammar > for_statement_r; boost::spirit::qi::rule, for_array_statement(scope), whitespace_grammar > for_array_statement_r; boost::spirit::qi::rule, for_matrix_statement(scope), whitespace_grammar > for_matrix_statement_r; boost::spirit::qi::rule > while_statement_r; boost::spirit::qi::rule > break_continue_statement_r; boost::spirit::qi::rule > print_statement_r; boost::spirit::qi::rule > reject_statement_r; boost::spirit::qi::rule > return_statement_r; boost::spirit::qi::rule > void_return_statement_r; boost::spirit::qi::rule > printable_r; boost::spirit::qi::rule > printable_string_r; boost::spirit::qi::rule > identifier_r; boost::spirit::qi::rule(scope), whitespace_grammar > local_var_decls_r; boost::spirit::qi::rule(scope), whitespace_grammar > idxs_r; boost::spirit::qi::rule > no_op_statement_r; boost::spirit::qi::rule(scope), whitespace_grammar > opt_idxs_r; boost::spirit::qi::rule > range_r; boost::spirit::qi::rule > sample_r; boost::spirit::qi::rule > statement_r; boost::spirit::qi::rule > statement_sub_r; boost::spirit::qi::rule< Iterator, boost::spirit::qi::locals, scope>, statements(scope, bool), whitespace_grammar > statement_seq_r; boost::spirit::qi::rule > truncation_range_r; boost::spirit::qi::rule > var_r; boost::spirit::qi::rule > expression_rhs_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/functions_grammar_def.hpp0000644000176200001440000001013413766554456026432 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_FUNCTIONS_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_FUNCTIONS_GRAMMAR_DEF_HPP #include #include #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::function_decl_def, (stan::lang::bare_expr_type, return_type_)(std::string, name_)( std::vector, arg_decls_)(stan::lang::statement, body_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::var_decl, (stan::lang::bare_expr_type, bare_type_)(std::string, name_)) namespace stan { namespace lang { template functions_grammar::functions_grammar(variable_map& var_map, std::stringstream& error_msgs, bool allow_undefined) : functions_grammar::base_type(functions_r), var_map_(var_map), functions_declared_(), functions_defined_(), error_msgs_(error_msgs), statement_g(var_map_, error_msgs_), bare_type_g(error_msgs_) { using boost::spirit::qi::_1; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::char_; using boost::spirit::qi::eps; using boost::spirit::qi::lexeme; using boost::spirit::qi::lit; using boost::spirit::qi::labels::_a; functions_r.name("function declarations and definitions"); functions_r %= (lit("functions") > lit("{")) >> *function_r > lit('}') > eps[validate_declarations_f( _pass, boost::phoenix::ref(functions_declared_), boost::phoenix::ref(functions_defined_), boost::phoenix::ref(error_msgs_), allow_undefined)]; // locals: _a = scope (origin) function subtype void,rng,lp) function_r.name("function declaration or definition"); function_r %= bare_type_g[set_void_function_f( _1, _a, _pass, boost::phoenix::ref(error_msgs_))] > identifier_r[set_allows_sampling_origin_f(_1, _a)] [validate_prob_fun_f( _1, _pass, boost::phoenix::ref(error_msgs_))] > lit('(') > arg_decls_r > close_arg_decls_r > eps[validate_pmf_pdf_variate_f( _val, _pass, boost::phoenix::ref(error_msgs_))] > eps[set_fun_params_scope_f(_a, boost::phoenix::ref(var_map_))] > statement_g(_a, false) > eps[unscope_variables_f(_val, boost::phoenix::ref(var_map_))] > eps[validate_return_type_f(_val, _pass, boost::phoenix::ref(error_msgs_))] > eps[add_function_signature_f( _val, _pass, boost::phoenix::ref(functions_declared_), boost::phoenix::ref(functions_defined_), boost::phoenix::ref(error_msgs_))]; close_arg_decls_r.name( "argument declaration or close paren )" " to end argument declarations"); close_arg_decls_r %= lit(')'); arg_decls_r.name("function argument declaration sequence"); arg_decls_r %= arg_decl_r % ',' | eps; // locals: _a = scope (origin) argument data or var arg_decl_r.name("function argument declaration"); arg_decl_r %= -(lit("data")[set_data_origin_f(_a)]) >> bare_type_g[validate_non_void_arg_f( _1, _a, _pass, boost::phoenix::ref(error_msgs_))] > identifier_r > eps[add_fun_arg_var_f(_val, _a, _pass, boost::phoenix::ref(var_map_), boost::phoenix::ref(error_msgs_))]; identifier_r.name("identifier"); identifier_r %= lexeme[char_("a-zA-Z") >> *char_("a-zA-Z0-9_.")]; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/semantic_actions_def.cpp0000644000176200001440000034107113766554456026241 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_SEMANTIC_ACTIONS_DEF_CPP #define STAN_LANG_GRAMMARS_SEMANTIC_ACTIONS_DEF_CPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Add namespace qualifier `stan::math::` or `std::` to function names * in order to avoid ambiguities for functions in the Stan language which * are also defined in c and/or other libraries that some compilers (gcc) * bring into the top-level namespace. * * @param[in, out] f Function to qualify. */ void qualify_builtins(fun &f) { if ((f.name_ == "max" || f.name_ == "min") && f.args_.size() == 2 && f.args_[0].bare_type().is_int_type() && f.args_[1].bare_type().is_int_type()) { f.name_ = "std::" + f.name_; return; } if (f.name_ == "ceil" && f.args_[0].bare_type().is_int_type()) { f.name_ = "std::" + f.name_; return; } if ((f.args_.size() == 0 && (f.name_ == "e" || f.name_ == "pi" || f.name_ == "log2" || f.name_ == "log10" || f.name_ == "sqrt2" || f.name_ == "not_a_number" || f.name_ == "positive_infinity" || f.name_ == "negative_infinity" || f.name_ == "machine_precision")) || (f.args_.size() == 1 && (f.name_ == "abs" || f.name_ == "acos" || f.name_ == "acosh" || f.name_ == "asin" || f.name_ == "asinh" || f.name_ == "atan" || f.name_ == "atan2" || f.name_ == "atanh" || f.name_ == "cbrt" || f.name_ == "ceil" || f.name_ == "cos" || f.name_ == "cosh" || f.name_ == "erf" || f.name_ == "erfc" || f.name_ == "exp" || f.name_ == "exp2" || f.name_ == "expm1" || f.name_ == "fabs" || f.name_ == "floor" || f.name_ == "lgamma" || f.name_ == "log" || f.name_ == "log1p" || f.name_ == "log2" || f.name_ == "log10" || f.name_ == "round" || f.name_ == "sin" || f.name_ == "sinh" || f.name_ == "sqrt" || f.name_ == "tan" || f.name_ == "tanh" || f.name_ == "tgamma" || f.name_ == "trunc")) || (f.args_.size() == 2 && (f.name_ == "fdim" || f.name_ == "fmax" || f.name_ == "fmin" || f.name_ == "hypot")) || (f.args_.size() == 3 && f.name_ == "fma")) f.name_ = "stan::math::" + f.name_; } bool has_prob_suffix(const std::string &s) { return ends_with("_lpdf", s) || ends_with("_lpmf", s) || ends_with("_lcdf", s) || ends_with("_lccdf", s); } bool has_rng_lp_suffix(const std::string &s) { return ends_with("_lp", s) || ends_with("_rng", s); } void replace_suffix(const std::string &old_suffix, const std::string &new_suffix, fun &f) { if (!ends_with(old_suffix, f.name_)) return; f.name_ = f.name_.substr(0, f.name_.size() - old_suffix.size()) + new_suffix; } bool deprecate_fun(const std::string &old_name, const std::string &new_name, fun &f, std::ostream &msgs) { if (f.name_ != old_name) return false; f.original_name_ = f.name_; f.name_ = new_name; msgs << "Info: Function name '" << old_name << "' is deprecated" << " and will be removed in a later release; please replace" << " with '" << new_name << "'" << std::endl; return true; } bool deprecate_suffix(const std::string &deprecated_suffix, const std::string &replacement, fun &f, std::ostream &msgs) { if (!ends_with(deprecated_suffix, f.name_)) return false; msgs << "Info: Deprecated function '" << f.name_ << "';" << " please replace suffix '" << deprecated_suffix << "' with " << replacement << std::endl; return true; } void set_fun_type(fun &fun, std::ostream &error_msgs) { std::vector arg_types; for (size_t i = 0; i < fun.args_.size(); ++i) arg_types.push_back(fun.args_[i].bare_type()); fun.type_ = function_signatures::instance().get_result_type( fun.name_, arg_types, error_msgs); } int num_dimss(std::vector> &dimss) { int sum = 0; for (size_t i = 0; i < dimss.size(); ++i) sum += dimss[i].size(); return sum; } bool is_double_return(const std::string &function_name, const std::vector &arg_types, std::ostream &error_msgs) { return function_signatures::instance() .get_result_type(function_name, arg_types, error_msgs, true) .is_double_type(); } bool is_univariate(const bare_expr_type &et) { return et.num_dims() == 0 && (et.is_int_type() || et.is_double_type()); } bool can_assign_to_lhs_var(const std::string &lhs_var_name, const scope &var_scope, const variable_map &vm, std::ostream &error_msgs) { if (lhs_var_name == std::string("lp__")) { error_msgs << std::endl << "Error (fatal): Use of lp__ is no longer supported." << std::endl << " Use target += ... statement to increment log density." << std::endl; return false; } if (!vm.exists(lhs_var_name)) { error_msgs << "Unknown variable in assignment" << "; lhs variable=" << lhs_var_name << std::endl; return false; } scope lhs_origin = vm.get_scope(lhs_var_name); // enforce constancy of loop variables if (lhs_origin.program_block() == loop_identifier_origin) { error_msgs << "Loop variable " << lhs_var_name << " cannot be used on left side of assignment statement." << std::endl; return false; } // enforce constancy of function args if (!lhs_origin.is_local() && lhs_origin.fun()) { error_msgs << "Cannot assign to function argument variables." << std::endl << "Use local variables instead." << std::endl; return false; } if (lhs_origin.program_block() != var_scope.program_block()) { error_msgs << "Cannot assign to variable outside of declaration block" << "; left-hand-side variable origin="; print_scope(error_msgs, lhs_origin); error_msgs << std::endl; return false; } return true; } bare_expr_type infer_var_dims_type(const bare_expr_type &var_type, const variable_dims &var_dims) { size_t num_index_dims = var_dims.dims_.size(); return infer_type_indexing(var_type, num_index_dims); } bool has_same_shape(const bare_expr_type &lhs_type, const expression &rhs_expr, const std::string &name, const std::string &stmt_type, std::ostream &error_msgs) { if (lhs_type.num_dims() != rhs_expr.bare_type().num_dims() || lhs_type.array_dims() != rhs_expr.bare_type().array_dims()) { error_msgs << "Dimension mismatch in " << stmt_type << "; variable name = " << name << ", type = " << lhs_type << "; right-hand side type = " << rhs_expr.bare_type() << "." << std::endl; return false; } // allow int -> double promotion, even in arrays bool types_compatible = (lhs_type.innermost_type() == rhs_expr.bare_type().innermost_type() || (lhs_type.innermost_type().is_double_type() && rhs_expr.bare_type().innermost_type().is_int_type())); if (!types_compatible) { error_msgs << "Base type mismatch in " << stmt_type << "; variable name = " << name << ", base type = " << lhs_type.innermost_type() << "; right-hand side base type = " << rhs_expr.bare_type().innermost_type() << "." << std::endl; return false; } return true; } // ////////////////////////////////// // *** functors for grammar rules *** // ////////////////////////////////// void validate_double_expr::operator()(const expression &expr, bool &pass, std::stringstream &error_msgs) const { if (!expr.bare_type().is_double_type() && !expr.bare_type().is_int_type()) { error_msgs << "Expression denoting real required; found type=" << expr.bare_type() << "." << std::endl; pass = false; return; } pass = true; } boost::phoenix::function validate_double_expr_f; template void assign_lhs::operator()(L &lhs, const R &rhs) const { lhs = rhs; } boost::phoenix::function assign_lhs_f; template void assign_lhs::operator()(expression &, const expression &) const; template void assign_lhs::operator()(expression &, const double_literal &) const; template void assign_lhs::operator()(expression &, const int_literal &) const; template void assign_lhs::operator()(expression &, const integrate_1d &) const; template void assign_lhs::operator()(expression &, const integrate_ode &) const; template void assign_lhs::operator()(expression &, const integrate_ode_control &) const; template void assign_lhs::operator()(expression &, const algebra_solver &) const; template void assign_lhs::operator()(expression &, const algebra_solver_control &) const; template void assign_lhs::operator()(expression &, const map_rect &) const; template void assign_lhs::operator()(array_expr &, const array_expr &) const; template void assign_lhs::operator()(matrix_expr &, const matrix_expr &) const; template void assign_lhs::operator()(row_vector_expr &, const row_vector_expr &) const; template void assign_lhs::operator()(int &, const int &) const; template void assign_lhs::operator()(size_t &, const size_t &) const; template void assign_lhs::operator()(statement &, const statement &) const; template void assign_lhs::operator()(std::vector &, const std::vector &) const; template void assign_lhs::operator()(std::vector &, const std::vector &) const; template void assign_lhs::operator()( std::vector> &, const std::vector> &) const; template void assign_lhs::operator()(fun &, const fun &) const; template void assign_lhs::operator()(variable &, const variable &) const; template void assign_lhs::operator()(std::vector &, const std::vector &) const; template void assign_lhs::operator()(std::vector &, const std::vector &) const; template void assign_lhs::operator()(bare_expr_type &, const bare_expr_type &) const; template void assign_lhs::operator()(block_var_decl &, const block_var_decl &) const; template void assign_lhs::operator()(local_var_decl &, const local_var_decl &) const; template void assign_lhs::operator()(var_decl &, const var_decl &) const; void validate_expr_type3::operator()(const expression &expr, bool &pass, std::ostream &error_msgs) const { pass = !expr.bare_type().is_ill_formed_type(); if (!pass) error_msgs << "Expression is ill formed." << std::endl; } boost::phoenix::function validate_expr_type3_f; void is_prob_fun::operator()(const std::string &s, bool &pass) const { pass = has_prob_suffix(s); } boost::phoenix::function is_prob_fun_f; void addition_expr3::operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const { if (expr1.bare_type().is_primitive() && expr2.bare_type().is_primitive()) { expr1 += expr2; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("add", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function addition3_f; void subtraction_expr3::operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const { if (expr1.bare_type().is_primitive() && expr2.bare_type().is_primitive()) { expr1 -= expr2; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("subtract", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function subtraction3_f; void increment_size_t::operator()(size_t &lhs) const { ++lhs; } boost::phoenix::function increment_size_t_f; void validate_conditional_op::operator()(conditional_op &conditional_op, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const { bare_expr_type cond_type = conditional_op.cond_.bare_type(); if (!cond_type.is_int_type()) { error_msgs << "Condition in ternary expression must be" << " primitive int;" << " found type=" << cond_type << "." << std::endl; pass = false; return; } bare_expr_type true_val_type = conditional_op.true_val_.bare_type(); bare_expr_type false_val_type = conditional_op.false_val_.bare_type(); bool types_compatible = (true_val_type == false_val_type) || (true_val_type.is_double_type() && false_val_type.is_int_type()) || (true_val_type.is_int_type() && false_val_type.is_double_type()); if (!types_compatible) { error_msgs << "Type mismatch in ternary expression," << " expression when true is: "; write_bare_expr_type(error_msgs, true_val_type); error_msgs << "; expression when false is: "; write_bare_expr_type(error_msgs, false_val_type); error_msgs << "." << std::endl; pass = false; return; } if (true_val_type.is_primitive()) conditional_op.type_ = (true_val_type == false_val_type) ? true_val_type : double_type(); else conditional_op.type_ = true_val_type; conditional_op.has_var_ = has_var(conditional_op, var_map); conditional_op.scope_ = var_scope; pass = true; } boost::phoenix::function validate_conditional_op_f; void binary_op_expr::operator()(expression &expr1, const expression &expr2, const std::string &op, const std::string &fun_name, std::ostream &error_msgs) const { if (!expr1.bare_type().is_primitive() || !expr2.bare_type().is_primitive()) { error_msgs << "Binary infix operator " << op << " with functional interpretation " << fun_name << " requires arguments of primitive type (int or real)" << ", found left type=" << expr1.bare_type() << ", right arg type=" << expr2.bare_type() << "." << std::endl; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f(fun_name, args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function binary_op_f; void validate_non_void_arg_function::operator()( bare_expr_type &arg_type, const scope &var_scope, bool &pass, std::ostream &error_msgs) const { if (var_scope.program_block() == data_origin) arg_type.set_is_data(); pass = !arg_type.is_void_type(); if (!pass) error_msgs << "Functions cannot contain void argument types; " << "found void argument." << std::endl; } boost::phoenix::function validate_non_void_arg_f; void set_void_function::operator()(const bare_expr_type &return_type, scope &var_scope, bool &pass, std::ostream &error_msgs) const { if (return_type.is_void_type() && return_type.num_dims() > 0) { error_msgs << "Void return type may not have dimensions declared." << std::endl; pass = false; return; } var_scope = return_type.is_void_type() ? scope(void_function_argument_origin) : scope(function_argument_origin); pass = true; } boost::phoenix::function set_void_function_f; void set_allows_sampling_origin::operator()(const std::string &identifier, scope &var_scope) const { if (ends_with("_lp", identifier)) { var_scope = var_scope.void_fun() ? scope(void_function_argument_origin_lp) : scope(function_argument_origin_lp); } else if (ends_with("_rng", identifier)) { var_scope = var_scope.void_fun() ? scope(void_function_argument_origin_rng) : scope(function_argument_origin_rng); } else { var_scope = var_scope.void_fun() ? scope(void_function_argument_origin) : scope(function_argument_origin); } } boost::phoenix::function set_allows_sampling_origin_f; void validate_declarations::operator()( bool &pass, std::set> &declared, std::set> &defined, std::ostream &error_msgs, bool allow_undefined) const { using std::pair; using std::set; using std::string; typedef set>::iterator iterator_t; if (!allow_undefined) { for (iterator_t it = declared.begin(); it != declared.end(); ++it) { if (defined.find(*it) == defined.end()) { error_msgs << "Function declared, but not defined." << " Function name=" << (*it).first << std::endl; pass = false; return; } } } pass = true; } boost::phoenix::function validate_declarations_f; bool fun_exists( const std::set> &existing, const std::pair &name_sig, bool name_only = true) { for (std::set>::const_iterator it = existing.begin(); it != existing.end(); ++it) { if (name_sig.first == (*it).first && (name_only || name_sig.second.second == (*it).second.second)) return true; // name and arg sequences match } return false; } void validate_prob_fun::operator()(std::string &fname, bool &pass, std::ostream &error_msgs) const { if (has_prob_fun_suffix(fname)) { std::string dist_name = strip_prob_fun_suffix(fname); if (!fun_name_exists(fname) // catch redefines later avoid fwd && (fun_name_exists(dist_name + "_lpdf") || fun_name_exists(dist_name + "_lpmf") || fun_name_exists(dist_name + "_log"))) { error_msgs << "Parse Error. Probability function already defined" << " for " << dist_name << std::endl; pass = false; return; } } if (has_cdf_suffix(fname)) { std::string dist_name = strip_cdf_suffix(fname); if (fun_name_exists(dist_name + "_cdf_log") || fun_name_exists(dist_name + "_lcdf")) { error_msgs << " Parse Error. CDF already defined for " << dist_name << std::endl; pass = false; return; } } if (has_ccdf_suffix(fname)) { std::string dist_name = strip_ccdf_suffix(fname); if (fun_name_exists(dist_name + "_ccdf_log") || fun_name_exists(dist_name + "_lccdf")) { error_msgs << " Parse Error. CCDF already defined for " << dist_name << std::endl; pass = false; return; } } } boost::phoenix::function validate_prob_fun_f; void add_function_signature::operator()( const function_decl_def &decl, bool &pass, std::set> &functions_declared, std::set> &functions_defined, std::ostream &error_msgs) const { std::vector arg_types; for (size_t i = 0; i < decl.arg_decls_.size(); ++i) { arg_types.push_back(decl.arg_decls_[i].bare_type()); } function_signature_t sig(decl.return_type_, arg_types); std::pair name_sig(decl.name_, sig); // check that not already declared if just declaration if (decl.body_.is_no_op_statement() && fun_exists(functions_declared, name_sig)) { error_msgs << "Parse Error. Function already declared, name=" << decl.name_; pass = false; return; } // check not already user defined if (fun_exists(functions_defined, name_sig)) { error_msgs << "Parse Error. Function already defined, name=" << decl.name_; pass = false; return; } // check not already system defined if (!fun_exists(functions_declared, name_sig) && function_signatures::instance().is_defined(decl.name_, sig)) { error_msgs << "Parse Error. Function system defined, name=" << decl.name_; pass = false; return; } // check argument type and qualifiers if (!decl.body_.is_no_op_statement()) { function_signature_t decl_sig = function_signatures::instance().get_definition(decl.name_, sig); if (!decl_sig.first.is_ill_formed_type()) { for (size_t i = 0; i < decl.arg_decls_.size(); ++i) { if (decl_sig.second[i] != arg_types[i] || decl_sig.second[i].is_data() != arg_types[i].is_data()) { error_msgs << "Declaration doesn't match definition " << "for function: " << decl.name_ << " argument " << (i + 1) << ": argument declared as " << arg_types[i] << ", defined as " << decl_sig.second[i] << "." << std::endl; pass = false; return; } } } } if (ends_with("_lpdf", decl.name_) && arg_types[0].innermost_type().is_int_type()) { error_msgs << "Parse Error. Probability density functions require" << " real variates (first argument)." << " Found type = " << arg_types[0] << std::endl; pass = false; return; } if (ends_with("_lpmf", decl.name_) && !arg_types[0].innermost_type().is_int_type()) { error_msgs << "Parse Error. Probability mass functions require" << " integer variates (first argument)." << " Found type = " << arg_types[0] << std::endl; pass = false; return; } // add declaration in local sets and in parser function sigs if (functions_declared.find(name_sig) == functions_declared.end()) { functions_declared.insert(name_sig); function_signatures::instance().add(decl.name_, decl.return_type_, arg_types); function_signatures::instance().set_user_defined(name_sig); } // add as definition if there's a body if (!decl.body_.is_no_op_statement()) functions_defined.insert(name_sig); pass = true; } boost::phoenix::function add_function_signature_f; void validate_pmf_pdf_variate::operator()(function_decl_def &decl, bool &pass, std::ostream &error_msgs) const { if (!has_prob_fun_suffix(decl.name_)) return; if (decl.arg_decls_.size() == 0) { error_msgs << "Parse Error. Probability functions require" << " at least one argument." << std::endl; pass = false; return; } bare_expr_type variate_type = decl.arg_decls_[0].bare_type().innermost_type(); if (ends_with("_lpdf", decl.name_) && variate_type.is_int_type()) { error_msgs << "Parse Error. Probability density functions require" << " real variates (first argument)." << " Found type = " << variate_type << std::endl; pass = false; return; } if (ends_with("_lpmf", decl.name_) && !variate_type.is_int_type()) { error_msgs << "Parse Error. Probability mass functions require" << " integer variates (first argument)." << " Found type = " << variate_type << std::endl; pass = false; return; } } boost::phoenix::function validate_pmf_pdf_variate_f; void validate_return_type::operator()(function_decl_def &decl, bool &pass, std::ostream &error_msgs) const { pass = decl.body_.is_no_op_statement() || stan::lang::returns_type(decl.return_type_, decl.body_, error_msgs); if (!pass) { error_msgs << "Improper return in body of function." << std::endl; return; } if ((ends_with("_log", decl.name_) || ends_with("_lpdf", decl.name_) || ends_with("_lpmf", decl.name_) || ends_with("_lcdf", decl.name_) || ends_with("_lccdf", decl.name_)) && !decl.return_type_.is_double_type()) { pass = false; error_msgs << "Real return type required for probability functions" << " ending in _log, _lpdf, _lpmf, _lcdf, or _lccdf." << std::endl; } } boost::phoenix::function validate_return_type_f; void set_fun_params_scope::operator()(scope &var_scope, variable_map &vm) const { var_scope = scope(var_scope.program_block(), true); // generated log_prob code has vector called "params_r__" // hidden way to get unconstrained params from model vm.add("params_r__", var_decl("params_r__", vector_type()), parameter_origin); } boost::phoenix::function set_fun_params_scope_f; void unscope_variables::operator()(function_decl_def &decl, variable_map &vm) const { vm.remove("params_r__"); for (size_t i = 0; i < decl.arg_decls_.size(); ++i) vm.remove(decl.arg_decls_[i].name()); } boost::phoenix::function unscope_variables_f; void add_fun_arg_var::operator()(const var_decl &decl, const scope &scope, bool &pass, variable_map &vm, std::ostream &error_msgs) const { if (vm.exists(decl.name())) { pass = false; error_msgs << "Duplicate declaration of variable, name=" << decl.name() << "; attempt to redeclare as function argument" << "; original declaration as "; print_scope(error_msgs, vm.get_scope(decl.name())); error_msgs << " variable." << std::endl; return; } pass = true; stan::lang::scope arg_scope(scope.program_block() == data_origin ? data_origin : function_argument_origin); vm.add(decl.name(), decl, arg_scope); } boost::phoenix::function add_fun_arg_var_f; // TODO(carpenter): seems redundant; see if it can be removed void set_omni_idx::operator()(omni_idx &val) const { val = omni_idx(); } boost::phoenix::function set_omni_idx_f; void validate_int_expr_silent::operator()(const expression &e, bool &pass) const { pass = e.bare_type().is_int_type(); } boost::phoenix::function validate_int_expr_silent_f; void validate_ints_expression::operator()(const expression &e, bool &pass, std::ostream &error_msgs) const { if (!e.bare_type().innermost_type().is_int_type()) { error_msgs << "Container index must be integer; found type=" << e.bare_type() << std::endl; pass = false; return; } if (e.bare_type().num_dims() > 1) { // tests > 1 so that message is coherent because the single // integer array tests don't print error_msgs << "Index must be integer or 1D integer array;" << " found number of dimensions=" << e.bare_type().num_dims() << std::endl; pass = false; return; } if (e.bare_type().num_dims() == 0) { // not an array expression, fail and backtrack pass = false; return; } pass = true; } boost::phoenix::function validate_ints_expression_f; void add_params_var::operator()(variable_map &vm) const { vm.add("params_r__", var_decl("params_r__", vector_type()), parameter_origin); // acts like a parameter } boost::phoenix::function add_params_var_f; void remove_params_var::operator()(variable_map &vm) const { vm.remove("params_r__"); } boost::phoenix::function remove_params_var_f; void dump_program_line(size_t idx_errline, int offset, const std::string &origin_file, size_t origin_line, const io::program_reader &reader, const std::vector &program_lines, std::stringstream &error_msgs) { boost::format fmt_lineno("%6d: "); if (idx_errline + offset > 0 && idx_errline + offset < program_lines.size()) { io::program_reader::trace_t trace = reader.trace(idx_errline + offset); if (trace[trace.size() - 1].first == origin_file) { std::string lineno = str(fmt_lineno % (origin_line + offset)); error_msgs << lineno << program_lines[idx_errline + offset - 1] << std::endl; } } } void program_error::operator()(pos_iterator_t begin, pos_iterator_t end, pos_iterator_t where, variable_map &vm, std::stringstream &error_msgs, const io::program_reader &reader) const { // extract line and column of error size_t idx_errline = boost::spirit::get_line(where); if (idx_errline == 0) { error_msgs << "Error before start of program." << std::endl; return; } size_t idx_errcol = 0; idx_errcol = get_column(begin, where) - 1; // extract lines of included program std::basic_stringstream program_ss; program_ss << boost::make_iterator_range(begin, end); std::vector program_lines; while (!program_ss.eof()) { std::string line; std::getline(program_ss, line); program_lines.push_back(line); } // dump include trace for error line io::program_reader::trace_t trace = reader.trace(idx_errline); std::string origin_file = trace[trace.size() - 1].first; size_t origin_line = trace[trace.size() - 1].second; error_msgs << " error in '" << trace[trace.size() - 1].first << "' at line " << trace[trace.size() - 1].second << ", column " << idx_errcol << std::endl; for (int i = trace.size() - 1; i-- > 0;) error_msgs << " included from '" << trace[i].first << "' at line " << trace[i].second << std::endl; // dump context of error error_msgs << " -------------------------------------------------" << std::endl; dump_program_line(idx_errline, -2, origin_file, origin_line, reader, program_lines, error_msgs); dump_program_line(idx_errline, -1, origin_file, origin_line, reader, program_lines, error_msgs); dump_program_line(idx_errline, 0, origin_file, origin_line, reader, program_lines, error_msgs); error_msgs << std::setw(idx_errcol + 8) << "^" << std::endl; dump_program_line(idx_errline, +1, origin_file, origin_line, reader, program_lines, error_msgs); error_msgs << " -------------------------------------------------" << std::endl << std::endl; } boost::phoenix::function program_error_f; void add_conditional_condition::operator()( conditional_statement &cs, const expression &e, bool &pass, std::stringstream &error_msgs) const { if (!e.bare_type().is_primitive()) { error_msgs << "Conditions in if-else statement must be" << " primitive int or real;" << " found type=" << e.bare_type() << std::endl; pass = false; return; } cs.conditions_.push_back(e); pass = true; return; } boost::phoenix::function add_conditional_condition_f; void add_conditional_body::operator()(conditional_statement &cs, const statement &s) const { cs.bodies_.push_back(s); } boost::phoenix::function add_conditional_body_f; void deprecate_old_assignment_op::operator()(std::string &op, std::ostream &error_msgs) const { error_msgs << "Info: assignment operator <- deprecated" << " in the Stan language;" << " use = instead." << std::endl; std::string eq("="); op = eq; } boost::phoenix::function deprecate_old_assignment_op_f; void non_void_return_msg::operator()(scope var_scope, bool &pass, std::ostream &error_msgs) const { pass = false; if (var_scope.non_void_fun()) { error_msgs << "Non-void function must return expression" << " of specified return type." << std::endl; return; } error_msgs << "Return statement only allowed from function bodies." << std::endl; } boost::phoenix::function non_void_return_msg_f; void validate_return_allowed::operator()(scope var_scope, bool &pass, std::ostream &error_msgs) const { if (var_scope.void_fun()) { error_msgs << "Void function cannot return a value." << std::endl; pass = false; return; } if (!var_scope.non_void_fun()) { error_msgs << "Returns only allowed from function bodies." << std::endl; pass = false; return; } pass = true; } boost::phoenix::function validate_return_allowed_f; void validate_void_return_allowed::operator()(scope var_scope, bool &pass, std::ostream &error_msgs) const { if (!var_scope.void_fun()) { error_msgs << "Void returns only allowed from function" << " bodies of void return type." << std::endl; pass = false; return; } pass = true; } boost::phoenix::function validate_void_return_allowed_f; void validate_lhs_var_assgn::operator()(assgn &a, const scope &var_scope, bool &pass, const variable_map &vm, std::ostream &error_msgs) const { std::string name(a.lhs_var_.name_); if (!can_assign_to_lhs_var(name, var_scope, vm, error_msgs)) { pass = false; return; } a.lhs_var_.set_type(vm.get_bare_type(name)); } boost::phoenix::function validate_lhs_var_assgn_f; void set_lhs_var_assgn::operator()(assgn &a, const std::string &name, bool &pass, const variable_map &vm) const { if (!vm.exists(name)) { pass = false; return; } a.lhs_var_ = variable(name); a.lhs_var_.set_type(vm.get_bare_type(name)); pass = true; } boost::phoenix::function set_lhs_var_assgn_f; void validate_assgn::operator()(assgn &a, bool &pass, const variable_map &vm, std::ostream &error_msgs) const { // validate lhs name + idxs std::string name = a.lhs_var_.name_; expression lhs_expr = expression(a.lhs_var_); bare_expr_type lhs_type = indexed_type(lhs_expr, a.idxs_); if (lhs_type.is_ill_formed_type()) { error_msgs << "Left-hand side indexing incompatible with variable." << std::endl; pass = false; return; } if (a.is_simple_assignment()) { if (!has_same_shape(lhs_type, a.rhs_, name, "assignment", error_msgs)) { pass = false; return; } pass = true; return; } else { // compound operator-assignment std::string op_equals = a.op_; a.op_ = op_equals.substr(0, op_equals.size() - 1); if (lhs_type.array_dims() > 0) { error_msgs << "Cannot apply operator '" << op_equals << "' to array variable; variable name = " << name << "."; error_msgs << std::endl; pass = false; return; } bare_expr_type rhs_type = a.rhs_.bare_type(); if (lhs_type.is_primitive() && boost::algorithm::starts_with(a.op_, ".")) { error_msgs << "Cannot apply element-wise operation to scalar" << "; compound operator is: " << op_equals << std::endl; pass = false; return; } if (lhs_type.is_primitive() && rhs_type.is_primitive() && (lhs_type.innermost_type().is_double_type() || lhs_type == rhs_type)) { pass = true; return; } std::string op_name; if (a.op_ == "+") { op_name = "add"; } else if (a.op_ == "-") { op_name = "subtract"; } else if (a.op_ == "*") { op_name = "multiply"; } else if (a.op_ == "/") { op_name = "divide"; } else if (a.op_ == "./") { op_name = "elt_divide"; } else if (a.op_ == ".*") { op_name = "elt_multiply"; } // check that "lhs rhs" is valid stan::math function sig std::vector arg_types; arg_types.push_back(bare_expr_type(lhs_type)); arg_types.push_back(bare_expr_type(rhs_type)); function_signature_t op_equals_sig(lhs_type, arg_types); if (!function_signatures::instance().is_defined(op_name, op_equals_sig)) { error_msgs << "Cannot apply operator '" << op_equals << "' to operands;" << " left-hand side type = " << lhs_type << "; right-hand side type=" << rhs_type << std::endl; pass = false; return; } a.op_name_ = op_name; pass = true; } } boost::phoenix::function validate_assgn_f; void validate_sample::operator()(sample &s, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { std::vector arg_types; arg_types.push_back(s.expr_.bare_type()); for (size_t i = 0; i < s.dist_.args_.size(); ++i) { arg_types.push_back(s.dist_.args_[i].bare_type()); } std::string function_name(s.dist_.family_); std::string internal_function_name = get_prob_fun(function_name); s.is_discrete_ = function_signatures::instance().discrete_first_arg( internal_function_name); if (internal_function_name.size() == 0) { pass = false; error_msgs << "Unknown distribution name: " << function_name << std::endl; return; } if (!(ends_with("_lpdf", internal_function_name) || ends_with("_lpmf", internal_function_name) || ends_with("_log", internal_function_name))) { pass = false; error_msgs << "Probability function must end in _lpdf or _lpmf." << " Found distribution family = " << function_name << " with no corresponding probability function" << " " << function_name << "_lpdf" << ", " << function_name << "_lpmf" << ", or " << function_name << "_log" << std::endl; return; } if ((internal_function_name.find("multiply_log") != std::string::npos) || (internal_function_name.find("binomial_coefficient_log") != std::string::npos)) { error_msgs << "Only distribution names can be used with" << " sampling (~) notation; found non-distribution" << " function: " << function_name << std::endl; pass = false; return; } if (internal_function_name.find("cdf_log") != std::string::npos) { error_msgs << "CDF and CCDF functions may not be used with" << " sampling notation." << " Use increment_log_prob(" << internal_function_name << "(...)) instead." << std::endl; pass = false; return; } if (internal_function_name == "lkj_cov_log") { error_msgs << "Info: the lkj_cov_log() sampling distribution" << " is deprecated. It will be removed in Stan 3." << std::endl << "Code LKJ covariance in terms of an lkj_corr()" << " distribution on a correlation matrix" << " and independent lognormals on the scales." << std::endl << std::endl; } if (!is_double_return(internal_function_name, arg_types, error_msgs)) { error_msgs << "Real return type required for probability function." << std::endl; pass = false; return; } // test for LHS not being purely a variable if (has_non_param_var(s.expr_, var_map)) { error_msgs << "Info:" << std::endl << "Left-hand side of sampling statement (~) may contain a" << " non-linear transform of a parameter or local variable." << std::endl << "If it does, you need to include a target += statement" << " with the log absolute determinant of the Jacobian of" << " the transform." << std::endl << "Left-hand-side of sampling statement:" << std::endl << " " << s.expr_.to_string() << " ~ " << function_name << "(...)" << std::endl; } // validate that variable and params are univariate if truncated if (s.truncation_.has_low() || s.truncation_.has_high()) { if (!is_univariate(s.expr_.bare_type())) { error_msgs << "Outcomes in truncated distributions" << " must be univariate." << std::endl << " Found outcome expression: " << s.expr_.to_string() << std::endl << " with non-univariate type: " << s.expr_.bare_type() << std::endl; pass = false; return; } for (size_t i = 0; i < s.dist_.args_.size(); ++i) if (!is_univariate(s.dist_.args_[i].bare_type())) { error_msgs << "Parameters in truncated distributions" << " must be univariate." << std::endl << " Found parameter expression: " << s.dist_.args_[i].to_string() << std::endl << " with non-univariate type: " << s.dist_.args_[i].bare_type() << std::endl; pass = false; return; } } if (s.truncation_.has_low() && !is_univariate(s.truncation_.low_.bare_type())) { error_msgs << "Lower bounds in truncated distributions" << " must be univariate." << std::endl << " Found lower bound expression: " << s.truncation_.low_.to_string() << std::endl << " with non-univariate type: " << s.truncation_.low_.bare_type() << std::endl; pass = false; return; } if (s.truncation_.has_high() && !is_univariate(s.truncation_.high_.bare_type())) { error_msgs << "Upper bounds in truncated distributions" << " must be univariate." << std::endl << " Found upper bound expression: " << s.truncation_.high_.to_string() << std::endl << " with non-univariate type: " << s.truncation_.high_.bare_type() << std::endl; pass = false; return; } // make sure CDFs or CCDFs exist with conforming signature // T[L, ] if (s.truncation_.has_low() && !s.truncation_.has_high()) { std::vector arg_types_trunc(arg_types); arg_types_trunc[0] = s.truncation_.low_.bare_type(); std::string function_name_ccdf = get_ccdf(s.dist_.family_); if (function_name_ccdf == s.dist_.family_ || !is_double_return(function_name_ccdf, arg_types_trunc, error_msgs)) { error_msgs << "Lower truncation not defined for specified" << " arguments to " << s.dist_.family_ << std::endl; pass = false; return; } if (!is_double_return(function_name_ccdf, arg_types, error_msgs)) { error_msgs << "Lower bound in truncation type does not match" << " sampled variate in distribution's type" << std::endl; pass = false; return; } } // T[, H] if (!s.truncation_.has_low() && s.truncation_.has_high()) { std::vector arg_types_trunc(arg_types); arg_types_trunc[0] = s.truncation_.high_.bare_type(); std::string function_name_cdf = get_cdf(s.dist_.family_); if (function_name_cdf == s.dist_.family_ || !is_double_return(function_name_cdf, arg_types_trunc, error_msgs)) { error_msgs << "Upper truncation not defined for" << " specified arguments to " << s.dist_.family_ << std::endl; pass = false; return; } if (!is_double_return(function_name_cdf, arg_types, error_msgs)) { error_msgs << "Upper bound in truncation type does not match" << " sampled variate in distribution's type" << std::endl; pass = false; return; } } // T[L, H] if (s.truncation_.has_low() && s.truncation_.has_high()) { std::vector arg_types_trunc(arg_types); arg_types_trunc[0] = s.truncation_.low_.bare_type(); std::string function_name_cdf = get_cdf(s.dist_.family_); if (function_name_cdf == s.dist_.family_ || !is_double_return(function_name_cdf, arg_types_trunc, error_msgs)) { error_msgs << "Lower truncation not defined for specified" << " arguments to " << s.dist_.family_ << std::endl; pass = false; return; } if (!is_double_return(function_name_cdf, arg_types, error_msgs)) { error_msgs << "Lower bound in truncation type does not match" << " sampled variate in distribution's type" << std::endl; pass = false; return; } } pass = true; } boost::phoenix::function validate_sample_f; void expression_as_statement::operator()(bool &pass, const stan::lang::expression &expr, std::stringstream &error_msgs) const { if (!(expr.bare_type().is_void_type())) { error_msgs << "Illegal statement beginning with non-void" << " expression parsed as" << std::endl << " " << expr.to_string() << std::endl << "Not a legal assignment, sampling, or function" << " statement. Note that" << std::endl << " * Assignment statements only allow variables" << " (with optional indexes) on the left;" << std::endl << " * Sampling statements allow arbitrary" << " value-denoting expressions on the left." << std::endl << " * Functions used as statements must be" << " declared to have void returns" << std::endl << std::endl; pass = false; return; } pass = true; } boost::phoenix::function expression_as_statement_f; void unscope_locals::operator()(const std::vector &var_decls, variable_map &vm) const { for (size_t i = 0; i < var_decls.size(); ++i) vm.remove(var_decls[i].name()); } boost::phoenix::function unscope_locals_f; void add_while_condition::operator()(while_statement &ws, const expression &e, bool &pass, std::stringstream &error_msgs) const { pass = e.bare_type().is_primitive(); if (!pass) { error_msgs << "Conditions in while statement must be primitive" << " int or real;" << " found type=" << e.bare_type() << std::endl; return; } ws.condition_ = e; } boost::phoenix::function add_while_condition_f; void add_while_body::operator()(while_statement &ws, const statement &s) const { ws.body_ = s; } boost::phoenix::function add_while_body_f; void add_loop_identifier::operator()(const std::string &name, const scope &var_scope, variable_map &vm) const { vm.add(name, var_decl(name, int_type()), scope(loop_identifier_origin, true)); } boost::phoenix::function add_loop_identifier_f; void add_array_loop_identifier ::operator()(const stan::lang::expression &expr, std::string &name, const scope &var_scope, bool &pass, variable_map &vm) const { pass = expr.bare_type().is_array_type(); if (pass) vm.add(name, var_decl(name, expr.bare_type().array_element_type()), scope(loop_identifier_origin, true)); } boost::phoenix::function add_array_loop_identifier_f; void add_matrix_loop_identifier ::operator()( const stan::lang::expression &expr, std::string &name, const scope &var_scope, bool &pass, variable_map &vm, std::stringstream &error_msgs) const { pass = expr.bare_type().num_dims() > 0 && !(expr.bare_type().is_array_type()); if (!pass) { error_msgs << "Loop must be over container or range." << std::endl; return; } else { vm.add(name, var_decl(name, double_type()), scope(loop_identifier_origin, true)); pass = true; } } boost::phoenix::function add_matrix_loop_identifier_f; void store_loop_identifier::operator()(const std::string &name, std::string &name_local, bool &pass, variable_map &vm, std::stringstream &error_msgs) const { pass = !(vm.exists(name)); if (!pass) { // avoid repeated error message due to backtracking if (error_msgs.str().find("Loop variable already declared.") == std::string::npos) error_msgs << "Loop variable already declared." << " variable name=\"" << name << "\"" << std::endl; } else { name_local = name; } } boost::phoenix::function store_loop_identifier_f; void remove_loop_identifier::operator()(const std::string &name, variable_map &vm) const { vm.remove(name); } boost::phoenix::function remove_loop_identifier_f; void validate_int_expr::operator()(const expression &expr, bool &pass, std::stringstream &error_msgs) const { if (!expr.bare_type().is_int_type()) { error_msgs << "Expression denoting integer required; found type=" << expr.bare_type() << std::endl; pass = false; return; } pass = true; } boost::phoenix::function validate_int_expr_f; void deprecate_increment_log_prob::operator()( std::stringstream &error_msgs) const { error_msgs << "Info: increment_log_prob(...);" << " is deprecated and will be removed in the future." << std::endl << " Use target += ...; instead." << std::endl; } boost::phoenix::function deprecate_increment_log_prob_f; void validate_allow_sample::operator()(const scope &var_scope, bool &pass, std::stringstream &error_msgs) const { pass = var_scope.allows_sampling(); if (!pass) error_msgs << "Sampling statements (~) and increment_log_prob() are" << std::endl << "only allowed in the model block or lp functions." << std::endl; } boost::phoenix::function validate_allow_sample_f; void validate_non_void_expression::operator()(const expression &e, bool &pass, std::ostream &error_msgs) const { pass = !e.bare_type().is_void_type(); if (!pass) error_msgs << "Attempt to increment log prob with void expression" << std::endl; } boost::phoenix::function validate_non_void_expression_f; void add_literal_string::operator()(double_literal &lit, const pos_iterator_t &begin, const pos_iterator_t &end) const { lit.string_ = std::string(begin, end); } boost::phoenix::function add_literal_string_f; template void add_line_number::operator()(T &line, const I &begin, const I &end) const { line.begin_line_ = get_line(begin); line.end_line_ = get_line(end); } boost::phoenix::function add_line_number_f; template void add_line_number::operator()(block_var_decl &, const pos_iterator_t &begin, const pos_iterator_t &end) const; template void add_line_number::operator()(local_var_decl &, const pos_iterator_t &begin, const pos_iterator_t &end) const; template void add_line_number::operator()(statement &, const pos_iterator_t &begin, const pos_iterator_t &end) const; void set_void_return::operator()(return_statement &s) const { s = return_statement(); } boost::phoenix::function set_void_return_f; void set_no_op::operator()(no_op_statement &s) const { s = no_op_statement(); } boost::phoenix::function set_no_op_f; void deprecated_integrate_ode::operator()(std::ostream &error_msgs) const { error_msgs << "Info: the integrate_ode() function is deprecated" << " in the Stan language; use the following functions" << " instead.\n" << " integrate_ode_rk45()" << " [explicit, order 5, for non-stiff problems]\n" << " integrate_ode_adams()" << " [implicit, up to order 12, for non-stiff problems]\n" << " integrate_ode_bdf()" << " [implicit, up to order 5, for stiff problems]." << std::endl; } boost::phoenix::function deprecated_integrate_ode_f; template void validate_integrate_ode_non_control_args(const T &ode_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) { pass = true; // ode_integrator requires function with signature // (real, real[ ], real[ ], data real[ ], data int[ ]): real[ ]" // TODO(mitzi) names indicate status, but not flagged as data_only // instantiate ode fn arg types double_type t_double; bare_expr_type t_ar_double(bare_array_type(t_double, 1)); bare_expr_type t_ar_double_data(bare_array_type(t_double, 1)); int_type t_int_data; bare_expr_type t_ar_int_data(bare_array_type(t_int_data, 1)); // validate ode fn signature bare_expr_type sys_result_type(t_ar_double); std::vector sys_arg_types; sys_arg_types.push_back(t_double); sys_arg_types.push_back(t_ar_double); sys_arg_types.push_back(t_ar_double); sys_arg_types.push_back(t_ar_double_data); sys_arg_types.push_back(t_ar_int_data); function_signature_t system_signature(sys_result_type, sys_arg_types); if (!function_signatures::instance().is_defined(ode_fun.system_function_name_, system_signature)) { error_msgs << "Wrong signature for function " << ode_fun.integration_function_name_ << "; first argument must be " << "the name of a function with signature" << " (real, real[ ], real[ ], data real[ ], data int[ ]):" << " real[ ]." << std::endl; pass = false; } // Stan lang integrate_ode takes 7 args: // fn_name, y0, t0, ts, theta, x_r, x_i // only y0, t0, ts, and theta can have params if (ode_fun.y0_.bare_type() != t_ar_double) { error_msgs << "Second argument to " << ode_fun.integration_function_name_ << " must have type real[ ]" << "; found type = " << ode_fun.y0_.bare_type() << ". " << std::endl; pass = false; } if (!ode_fun.t0_.bare_type().is_primitive()) { error_msgs << "Third argument to " << ode_fun.integration_function_name_ << " must have type real" << "; found type = " << ode_fun.t0_.bare_type() << ". " << std::endl; pass = false; } if (ode_fun.ts_.bare_type() != t_ar_double) { error_msgs << "Fourth argument to " << ode_fun.integration_function_name_ << " must have type real[ ]" << "; found type = " << ode_fun.ts_.bare_type() << ". " << std::endl; pass = false; } if (ode_fun.theta_.bare_type() != t_ar_double) { error_msgs << "Fifth argument to " << ode_fun.integration_function_name_ << " must have type real[ ]" << "; found type = " << ode_fun.theta_.bare_type() << ". " << std::endl; pass = false; } if (ode_fun.x_.bare_type() != t_ar_double_data) { error_msgs << "Sixth argument to " << ode_fun.integration_function_name_ << " must have type data real[ ]" << "; found type = " << ode_fun.x_.bare_type() << ". " << std::endl; pass = false; } if (ode_fun.x_int_.bare_type() != t_ar_int_data) { error_msgs << "Seventh argument to " << ode_fun.integration_function_name_ << " must have type data int[ ]" << "; found type = " << ode_fun.x_int_.bare_type() << ". " << std::endl; pass = false; } // test data-only variables do not have parameters (int locals OK) if (has_var(ode_fun.x_, var_map)) { error_msgs << "Sixth argument to " << ode_fun.integration_function_name_ << " (real data)" << " must be data only and not reference parameters." << std::endl; pass = false; } } void validate_integrate_ode::operator()(const integrate_ode &ode_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { validate_integrate_ode_non_control_args(ode_fun, var_map, pass, error_msgs); } boost::phoenix::function validate_integrate_ode_f; void validate_integrate_ode_control::operator()( const integrate_ode_control &ode_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { validate_integrate_ode_non_control_args(ode_fun, var_map, pass, error_msgs); if (!ode_fun.rel_tol_.bare_type().is_primitive()) { error_msgs << "Eighth argument to " << ode_fun.integration_function_name_ << " (relative tolerance) must have type real or int;" << " found type=" << ode_fun.rel_tol_.bare_type() << ". "; pass = false; } if (!ode_fun.abs_tol_.bare_type().is_primitive()) { error_msgs << "Ninth argument to " << ode_fun.integration_function_name_ << " (absolute tolerance) must have type real or int;" << " found type=" << ode_fun.abs_tol_.bare_type() << ". "; pass = false; } if (!ode_fun.max_num_steps_.bare_type().is_primitive()) { error_msgs << "Tenth argument to " << ode_fun.integration_function_name_ << " (max steps) must have type real or int;" << " found type=" << ode_fun.max_num_steps_.bare_type() << ". "; pass = false; } // test data-only variables do not have parameters (int locals OK) if (has_var(ode_fun.rel_tol_, var_map)) { error_msgs << "Eighth argument to " << ode_fun.integration_function_name_ << " (relative tolerance) must be data only" << " and not depend on parameters."; pass = false; } if (has_var(ode_fun.abs_tol_, var_map)) { error_msgs << "Ninth argument to " << ode_fun.integration_function_name_ << " (absolute tolerance ) must be data only" << " and not depend parameters."; pass = false; } if (has_var(ode_fun.max_num_steps_, var_map)) { error_msgs << "Tenth argument to " << ode_fun.integration_function_name_ << " (max steps) must be data only" << " and not depend on parameters."; pass = false; } } boost::phoenix::function validate_integrate_ode_control_f; template void validate_algebra_solver_non_control_args(const T &alg_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) { pass = true; int_type t_int; double_type t_double; vector_type t_vector; bare_expr_type t_ar_int(bare_array_type(t_int, 1)); bare_expr_type t_ar_double(bare_array_type(t_double, 1)); bare_expr_type sys_result_type(t_vector); std::vector sys_arg_types; sys_arg_types.push_back(t_vector); // y sys_arg_types.push_back(t_vector); // theta sys_arg_types.push_back(t_ar_double); // x_r sys_arg_types.push_back(t_ar_int); // x_i function_signature_t system_signature(sys_result_type, sys_arg_types); if (!function_signatures::instance().is_defined(alg_fun.system_function_name_, system_signature)) { error_msgs << "Wrong signature for function " << alg_fun.system_function_name_ << "; first argument to algebra_solver" << " must be a function with signature" << " (vector, vector, real[ ], int[ ]) : vector." << std::endl; pass = false; } // check solver function arg types if (alg_fun.y_.bare_type() != t_vector) { error_msgs << "Second argument to algebra_solver must have type vector" << "; found type= " << alg_fun.y_.bare_type() << ". " << std::endl; pass = false; } if (alg_fun.theta_.bare_type() != t_vector) { error_msgs << "Third argument to algebra_solver must have type vector" << "; found type= " << alg_fun.theta_.bare_type() << ". " << std::endl; pass = false; } if (alg_fun.x_r_.bare_type() != t_ar_double) { error_msgs << "Fourth argument to algebra_solver must have type real[ ]" << "; found type= " << alg_fun.x_r_.bare_type() << ". " << std::endl; pass = false; } if (alg_fun.x_i_.bare_type() != t_ar_int) { error_msgs << "Fifth argument to algebra_solver must have type int[ ]" << "; found type= " << alg_fun.x_i_.bare_type() << ". " << std::endl; pass = false; } // real data array cannot be param or x-formed param variable if (has_var(alg_fun.x_r_, var_map)) { error_msgs << "Fourth argument to algebra_solver" << " must be data only (cannot reference parameters)." << std::endl; pass = false; } } void validate_algebra_solver::operator()(const algebra_solver &alg_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { validate_algebra_solver_non_control_args(alg_fun, var_map, pass, error_msgs); } boost::phoenix::function validate_algebra_solver_f; void validate_algebra_solver_control::operator()( const algebra_solver_control &alg_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { validate_algebra_solver_non_control_args(alg_fun, var_map, pass, error_msgs); if (!alg_fun.rel_tol_.bare_type().is_primitive()) { error_msgs << "Sixth argument to algebra_solver " << " (relative tolerance) must have type real or int;" << " found type=" << alg_fun.rel_tol_.bare_type() << ". " << std::endl; pass = false; } if (!alg_fun.fun_tol_.bare_type().is_primitive()) { error_msgs << "Seventh argument to algebra_solver " << " (function tolerance) must have type real or int;" << " found type=" << alg_fun.fun_tol_.bare_type() << ". " << std::endl; pass = false; } if (!alg_fun.max_num_steps_.bare_type().is_primitive()) { error_msgs << "Eighth argument to algebra_solver" << " (max number of steps) must have type real or int;" << " found type=" << alg_fun.max_num_steps_.bare_type() << ". " << std::endl; pass = false; } // control args cannot contain param variables if (has_var(alg_fun.rel_tol_, var_map)) { error_msgs << "Sixth argument to algebra_solver" << " (relative tolerance) must be data only" << " and not depend on parameters" << std::endl; pass = false; } if (has_var(alg_fun.fun_tol_, var_map)) { error_msgs << "Seventh argument to algebra_solver" << " (function tolerance ) must be data only" << " and not depend parameters" << std::endl; pass = false; } if (has_var(alg_fun.max_num_steps_, var_map)) { error_msgs << "Eighth argument to algebra_solver" << " (max number of steps) must be data only" << " and not depend on parameters" << std::endl; pass = false; } } boost::phoenix::function validate_algebra_solver_control_f; void validate_integrate_1d::operator()(integrate_1d &fx, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { pass = true; // (1) name of function to integrate if (ends_with("_rng", fx.function_name_)) { error_msgs << "integrated function may not be an _rng function," << " found function name: " << fx.function_name_ << std::endl; pass = false; } double_type t_double; bare_expr_type sys_result_type(t_double); std::vector sys_arg_types; sys_arg_types.push_back(bare_expr_type(t_double)); sys_arg_types.push_back(bare_expr_type(t_double)); sys_arg_types.push_back(bare_expr_type(bare_array_type(double_type(), 1))); sys_arg_types.push_back(bare_expr_type(bare_array_type(double_type(), 1))); sys_arg_types.push_back(bare_expr_type(bare_array_type(int_type(), 1))); function_signature_t system_signature(sys_result_type, sys_arg_types); if (!function_signatures::instance().is_defined(fx.function_name_, system_signature)) { pass = false; error_msgs << "first argument to integrate_1d" << " must be the name of a function with signature" << " (real, real, real[], real[], int[]) : real " << std::endl; } // (2) lower bound of integration if (!fx.lb_.bare_type().is_primitive()) { pass = false; error_msgs << "second argument to integrate_1d, the lower bound of" << " integration, must have type int or real;" << " found type = " << fx.lb_.bare_type() << "." << std::endl; } // (3) lower bound of integration if (!fx.ub_.bare_type().is_primitive()) { pass = false; error_msgs << "third argument to integrate_1d, the upper bound of" << " integration, must have type int or real;" << " found type = " << fx.ub_.bare_type() << "." << std::endl; } // (4) parameters if (fx.theta_.bare_type() != bare_array_type(double_type(), 1)) { pass = false; error_msgs << "fourth argument to integrate_1d, the parameters," << " must have type real[];" << " found type = " << fx.theta_.bare_type() << "." << std::endl; } // (5) real data if (fx.x_r_.bare_type() != bare_array_type(double_type(), 1)) { pass = false; error_msgs << "fifth argument to integrate_1d, the real data," << " must have type real[]; found type = " << fx.x_r_.bare_type() << "." << std::endl; } // (6) int data if (fx.x_i_.bare_type() != bare_array_type(int_type(), 1)) { pass = false; error_msgs << "sixth argument to integrate_1d, the integer data," << " must have type int[]; found type = " << fx.x_i_.bare_type() << "." << std::endl; } // (7) relative tolerance if (!fx.rel_tol_.bare_type().is_primitive()) { pass = false; error_msgs << "seventh argument to integrate_1d, relative tolerance," << " must be of type int or real; found type = " << fx.rel_tol_.bare_type() << "." << std::endl; } // test data-only variables do not have parameters (int locals OK) if (has_var(fx.x_r_, var_map)) { pass = false; error_msgs << "fifth argument to integrate_1d, the real data," << " must be data only and not reference parameters." << std::endl; } if (has_var(fx.rel_tol_, var_map)) { pass = false; error_msgs << "seventh argument to integrate_1d, relative tolerance," << " must be data only and not reference parameters." << std::endl; } } boost::phoenix::function validate_integrate_1d_f; void validate_map_rect::operator()(map_rect &mr, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const { pass = true; if (has_rng_lp_suffix(mr.fun_name_)) { error_msgs << "Mapped function cannot be an _rng or _lp function," << " found function name: " << mr.fun_name_ << std::endl; pass = false; } // mapped function signature // vector f(vector param_shared, vector param_local, // real[] data_r, int[] data_i) int_type t_int; double_type t_double; vector_type t_vector; bare_expr_type t_ar_int(bare_array_type(t_int, 1)); bare_expr_type t_2d_ar_int(bare_array_type(t_int, 2)); bare_expr_type t_ar_double(bare_array_type(t_double, 1)); bare_expr_type t_2d_ar_double(bare_array_type(t_double, 2)); bare_expr_type t_ar_vector(bare_array_type(t_vector, 1)); bare_expr_type shared_params_type(t_vector); bare_expr_type job_params_type(t_vector); bare_expr_type job_data_r_type(t_ar_double); bare_expr_type job_data_i_type(t_ar_int); bare_expr_type result_type(t_vector); std::vector arg_types; arg_types.push_back(shared_params_type); arg_types.push_back(job_params_type); arg_types.push_back(job_data_r_type); arg_types.push_back(job_data_i_type); function_signature_t mapped_fun_signature(result_type, arg_types); // validate mapped function signature if (!function_signatures::instance().is_defined(mr.fun_name_, mapped_fun_signature)) { error_msgs << "First argument to map_rect" << " must be the name of a function with signature" << " (vector, vector, real[ ], int[ ]) : vector." << std::endl; pass = false; } // shared parameters - vector if (mr.shared_params_.bare_type() != shared_params_type) { if (!pass) error_msgs << "; "; error_msgs << "Second argument to map_rect must be of type vector." << std::endl; pass = false; } // job-specific parameters - array of vectors (array elts map to arg2) if (mr.job_params_.bare_type() != t_ar_vector) { if (!pass) error_msgs << "; "; error_msgs << "Third argument to map_rect must be of type vector[ ]" << " (array of vectors)." << std::endl; pass = false; } // job-specific real data - 2-d array of double (array elts map to arg3) bare_expr_type job_data_rs_type(t_2d_ar_double); if (mr.job_data_r_.bare_type() != job_data_rs_type) { if (!pass) error_msgs << "; "; error_msgs << "Fourth argument to map_rect must be of type real[ , ]" << " (two dimensional array of reals)." << std::endl; pass = false; } // job-specific int data - 2-d array of int (array elts map to arg4) bare_expr_type job_data_is_type(t_2d_ar_int); if (mr.job_data_i_.bare_type() != job_data_is_type) { if (!pass) error_msgs << "; "; error_msgs << "Fifth argument to map_rect must be of type int[ , ]" << " (two dimensional array of integers)." << std::endl; pass = false; } // test data is data only if (has_var(mr.job_data_r_, var_map)) { if (!pass) error_msgs << "; "; error_msgs << "Fourth argment to map_rect must be data only." << std::endl; pass = false; } if (has_var(mr.job_data_i_, var_map)) { if (!pass) error_msgs << "; "; error_msgs << "Fifth argument to map_rect must be data only." << std::endl; pass = false; } if (pass) mr.register_id(); } boost::phoenix::function validate_map_rect_f; void set_fun_type_named::operator()(expression &fun_result, fun &fun, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const { if (fun.name_ == "get_lp") error_msgs << "Info: get_lp() function deprecated." << std::endl << " It will be removed in a future release." << std::endl << " Use target() instead." << std::endl; if (fun.name_ == "target") fun.name_ = "get_lp"; // for code gen and context validation std::vector arg_types; for (size_t i = 0; i < fun.args_.size(); ++i) arg_types.push_back(fun.args_[i].bare_type()); fun.type_ = function_signatures::instance().get_result_type( fun.name_, arg_types, error_msgs); if (fun.type_.is_ill_formed_type()) { pass = false; return; } // get function definition for this functiion std::vector fun_arg_types; for (size_t i = 0; i < fun.args_.size(); ++i) fun_arg_types.push_back(arg_types[i]); function_signature_t sig(fun.type_, fun_arg_types); function_signature_t decl_sig = function_signatures::instance().get_definition(fun.name_, sig); if (!decl_sig.first.is_ill_formed_type()) { for (size_t i = 0; i < fun_arg_types.size(); ++i) { if (decl_sig.second[i].is_data() && has_var(fun.args_[i], var_map)) { error_msgs << "Function argument error, function: " << fun.name_ << ", argument: " << (i + 1) << " must be data only, " << "found expression containing a parameter varaible." << std::endl; pass = false; return; } } } // disjunction so only first match triggered deprecate_fun("binomial_coefficient_log", "lchoose", fun, error_msgs) || deprecate_fun("multiply_log", "lmultiply", fun, error_msgs) || deprecate_suffix("_cdf_log", "'_lcdf'", fun, error_msgs) || deprecate_suffix("_ccdf_log", "'_lccdf'", fun, error_msgs) || deprecate_suffix( "_log", "'_lpdf' for density functions or '_lpmf' for mass functions", fun, error_msgs); // use old function names for built-in prob funs if (!function_signatures::instance().has_user_defined_key(fun.name_)) { replace_suffix("_lpdf", "_log", fun); replace_suffix("_lpmf", "_log", fun); replace_suffix("_lcdf", "_cdf_log", fun); replace_suffix("_lccdf", "_ccdf_log", fun); } // know these are not user-defined`x replace_suffix("lmultiply", "multiply_log", fun); replace_suffix("lchoose", "binomial_coefficient_log", fun); if (has_rng_suffix(fun.name_)) { if (!(var_scope.allows_rng())) { error_msgs << "Random number generators only allowed in" << " transformed data block, generated quantities block" << " or user-defined functions with names ending in _rng" << "; found function=" << fun.name_ << " in block="; print_scope(error_msgs, var_scope); error_msgs << std::endl; pass = false; return; } } if (has_lp_suffix(fun.name_) || fun.name_ == "target") { if (!(var_scope.allows_lp_fun())) { error_msgs << "Function target() or functions suffixed with _lp only" << " allowed in transformed parameter block, model block" << std::endl << "or the body of a function with suffix _lp." << std::endl << "Found function = " << (fun.name_ == "get_lp" ? "target or get_lp" : fun.name_) << " in block = "; print_scope(error_msgs, var_scope); error_msgs << std::endl; pass = false; return; } } if (fun.name_ == "abs" && fun.args_.size() > 0 && fun.args_[0].bare_type().is_double_type()) { error_msgs << "Info: Function abs(real) is deprecated" << " in the Stan language." << std::endl << " It will be removed in a future release." << std::endl << " Use fabs(real) instead." << std::endl << std::endl; } if (fun.name_ == "lkj_cov_log") { error_msgs << "Info: the lkj_cov_log() function" << " is deprecated. It will be removed in Stan 3." << std::endl << "Code LKJ covariance in terms of an lkj_corr()" << " distribution on a correlation matrix" << " and independent lognormals on the scales." << std::endl << std::endl; } if (fun.name_ == "if_else") { error_msgs << "Info: the if_else() function" << " is deprecated. " << "Use the conditional operator '?:' instead." << std::endl; } // add namespace qualifier to avoid ambiguities w/ c math fns qualify_builtins(fun); fun_result = fun; pass = true; } boost::phoenix::function set_fun_type_named_f; void infer_array_expr_type::operator()(expression &e, array_expr &array_expr, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const { if (array_expr.args_.size() == 0) { // shouldn't occur, because of % operator used to construct it error_msgs << "Array expression found size 0, must be > 0"; array_expr.type_ = ill_formed_type(); pass = false; return; } bare_expr_type e_first(array_expr.args_[0].bare_type()); for (size_t i = 1; i < array_expr.args_.size(); ++i) { bare_expr_type e_next(array_expr.args_[i].bare_type()); if (e_first != e_next) { if (e_first.is_primitive() && e_next.is_primitive()) { e_first = double_type(); } else { error_msgs << "Expressions for elements of array must have" << " the same or promotable types; found" << " first element type=" << e_first << "; type at position " << i + 1 << "=" << e_next; array_expr.type_ = ill_formed_type(); pass = false; return; } } } array_expr.type_ = bare_array_type(e_first); array_expr.array_expr_scope_ = var_scope; array_expr.has_var_ = has_var(array_expr, var_map); e = array_expr; pass = true; } boost::phoenix::function infer_array_expr_type_f; void infer_vec_or_matrix_expr_type::operator()( expression &e, row_vector_expr &vec_expr, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const { if (vec_expr.args_.size() == 0) { // shouldn't occur, because of % operator used to construct it error_msgs << "Vector or matrix expression found size 0, must be > 0"; pass = false; return; } bare_expr_type e_first = vec_expr.args_[0].bare_type(); if (!(e_first.is_primitive() || e_first.is_row_vector_type())) { error_msgs << "Matrix expression elements must be type row_vector " << "and row vector expression elements must be int " << "or real, but found element of type " << e_first << std::endl; pass = false; return; } bool is_matrix_el = e_first.is_row_vector_type(); for (size_t i = 1; i < vec_expr.args_.size(); ++i) { if (is_matrix_el && !vec_expr.args_[i].bare_type().is_row_vector_type()) { error_msgs << "Matrix expression elements must be type row_vector, " << "but found element of type " << vec_expr.args_[i].bare_type() << std::endl; pass = false; return; } else if (!is_matrix_el && !(vec_expr.args_[i].bare_type().is_primitive())) { error_msgs << "Row vector expression elements must be int or real, " << "but found element of type " << vec_expr.args_[i].bare_type() << std::endl; pass = false; return; } } if (is_matrix_el) { // create matrix expr object matrix_expr me = matrix_expr(vec_expr.args_); me.matrix_expr_scope_ = var_scope; me.has_var_ = has_var(me, var_map); e = me; } else { vec_expr.row_vector_expr_scope_ = var_scope; vec_expr.has_var_ = has_var(vec_expr, var_map); e = vec_expr; } pass = true; } boost::phoenix::function infer_vec_or_matrix_expr_type_f; void exponentiation_expr::operator()(expression &expr1, const expression &expr2, const scope &var_scope, bool &pass, std::ostream &error_msgs) const { if (!expr1.bare_type().is_primitive() || !expr2.bare_type().is_primitive()) { error_msgs << "Arguments to ^ must be primitive (real or int)" << "; cannot exponentiate " << expr1.bare_type() << " by " << expr2.bare_type() << " in block="; print_scope(error_msgs, var_scope); error_msgs << std::endl; pass = false; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("pow", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function exponentiation_f; void multiplication_expr::operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const { if (expr1.bare_type().is_primitive() && expr2.bare_type().is_primitive()) { expr1 *= expr2; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("multiply", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function multiplication_f; void division_expr::operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const { if (expr1.bare_type().is_primitive() && expr2.bare_type().is_primitive() && (expr1.bare_type().is_double_type() || expr2.bare_type().is_double_type())) { expr1 /= expr2; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); if (expr1.bare_type().is_int_type() && expr2.bare_type().is_int_type()) { // result might be assigned to real - generate warning error_msgs << "Info: integer division" << " implicitly rounds to integer." << " Found int division: " << expr1.to_string() << " / " << expr2.to_string() << std::endl << " Positive values rounded down," << " negative values rounded up or down" << " in platform-dependent way." << std::endl; fun f("divide", args); set_fun_type(f, error_msgs); expr1 = expression(f); return; } if ((expr1.bare_type().is_matrix_type() || expr1.bare_type().is_row_vector_type()) && expr2.bare_type().is_matrix_type()) { fun f("mdivide_right", args); set_fun_type(f, error_msgs); expr1 = expression(f); return; } fun f("divide", args); set_fun_type(f, error_msgs); expr1 = expression(f); return; } boost::phoenix::function division_f; void modulus_expr::operator()(expression &expr1, const expression &expr2, bool &pass, std::ostream &error_msgs) const { if (!expr1.bare_type().is_int_type() && !expr2.bare_type().is_int_type()) { error_msgs << "Both operands of % must be int" << "; cannot modulo " << expr1.bare_type() << " by " << expr2.bare_type(); error_msgs << std::endl; pass = false; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("modulus", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function modulus_f; void left_division_expr::operator()(expression &expr1, bool &pass, const expression &expr2, std::ostream &error_msgs) const { std::vector args; args.push_back(expr1); args.push_back(expr2); if (expr1.bare_type().is_matrix_type() && (expr2.bare_type().is_vector_type() || expr2.bare_type().is_matrix_type())) { fun f("mdivide_left", args); set_fun_type(f, error_msgs); expr1 = expression(f); pass = true; return; } fun f("mdivide_left", args); // set for alt args err msg set_fun_type(f, error_msgs); expr1 = expression(f); pass = false; } boost::phoenix::function left_division_f; void elt_multiplication_expr::operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const { if (expr1.bare_type().is_primitive() && expr2.bare_type().is_primitive()) { expr1 *= expr2; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("elt_multiply", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function elt_multiplication_f; void elt_division_expr::operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const { if (expr1.bare_type().is_primitive() && expr2.bare_type().is_primitive()) { expr1 /= expr2; return; } std::vector args; args.push_back(expr1); args.push_back(expr2); fun f("elt_divide", args); set_fun_type(f, error_msgs); expr1 = expression(f); } boost::phoenix::function elt_division_f; void negate_expr::operator()(expression &expr_result, const expression &expr, bool &pass, std::ostream &error_msgs) const { if (expr.bare_type().is_primitive()) { expr_result = expression(unary_op('-', expr)); return; } std::vector args; args.push_back(expr); fun f("minus", args); set_fun_type(f, error_msgs); expr_result = expression(f); } boost::phoenix::function negate_expr_f; void logical_negate_expr::operator()(expression &expr_result, const expression &expr, std::ostream &error_msgs) const { if (!expr.bare_type().is_primitive()) { error_msgs << "Logical negation operator !" << " only applies to int or real types; "; expr_result = expression(); } std::vector args; args.push_back(expr); fun f("logical_negation", args); set_fun_type(f, error_msgs); expr_result = expression(f); } boost::phoenix::function logical_negate_expr_f; void transpose_expr::operator()(expression &expr, bool &pass, std::ostream &error_msgs) const { if (expr.bare_type().is_primitive()) return; std::vector args; args.push_back(expr); fun f("transpose", args); set_fun_type(f, error_msgs); expr = expression(f); pass = !expr.bare_type().is_ill_formed_type(); } boost::phoenix::function transpose_f; void add_idxs::operator()(expression &e, std::vector &idxs, bool &pass, std::ostream &error_msgs) const { e = index_op_sliced(e, idxs); pass = !e.bare_type().is_ill_formed_type(); if (!pass) error_msgs << "Indexed expression must have at least as many" << " dimensions as number of indexes supplied:" << std::endl << " indexed expression dims=" << e.total_dims() << "; num indexes=" << idxs.size() << std::endl; } boost::phoenix::function add_idxs_f; void add_expression_dimss::operator()( expression &expression, std::vector> &dimss, bool &pass, std::ostream &error_msgs) const { int expr_dims = expression.total_dims(); int index_dims = num_dimss(dimss); if (expr_dims < index_dims) { error_msgs << "Too many indexes, expression dimensions=" << expr_dims << ", indexes found=" << index_dims << std::endl; pass = false; return; } index_op iop(expression, dimss); iop.infer_type(); if (iop.type_.is_ill_formed_type()) { error_msgs << "Indexed expression must have at least as many" << " dimensions as number of indexes supplied." << std::endl; pass = false; return; } pass = true; expression = iop; } boost::phoenix::function add_expression_dimss_f; void set_var_type::operator()(variable &var_expr, expression &val, variable_map &vm, std::ostream &error_msgs, bool &pass) const { std::string name = var_expr.name_; if (name == std::string("lp__")) { error_msgs << std::endl << "Error (fatal): Use of lp__ is no longer supported." << std::endl << " Use target += ... statement to increment log density." << std::endl << " Use target() function to get log density." << std::endl; pass = false; return; } else if (name == std::string("params_r__")) { error_msgs << std::endl << "Info:" << std::endl << " Direct access to params_r__ yields an inconsistent" << " statistical model in isolation and no guarantee is" << " made that this model will yield valid inferences." << std::endl << " Moreover, access to params_r__ is unsupported" << " and the variable may be removed without notice." << std::endl; } else if (name == std::string("data") || name == std::string("generated") || name == std::string("model") || name == std::string("parameters") || name == std::string("transformed")) { error_msgs << std::endl << "Unexpected open block, missing close block \"}\"" << " before keyword \"" << name << "\"." << std::endl; pass = false; return; } pass = vm.exists(name); if (pass) { var_expr.set_type(vm.get_bare_type(name)); } else { error_msgs << "Variable \"" << name << '"' << " does not exist." << std::endl; return; } val = expression(var_expr); } boost::phoenix::function set_var_type_f; void require_vbar::operator()(bool &pass, std::ostream &error_msgs) const { pass = false; error_msgs << "Probabilty functions with suffixes _lpdf, _lpmf," << " _lcdf, and _lccdf," << std::endl << "require a vertical bar (|) between the first two" << " arguments." << std::endl; } boost::phoenix::function require_vbar_f; data_only_expression::data_only_expression(std::stringstream &error_msgs, variable_map &var_map) : error_msgs_(error_msgs), var_map_(var_map) {} bool data_only_expression::operator()(const nil & /*e*/) const { return true; } bool data_only_expression::operator()(const int_literal & /*x*/) const { return true; } bool data_only_expression::operator()(const double_literal & /*x*/) const { return true; } bool data_only_expression::operator()(const array_expr &x) const { for (size_t i = 0; i < x.args_.size(); ++i) if (!boost::apply_visitor(*this, x.args_[i].expr_)) return false; return true; } bool data_only_expression::operator()(const matrix_expr &x) const { for (size_t i = 0; i < x.args_.size(); ++i) if (!boost::apply_visitor(*this, x.args_[i].expr_)) return false; return true; } bool data_only_expression::operator()(const row_vector_expr &x) const { for (size_t i = 0; i < x.args_.size(); ++i) if (!boost::apply_visitor(*this, x.args_[i].expr_)) return false; return true; } bool data_only_expression::operator()(const variable &x) const { scope var_scope = var_map_.get_scope(x.name_); bool is_data = var_scope.allows_size(); if (!is_data) { error_msgs_ << "Non-data variables are not allowed" << " in dimension declarations;" << " found variable=" << x.name_ << "; declared in block="; print_scope(error_msgs_, var_scope); error_msgs_ << "." << std::endl; } return is_data; } bool data_only_expression::operator()(const integrate_1d &x) const { return boost::apply_visitor(*this, x.lb_.expr_) && boost::apply_visitor(*this, x.ub_.expr_) && boost::apply_visitor(*this, x.theta_.expr_); } bool data_only_expression::operator()(const integrate_ode &x) const { return boost::apply_visitor(*this, x.y0_.expr_) && boost::apply_visitor(*this, x.theta_.expr_); } bool data_only_expression::operator()(const integrate_ode_control &x) const { return boost::apply_visitor(*this, x.y0_.expr_) && boost::apply_visitor(*this, x.theta_.expr_); } bool data_only_expression::operator()(const algebra_solver &x) const { return boost::apply_visitor(*this, x.theta_.expr_); } bool data_only_expression::operator()(const algebra_solver_control &x) const { return boost::apply_visitor(*this, x.theta_.expr_); } bool data_only_expression::operator()(const map_rect &x) const { return boost::apply_visitor(*this, x.shared_params_.expr_) && boost::apply_visitor(*this, x.job_params_.expr_); } bool data_only_expression::operator()(const fun &x) const { for (size_t i = 0; i < x.args_.size(); ++i) if (!boost::apply_visitor(*this, x.args_[i].expr_)) return false; return true; } bool data_only_expression::operator()(const index_op &x) const { if (!boost::apply_visitor(*this, x.expr_.expr_)) return false; for (size_t i = 0; i < x.dimss_.size(); ++i) for (size_t j = 0; j < x.dimss_[i].size(); ++j) if (!boost::apply_visitor(*this, x.dimss_[i][j].expr_)) return false; return true; } bool data_only_expression::operator()(const index_op_sliced &x) const { return boost::apply_visitor(*this, x.expr_.expr_); } bool data_only_expression::operator()(const conditional_op &x) const { return boost::apply_visitor(*this, x.cond_.expr_) && boost::apply_visitor(*this, x.true_val_.expr_) && boost::apply_visitor(*this, x.false_val_.expr_); } bool data_only_expression::operator()(const binary_op &x) const { return boost::apply_visitor(*this, x.left.expr_) && boost::apply_visitor(*this, x.right.expr_); } bool data_only_expression::operator()(const unary_op &x) const { return boost::apply_visitor(*this, x.subject.expr_); } template void validate_definition::operator()(const scope &var_scope, const T &var_decl, bool &pass, std::stringstream &error_msgs) const { if (is_nil(var_decl.def())) return; // validate that assigment is allowed in this block if (!var_scope.allows_assignment()) { error_msgs << "Variable definition not possible in this block." << std::endl; pass = false; } // validate type bare_expr_type decl_type(var_decl.bare_type()); bare_expr_type def_type = var_decl.def().bare_type(); bool types_compatible = (decl_type == def_type) || (decl_type.is_primitive() && def_type.is_primitive() && decl_type.is_double_type() && def_type.is_int_type()); if (!types_compatible) { error_msgs << "Variable definition base type mismatch," << " variable declared as base type "; write_bare_expr_type(error_msgs, decl_type); error_msgs << " variable definition has base type "; write_bare_expr_type(error_msgs, def_type); pass = false; } // validate dims if (decl_type.num_dims() != def_type.num_dims()) { error_msgs << "Variable definition dimensions mismatch," << " definition specifies " << decl_type.num_dims() << ", declaration specifies " << def_type.num_dims(); pass = false; } return; } boost::phoenix::function validate_definition_f; template void validate_definition::operator()( const scope &var_scope, const block_var_decl &var_decl, bool &pass, std::stringstream &error_msgs) const; template void validate_definition::operator()( const scope &var_scope, const local_var_decl &var_decl, bool &pass, std::stringstream &error_msgs) const; template void validate_definition::operator()( const scope &var_scope, const var_decl &var_decl, bool &pass, std::stringstream &error_msgs) const; void validate_identifier::reserve(const std::string &w) { reserved_word_set_.insert(w); } bool validate_identifier::contains(const std::set &s, const std::string &x) const { return s.find(x) != s.end(); } bool validate_identifier::identifier_exists( const std::string &identifier) const { return contains(reserved_word_set_, identifier) || (contains(function_signatures::instance().key_set(), identifier) && !contains(const_fun_name_set_, identifier)); } validate_identifier::validate_identifier() { // constant functions which may be used as identifiers const_fun_name_set_.insert("pi"); const_fun_name_set_.insert("e"); const_fun_name_set_.insert("sqrt2"); const_fun_name_set_.insert("log2"); const_fun_name_set_.insert("log10"); const_fun_name_set_.insert("not_a_number"); const_fun_name_set_.insert("positive_infinity"); const_fun_name_set_.insert("negative_infinity"); const_fun_name_set_.insert("epsilon"); const_fun_name_set_.insert("negative_epsilon"); const_fun_name_set_.insert("machine_precision"); // illegal identifiers reserve("for"); reserve("in"); reserve("while"); reserve("repeat"); reserve("until"); reserve("if"); reserve("then"); reserve("else"); reserve("true"); reserve("false"); reserve("int"); reserve("real"); reserve("vector"); reserve("unit_vector"); reserve("simplex"); reserve("ordered"); reserve("positive_ordered"); reserve("row_vector"); reserve("matrix"); reserve("cholesky_factor_cov"); reserve("cholesky_factor_corr"); reserve("cov_matrix"); reserve("corr_matrix"); reserve("target"); reserve("model"); reserve("data"); reserve("parameters"); reserve("quantities"); reserve("transformed"); reserve("generated"); reserve("var"); reserve("fvar"); reserve("STAN_MAJOR"); reserve("STAN_MINOR"); reserve("STAN_PATCH"); reserve("STAN_MATH_MAJOR"); reserve("STAN_MATH_MINOR"); reserve("STAN_MATH_PATCH"); reserve("alignas"); reserve("alignof"); reserve("and"); reserve("and_eq"); reserve("asm"); reserve("auto"); reserve("bitand"); reserve("bitor"); reserve("bool"); reserve("break"); reserve("case"); reserve("catch"); reserve("char"); reserve("char16_t"); reserve("char32_t"); reserve("class"); reserve("compl"); reserve("const"); reserve("constexpr"); reserve("const_cast"); reserve("continue"); reserve("decltype"); reserve("default"); reserve("delete"); reserve("do"); reserve("double"); reserve("dynamic_cast"); reserve("else"); reserve("enum"); reserve("explicit"); reserve("export"); reserve("extern"); reserve("false"); reserve("float"); reserve("for"); reserve("friend"); reserve("goto"); reserve("if"); reserve("inline"); reserve("int"); reserve("long"); reserve("mutable"); reserve("namespace"); reserve("new"); reserve("noexcept"); reserve("not"); reserve("not_eq"); reserve("nullptr"); reserve("operator"); reserve("or"); reserve("or_eq"); reserve("private"); reserve("protected"); reserve("public"); reserve("register"); reserve("reinterpret_cast"); reserve("return"); reserve("short"); reserve("signed"); reserve("sizeof"); reserve("static"); reserve("static_assert"); reserve("static_cast"); reserve("struct"); reserve("switch"); reserve("template"); reserve("this"); reserve("thread_local"); reserve("throw"); reserve("true"); reserve("try"); reserve("typedef"); reserve("typeid"); reserve("typename"); reserve("union"); reserve("unsigned"); reserve("using"); reserve("virtual"); reserve("void"); reserve("volatile"); reserve("wchar_t"); reserve("while"); reserve("xor"); reserve("xor_eq"); // function names declared in signatures using stan::lang::function_signatures; using std::set; using std::string; const function_signatures &sigs = function_signatures::instance(); set fun_names = sigs.key_set(); for (set::iterator it = fun_names.begin(); it != fun_names.end(); ++it) if (!contains(const_fun_name_set_, *it)) reserve(*it); } // validates identifier shape void validate_identifier::operator()(const std::string &identifier, bool &pass, std::stringstream &error_msgs) const { int len = identifier.size(); if (len >= 2 && identifier[len - 1] == '_' && identifier[len - 2] == '_') { error_msgs << "Variable identifier (name) may" << " not end in double underscore (__)" << std::endl << " found identifer=" << identifier << std::endl; pass = false; return; } size_t period_position = identifier.find('.'); if (period_position != std::string::npos) { error_msgs << "Variable identifier may not contain a period (.)" << std::endl << " found period at position (indexed from 0)=" << period_position << std::endl << " found identifier=" << identifier << std::endl; pass = false; return; } if (identifier_exists(identifier)) { error_msgs << "Variable identifier (name) may not be reserved word" << std::endl << " found identifier=" << identifier << std::endl; pass = false; return; } pass = true; } boost::phoenix::function validate_identifier_f; // copies single dimension from M to N if only M declared void copy_square_cholesky_dimension_if_necessary::operator()( cholesky_factor_cov_block_type &block_type) const { if (is_nil(block_type.N_)) block_type.N_ = block_type.M_; } boost::phoenix::function copy_square_cholesky_dimension_if_necessary_f; void empty_range::operator()(range &r, std::stringstream & /*error_msgs*/) const { r = range(); } boost::phoenix::function empty_range_f; void empty_offset_multiplier::operator()( offset_multiplier &r, std::stringstream & /*error_msgs*/) const { r = offset_multiplier(); } boost::phoenix::function empty_offset_multiplier_f; void set_int_range_lower::operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const { range.low_ = expr; validate_int_expr validator; validator(expr, pass, error_msgs); } boost::phoenix::function set_int_range_lower_f; void set_int_range_upper::operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const { range.high_ = expr; validate_int_expr validator; validator(expr, pass, error_msgs); } boost::phoenix::function set_int_range_upper_f; void validate_int_data_only_expr::operator()( const expression &expr, bool &pass, variable_map &var_map, std::stringstream &error_msgs) const { if (!expr.bare_type().is_int_type()) { error_msgs << "Dimension declaration requires expression" << " denoting integer; found type=" << expr.bare_type() << std::endl; pass = false; return; } data_only_expression vis(error_msgs, var_map); bool only_data_dimensions = boost::apply_visitor(vis, expr.expr_); pass = only_data_dimensions; return; } boost::phoenix::function validate_int_data_only_expr_f; void set_double_range_lower::operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const { range.low_ = expr; validate_double_expr validator; validator(expr, pass, error_msgs); } boost::phoenix::function set_double_range_lower_f; void set_double_range_upper::operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const { range.high_ = expr; validate_double_expr validator; validator(expr, pass, error_msgs); } boost::phoenix::function set_double_range_upper_f; void set_double_offset_multiplier_loc::operator()( offset_multiplier &offset_multiplier, const expression &expr, bool &pass, std::stringstream &error_msgs) const { offset_multiplier.offset_ = expr; validate_double_expr validator; validator(expr, pass, error_msgs); } boost::phoenix::function set_double_offset_multiplier_offset_f; void set_double_offset_multiplier_multiplier::operator()( offset_multiplier &offset_multiplier, const expression &expr, bool &pass, std::stringstream &error_msgs) const { offset_multiplier.multiplier_ = expr; validate_double_expr validator; validator(expr, pass, error_msgs); } boost::phoenix::function set_double_offset_multiplier_multiplier_f; void validate_array_block_var_decl::operator()( block_var_decl &var_decl_result, const block_var_type &el_type, const std::string &name, const std::vector &dims, const expression &def, bool &pass, std::ostream &error_msgs) const { if (dims.size() == 0) { error_msgs << "Array type requires at least 1 dimension," << " none found" << std::endl; pass = false; return; } if (el_type.bare_type().is_ill_formed_type()) { error_msgs << "Array variable declaration is ill formed," << " variable name=" << name << std::endl; pass = false; return; } stan::lang::block_array_type bat(el_type, dims); block_var_decl result(name, bat, def); var_decl_result = result; } boost::phoenix::function validate_array_block_var_decl_f; void validate_single_block_var_decl::operator()( const block_var_decl &var_decl, bool &pass, std::ostream &error_msgs) const { if (var_decl.bare_type().is_ill_formed_type()) { error_msgs << "Variable declaration is ill formed," << " variable name=" << var_decl.name() << std::endl; pass = false; return; } } boost::phoenix::function validate_single_block_var_decl_f; void validate_single_local_var_decl::operator()( const local_var_decl &var_decl, bool &pass, std::ostream &error_msgs) const { if (var_decl.bare_type().is_ill_formed_type()) { error_msgs << "Variable declaration is ill formed," << " variable name=" << var_decl.name() << std::endl; pass = false; return; } } boost::phoenix::function validate_single_local_var_decl_f; void validate_array_local_var_decl::operator()( local_var_decl &var_decl_result, const local_var_type &el_type, const std::string &name, const std::vector &dims, const expression &def, bool &pass, std::ostream &error_msgs) const { if (dims.size() == 0) { error_msgs << "Array type requires at least 1 dimension," << " none found" << std::endl; pass = false; return; } if (el_type.bare_type().is_ill_formed_type()) { error_msgs << "Array variable declaration is ill formed," << " variable name=" << name << std::endl; pass = false; return; } stan::lang::local_array_type bat(el_type, dims); local_var_decl result(name, bat, def); var_decl_result = result; } boost::phoenix::function validate_array_local_var_decl_f; void validate_fun_arg_var::operator()(var_decl &var_decl_result, const bare_expr_type &bare_type, const std::string &name, bool &pass, std::ostream &error_msgs) const { if (bare_type.is_ill_formed_type()) { error_msgs << "Function argument is ill formed," << " name=" << name << std::endl; pass = false; return; } stan::lang::var_decl vd(name, bare_type); var_decl_result = vd; } boost::phoenix::function validate_fun_arg_var_f; void validate_bare_type::operator()(bare_expr_type &bare_type_result, const bare_expr_type &el_type, const size_t &num_dims, bool &pass, std::ostream &error_msgs) const { if (el_type.is_ill_formed_type()) { error_msgs << "Ill-formed bare type" << std::endl; pass = false; return; } pass = true; if (num_dims == 0) { bare_type_result = el_type; return; } stan::lang::bare_array_type bat(el_type); for (size_t i = 0; i < num_dims - 1; ++i) { stan::lang::bare_expr_type cur_type(bat); bat = bare_array_type(cur_type); } bare_type_result = bat; } boost::phoenix::function validate_bare_type_f; template void add_to_var_map::operator()(const T &decl, variable_map &vm, bool &pass, const scope &var_scope, std::ostream &error_msgs) const { pass = false; if (vm.exists(decl.name())) { var_decl prev_decl = vm.get(decl.name()); error_msgs << "Duplicate declaration of variable, name=" << decl.name(); error_msgs << "; attempt to redeclare as " << decl.bare_type() << " in "; print_scope(error_msgs, var_scope); error_msgs << "; previously declared as " << prev_decl.bare_type() << " in "; print_scope(error_msgs, vm.get_scope(decl.name())); error_msgs << std::endl; pass = false; return; } if (var_scope.par_or_tpar() && decl.bare_type().innermost_type().is_int_type()) { error_msgs << "Parameters or transformed parameters" << " cannot be integer or integer array; " << " found int variable declaration, name=" << decl.name() << std::endl; pass = false; return; } var_decl bare_decl(decl.name(), decl.type().bare_type(), decl.def()); vm.add(decl.name(), bare_decl, var_scope); pass = true; } boost::phoenix::function add_to_var_map_f; template void add_to_var_map::operator()(const block_var_decl &decl, variable_map &vm, bool &pass, const scope &var_scope, std::ostream &error_msgs) const; template void add_to_var_map::operator()(const local_var_decl &decl, variable_map &vm, bool &pass, const scope &var_scope, std::ostream &error_msgs) const; void validate_in_loop::operator()(bool in_loop, bool &pass, std::ostream &error_msgs) const { pass = in_loop; if (!pass) error_msgs << "Break and continue statements are only allowed" << " in the body of a for-loop or while-loop." << std::endl; } boost::phoenix::function validate_in_loop_f; void non_void_expression::operator()(const expression &e, bool &pass, std::ostream &error_msgs) const { // ill-formed shouldn't be possible, but just in case pass = !(e.bare_type().is_void_type() || e.bare_type().is_ill_formed_type()); if (!pass) error_msgs << "Error: expected printable (non-void) expression." << std::endl; } boost::phoenix::function non_void_expression_f; void set_var_scope::operator()(scope &var_scope, const origin_block &program_block) const { var_scope = scope(program_block); } boost::phoenix::function set_var_scope_f; void set_data_origin::operator()(scope &var_scope) const { var_scope = scope(data_origin); } boost::phoenix::function set_data_origin_f; void set_var_scope_local::operator()(scope &var_scope, const origin_block &program_block) const { var_scope = scope(program_block, true); } boost::phoenix::function set_var_scope_local_f; void reset_var_scope::operator()(scope &var_scope, const scope &scope_enclosing) const { origin_block enclosing_block = scope_enclosing.program_block(); var_scope = scope(enclosing_block, true); } boost::phoenix::function reset_var_scope_f; // only used to debug grammars void trace::operator()(const std::string &msg) const { // std::cout << msg << std::endl; } boost::phoenix::function trace_f; // only used to debug grammars void trace_pass::operator()(const std::string &msg, const bool &pass) const { // std::cout << msg << " pass? " << pass << std::endl; } boost::phoenix::function trace_pass_f; void deprecate_pound_comment::operator()(std::ostream &error_msgs) const { error_msgs << "Info: Comments beginning with #" << " are deprecated. Please use // in place of #" << " for line comments." << std::endl; } boost::phoenix::function deprecate_pound_comment_f; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/local_var_decls_grammar_inst.cpp0000644000176200001440000000034513766554456027753 0ustar liggesusers#include #include namespace stan { namespace lang { template struct local_var_decls_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/program_grammar_inst.cpp0000644000176200001440000000032513766554456026304 0ustar liggesusers#include #include namespace stan { namespace lang { template struct program_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/indexes_grammar.hpp0000644000176200001440000000440013766554456025242 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_INDEXES_GRAMMAR_HPP #define STAN_LANG_GRAMMARS_INDEXES_GRAMMAR_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { // needed to break circularity of expression grammar including indexes template struct expression_grammar; template struct indexes_grammar : boost::spirit::qi::grammar(scope), whitespace_grammar > { variable_map& var_map_; std::stringstream& error_msgs_; expression_grammar& expression_g; indexes_grammar(variable_map& var_map, std::stringstream& error_msgs, expression_grammar& eg); boost::spirit::qi::rule(scope), whitespace_grammar > indexes_r; boost::spirit::qi::rule > index_r; boost::spirit::qi::rule > close_indexes_r; boost::spirit::qi::rule > uni_index_r; boost::spirit::qi::rule > multi_index_r; boost::spirit::qi::rule > omni_index_r; boost::spirit::qi::rule > lb_index_r; boost::spirit::qi::rule > ub_index_r; boost::spirit::qi::rule > lub_index_r; boost::spirit::qi::rule > int_expression_r; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/whitespace_grammar_def.hpp0000644000176200001440000000174613766554456026567 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_WHITESPACE_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_WHITESPACE_GRAMMAR_DEF_HPP #include #include #include #include #include #include namespace stan { namespace lang { template whitespace_grammar::whitespace_grammar(std::stringstream& ss) : whitespace_grammar::base_type(whitespace), error_msgs_(ss) { using boost::spirit::qi::char_; using boost::spirit::qi::eol; using boost::spirit::qi::omit; whitespace = ((omit["/*"] >> *(char_ - "*/")) > omit["*/"]) | (omit["//"] >> *(char_ - eol)) | (omit["#"] >> *(char_ - eol))[deprecate_pound_comment_f( boost::phoenix::ref(error_msgs_))] | boost::spirit::ascii::space_type(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/semantic_actions.hpp0000644000176200001440000011274413766554456025433 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_SEMANTIC_ACTIONS_HPP #define STAN_LANG_GRAMMARS_SEMANTIC_ACTIONS_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { bool has_prob_suffix(const std::string &s); void replace_suffix(const std::string &old_suffix, const std::string &new_suffix, fun &f); void set_fun_type(fun &fun, std::ostream &error_msgs); int num_dimss(std::vector> &dimss); /** * This is the base class for unnary functors that are adapted to * lazy semantic actions by boost::phoenix. The base class deals * with the type dispatch required by Phoenix. */ struct phoenix_functor_unary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; /** * This is the base class for binary functors that are adapted to * lazy semantic actions by boost::phoenix. The base class deals * with the type dispatch required by Phoenix. */ struct phoenix_functor_binary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; /** * This is the base class for ternary functors that are adapted to * lazy semantic actions by boost::phoenix. The base class deals * with the type dispatch required by Phoenix. */ struct phoenix_functor_ternary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; /** * This is the base class for quatenary functors that are adapted * to lazy semantic actions by boost::phoenix. The base class * deals with the type dispatch required by Phoenix. */ struct phoenix_functor_quaternary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; /** * This is the base class for quinary functors that are adapted to * lazy semantic actions by boost::phoenix. The base class deals * with the type dispatch required by Phoenix. */ struct phoenix_functor_quinary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; /** * This is the base class for senary functors that are adapted to * lazy semantic actions by boost::phoenix. The base class deals * with the type dispatch required by Phoenix. */ struct phoenix_functor_senary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; /** * This is the base class for septenary functors that are adapted to * lazy semantic actions by boost::phoenix. The base class deals * with the type dispatch required by Phoenix. */ struct phoenix_functor_septenary { /** * Declare result to be a template struct. */ template struct result; /** * Specialize as required by Phoenix to functional form * with typedef of return type. */ template struct result { typedef void type; }; }; struct assign_lhs : public phoenix_functor_binary { template void operator()(L &lhs, const R &rhs) const; }; extern boost::phoenix::function assign_lhs_f; // called from: expression07_grammar struct validate_expr_type3 : public phoenix_functor_ternary { void operator()(const expression &expr, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_expr_type3_f; // called from: term_grammar struct is_prob_fun : public phoenix_functor_binary { void operator()(const std::string &s, bool &pass) const; }; extern boost::phoenix::function is_prob_fun_f; // called from: expression07_grammar struct addition_expr3 : public phoenix_functor_ternary { void operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function addition3_f; // called from: expression07_grammar struct subtraction_expr3 : public phoenix_functor_ternary { void operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function subtraction3_f; // called from bare_type_grammar struct increment_size_t : public phoenix_functor_unary { void operator()(size_t &lhs) const; }; extern boost::phoenix::function increment_size_t_f; // called from: expression_grammar struct validate_conditional_op : public phoenix_functor_quinary { void operator()(conditional_op &cond_expr, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_conditional_op_f; // called from: expression_grammar struct binary_op_expr : public phoenix_functor_quinary { void operator()(expression &expr1, const expression &expr2, const std::string &op, const std::string &fun_name, std::ostream &error_msgs) const; }; extern boost::phoenix::function binary_op_f; // called from: functions_grammar struct validate_non_void_arg_function : public phoenix_functor_quaternary { void operator()(bare_expr_type &arg_type, const scope &var_scope, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_non_void_arg_f; // called from: functions_grammar struct set_void_function : public phoenix_functor_quaternary { void operator()(const bare_expr_type &return_type, scope &var_scope, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function set_void_function_f; // called from: functions_grammar struct set_allows_sampling_origin : public phoenix_functor_binary { void operator()(const std::string &identifier, scope &var_scope) const; }; extern boost::phoenix::function set_allows_sampling_origin_f; // called from: functions_grammar struct validate_declarations : public phoenix_functor_quinary { void operator()( bool &pass, std::set> &declared, std::set> &defined, std::ostream &error_msgs, bool allow_undefined) const; }; extern boost::phoenix::function validate_declarations_f; // called from: functions_grammar struct add_function_signature : public phoenix_functor_quinary { void operator()( const function_decl_def &decl, bool &pass, std::set> &functions_declared, std::set> &functions_defined, std::ostream &error_msgs) const; }; extern boost::phoenix::function add_function_signature_f; // called from: functions_grammar struct validate_return_type : public phoenix_functor_ternary { void operator()(function_decl_def &decl, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_return_type_f; // called from: functions_grammar struct validate_pmf_pdf_variate : public phoenix_functor_ternary { void operator()(function_decl_def &decl, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_pmf_pdf_variate_f; // called from: functions_grammar struct validate_prob_fun : public phoenix_functor_ternary { void operator()(std::string &fname, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_prob_fun_f; // called from: functions_grammar struct set_fun_params_scope : public phoenix_functor_binary { void operator()(scope &var_scope, variable_map &vm) const; }; extern boost::phoenix::function set_fun_params_scope_f; // called from: functions_grammar struct unscope_variables : public phoenix_functor_binary { void operator()(function_decl_def &decl, variable_map &vm) const; }; extern boost::phoenix::function unscope_variables_f; // called from: functions_grammar struct add_fun_arg_var : public phoenix_functor_quinary { void operator()(const var_decl &decl, const scope &scope, bool &pass, variable_map &vm, std::ostream &error_msgs) const; }; extern boost::phoenix::function add_fun_arg_var_f; struct validate_fun_arg_var : public phoenix_functor_quinary { void operator()(var_decl &var_decl_result, const bare_expr_type &bare_type, const std::string &name, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_fun_arg_var_f; // called from: indexes_grammar struct set_omni_idx : public phoenix_functor_unary { void operator()(omni_idx &val) const; }; extern boost::phoenix::function set_omni_idx_f; // called from: indexes_grammar, statement_grammar struct validate_int_expr_silent : public phoenix_functor_binary { void operator()(const expression &e, bool &pass) const; }; extern boost::phoenix::function validate_int_expr_silent_f; // called from: indexes_grammar struct validate_ints_expression : public phoenix_functor_ternary { void operator()(const expression &e, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_ints_expression_f; // called from: program_grammar struct add_params_var : public phoenix_functor_unary { void operator()(variable_map &vm) const; }; extern boost::phoenix::function add_params_var_f; // called from: program_grammar struct remove_params_var : public phoenix_functor_unary { void operator()(variable_map &vm) const; }; extern boost::phoenix::function remove_params_var_f; // called from: program_grammar struct program_error : public phoenix_functor_senary { void operator()(pos_iterator_t _begin, pos_iterator_t _end, pos_iterator_t _where, variable_map &vm, std::stringstream &error_msgs, const io::program_reader &reader) const; }; extern boost::phoenix::function program_error_f; // called from: statement_2_grammar struct add_conditional_condition : public phoenix_functor_quaternary { void operator()(conditional_statement &cs, const expression &e, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function add_conditional_condition_f; // called from: statement_2_grammar struct add_conditional_body : public phoenix_functor_binary { void operator()(conditional_statement &cs, const statement &s) const; }; extern boost::phoenix::function add_conditional_body_f; // called from: statement_grammar struct deprecate_old_assignment_op : public phoenix_functor_binary { void operator()(std::string &op, std::ostream &error_msgs) const; }; extern boost::phoenix::function deprecate_old_assignment_op_f; // called from: statement_grammar struct non_void_return_msg : public phoenix_functor_ternary { void operator()(scope var_scope, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function non_void_return_msg_f; // called from: statement_grammar struct validate_return_allowed : public phoenix_functor_ternary { void operator()(scope var_scope, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_return_allowed_f; // called from: statement_grammar struct validate_void_return_allowed : public phoenix_functor_ternary { void operator()(scope var_scope, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_void_return_allowed_f; // called from: statement_grammar struct set_lhs_var_assgn : public phoenix_functor_quaternary { void operator()(assgn &a, const std::string &name, bool &pass, const variable_map &vm) const; }; extern boost::phoenix::function set_lhs_var_assgn_f; // called from: statement_grammar struct validate_lhs_var_assgn : public phoenix_functor_quinary { void operator()(assgn &a, const scope &var_scope, bool &pass, const variable_map &vm, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_lhs_var_assgn_f; // called from: statement_grammar struct validate_assgn : public phoenix_functor_quaternary { void operator()(assgn &a, bool &pass, const variable_map &vm, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_assgn_f; // called from: statement_grammar struct validate_sample : public phoenix_functor_quaternary { void operator()(sample &s, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_sample_f; // called from: statement_grammar struct expression_as_statement : public phoenix_functor_ternary { void operator()(bool &pass, const stan::lang::expression &expr, std::stringstream &error_msgs) const; }; extern boost::phoenix::function expression_as_statement_f; // called from: statement_grammar struct unscope_locals : public phoenix_functor_binary { void operator()(const std::vector &var_decls, variable_map &vm) const; }; extern boost::phoenix::function unscope_locals_f; // called from: statement_grammar struct add_while_condition : public phoenix_functor_quaternary { void operator()(while_statement &ws, const expression &e, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function add_while_condition_f; // called from: statement_grammar struct add_while_body : public phoenix_functor_binary { void operator()(while_statement &ws, const statement &s) const; }; extern boost::phoenix::function add_while_body_f; // called from: statement_grammar struct add_loop_identifier : public phoenix_functor_ternary { void operator()(const std::string &name, const scope &var_scope, variable_map &vm) const; }; extern boost::phoenix::function add_loop_identifier_f; // called from: statement_grammar struct add_array_loop_identifier : public phoenix_functor_quinary { void operator()(const stan::lang::expression &expr, std::string &name, const scope &var_scope, bool &pass, variable_map &vm) const; }; extern boost::phoenix::function add_array_loop_identifier_f; // called from: statement_grammar struct add_matrix_loop_identifier : public phoenix_functor_senary { void operator()(const stan::lang::expression &expr, std::string &name, const scope &var_scope, bool &pass, variable_map &vm, std::stringstream &error_msgs) const; }; extern boost::phoenix::function add_matrix_loop_identifier_f; // called from: statement_grammar struct store_loop_identifier : public phoenix_functor_quinary { void operator()(const std::string &name, std::string &name_local, bool &pass, variable_map &vm, std::stringstream &error_msgs) const; }; extern boost::phoenix::function store_loop_identifier_f; // called from: statement_grammar struct remove_loop_identifier : public phoenix_functor_binary { void operator()(const std::string &name, variable_map &vm) const; }; extern boost::phoenix::function remove_loop_identifier_f; // called from: statement_grammar struct deprecate_increment_log_prob : public phoenix_functor_unary { void operator()(std::stringstream &error_msgs) const; }; extern boost::phoenix::function deprecate_increment_log_prob_f; // called from: statement_grammar struct validate_allow_sample : public phoenix_functor_ternary { void operator()(const scope &var_scope, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function validate_allow_sample_f; // called from: statement_grammar struct validate_non_void_expression : public phoenix_functor_ternary { void operator()(const expression &e, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_non_void_expression_f; // called from: statement_grammar struct set_void_return : public phoenix_functor_unary { void operator()(return_statement &s) const; }; extern boost::phoenix::function set_void_return_f; // called from: statement_grammar struct set_no_op : public phoenix_functor_unary { void operator()(no_op_statement &s) const; }; extern boost::phoenix::function set_no_op_f; // called from: term_grammar struct deprecated_integrate_ode : phoenix_functor_unary { void operator()(std::ostream &error_msgs) const; }; extern boost::phoenix::function deprecated_integrate_ode_f; // test first arguments for both ode calling patterns // (with/without control) template void validate_integrate_ode_non_control_args(const T &ode_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs); // called from: term_grammar struct validate_integrate_ode : public phoenix_functor_quaternary { void operator()(const integrate_ode &ode_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_integrate_ode_f; // called from: term_grammar struct validate_integrate_ode_control : public phoenix_functor_quaternary { void operator()(const integrate_ode_control &ode_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_integrate_ode_control_f; // test first arguments for both algebra_solver calling patterns // (with/without control) template void validate_algebra_solver_non_control_args(const T &alg_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs); // called from: term_grammar struct validate_algebra_solver : public phoenix_functor_quaternary { void operator()(const algebra_solver &alg_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_algebra_solver_f; // called from: term_grammar struct validate_algebra_solver_control : public phoenix_functor_quaternary { void operator()(const algebra_solver_control &alg_fun, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_algebra_solver_control_f; // called from: term_grammar /** * Functor for validating the arguments to map_rect. */ struct validate_map_rect : public phoenix_functor_quaternary { /** * Validate that the specified rectangular map object has * appropriately typed arguments and assign it a unique * identifier, setting the pass flag to false and writing an * error message to the output stream if they don't. * * @param[in,out] mr structure to validate * @param[in] var_map mapping for variables * @param[in,out] pass reference to set to false upon failure * @param[in,out] error_msgs reference to error message stream * @throws std::illegal_argument_exception if the arguments are * not of the appropriate shapes. */ void operator()(map_rect &mr, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; /** * Phoenix wrapper for the rectangular map structure validator. */ extern boost::phoenix::function validate_map_rect_f; // called from: term_grammar /** * Functor for validating the arguments to map_rect. */ struct validate_integrate_1d : public phoenix_functor_quaternary { /** * Validate that the specified 1d integration object has * appropriately typed arguments with appropriate data-only * requirements, setting the pass flag to false and writing an * error message to the output stream if they don't. * * @param[in,out] fx structure to validate * @param[in] var_map mapping for variables * @param[in,out] pass reference to set to false upon failure * @param[in,out] error_msgs reference to error message stream * @throws std::illegal_argument_exception if the arguments are * not of the appropriate shapes. */ void operator()(integrate_1d &fx, const variable_map &var_map, bool &pass, std::ostream &error_msgs) const; }; /** * Phoenix wrapper for the rectangular map structure validator. */ extern boost::phoenix::function validate_integrate_1d_f; // called from: term_grammar struct set_fun_type_named : public phoenix_functor_senary { void operator()(expression &fun_result, fun &fun, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const; }; extern boost::phoenix::function set_fun_type_named_f; // called from: term_grammar struct infer_array_expr_type : public phoenix_functor_senary { void operator()(expression &e, array_expr &array_expr, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const; }; extern boost::phoenix::function infer_array_expr_type_f; // called from: term_grammar struct infer_vec_or_matrix_expr_type : public phoenix_functor_senary { void operator()(expression &e, row_vector_expr &vec_expr, const scope &var_scope, bool &pass, const variable_map &var_map, std::ostream &error_msgs) const; }; extern boost::phoenix::function infer_vec_or_matrix_expr_type_f; // called from: term_grammar struct exponentiation_expr : public phoenix_functor_quinary { void operator()(expression &expr1, const expression &expr2, const scope &var_scope, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function exponentiation_f; // called from: term_grammar struct multiplication_expr : public phoenix_functor_ternary { void operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function multiplication_f; // called from: term_grammar struct division_expr : public phoenix_functor_ternary { void operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function division_f; // called from: term_grammar struct modulus_expr : public phoenix_functor_quaternary { void operator()(expression &expr1, const expression &expr2, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function modulus_f; // called from: term_grammar struct left_division_expr : public phoenix_functor_quaternary { void operator()(expression &expr1, bool &pass, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function left_division_f; // called from: term_grammar struct elt_multiplication_expr : public phoenix_functor_ternary { void operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function elt_multiplication_f; // called from: term_grammar struct elt_division_expr : public phoenix_functor_ternary { void operator()(expression &expr1, const expression &expr2, std::ostream &error_msgs) const; }; extern boost::phoenix::function elt_division_f; // called from: term_grammar struct negate_expr : public phoenix_functor_quaternary { void operator()(expression &expr_result, const expression &expr, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function negate_expr_f; // called from: term_grammar struct logical_negate_expr : public phoenix_functor_ternary { void operator()(expression &expr_result, const expression &expr, std::ostream &error_msgs) const; }; extern boost::phoenix::function logical_negate_expr_f; // called from: term_grammar struct transpose_expr : public phoenix_functor_ternary { void operator()(expression &expr, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function transpose_f; // called from: term_grammar struct add_idxs : public phoenix_functor_quaternary { void operator()(expression &e, std::vector &idxs, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function add_idxs_f; // called from: term_grammar struct add_expression_dimss : public phoenix_functor_quaternary { void operator()(expression &expression, std::vector> &dimss, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function add_expression_dimss_f; // called from: term_grammar struct set_var_type : public phoenix_functor_quinary { void operator()(variable &var_expr, expression &val, variable_map &vm, std::ostream &error_msgs, bool &pass) const; }; extern boost::phoenix::function set_var_type_f; struct require_vbar : public phoenix_functor_binary { void operator()(bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function require_vbar_f; struct data_only_expression : public boost::static_visitor { std::stringstream &error_msgs_; variable_map &var_map_; data_only_expression(std::stringstream &error_msgs, variable_map &var_map); bool operator()(const nil & /*e*/) const; bool operator()(const int_literal & /*x*/) const; bool operator()(const double_literal & /*x*/) const; bool operator()(const array_expr &x) const; bool operator()(const matrix_expr &x) const; bool operator()(const row_vector_expr &x) const; bool operator()(const variable &x) const; bool operator()(const integrate_1d &x) const; bool operator()(const integrate_ode &x) const; bool operator()(const integrate_ode_control &x) const; bool operator()(const algebra_solver &x) const; bool operator()(const algebra_solver_control &x) const; bool operator()(const map_rect &x) const; bool operator()(const fun &x) const; bool operator()(const index_op &x) const; bool operator()(const index_op_sliced &x) const; bool operator()(const conditional_op &x) const; bool operator()(const binary_op &x) const; bool operator()(const unary_op &x) const; }; struct add_line_number : public phoenix_functor_ternary { template void operator()(T &line, const I &begin, const I &end) const; }; extern boost::phoenix::function add_line_number_f; struct add_literal_string : public phoenix_functor_ternary { void operator()(double_literal &lit, const pos_iterator_t &begin, const pos_iterator_t &end) const; }; extern boost::phoenix::function add_literal_string_f; struct validate_definition : public phoenix_functor_quaternary { template void operator()(const scope &var_scope, const T &var_decl, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function validate_definition_f; struct validate_identifier : public phoenix_functor_ternary { std::set reserved_word_set_; std::set const_fun_name_set_; validate_identifier(); void operator()(const std::string &identifier, bool &pass, std::stringstream &error_msgs) const; bool contains(const std::set &s, const std::string &x) const; bool identifier_exists(const std::string &identifier) const; void reserve(const std::string &w); }; extern boost::phoenix::function validate_identifier_f; // copies single dimension from M to N if only M declared struct copy_square_cholesky_dimension_if_necessary : public phoenix_functor_unary { void operator()(cholesky_factor_cov_block_type &block_type) const; }; extern boost::phoenix::function copy_square_cholesky_dimension_if_necessary_f; struct empty_range : public phoenix_functor_binary { void operator()(range &r, std::stringstream & /*error_msgs*/) const; }; extern boost::phoenix::function empty_range_f; struct empty_offset_multiplier : public phoenix_functor_binary { void operator()(offset_multiplier &r, std::stringstream & /*error_msgs*/) const; }; extern boost::phoenix::function empty_offset_multiplier_f; struct validate_int_expr : public phoenix_functor_ternary { void operator()(const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function validate_int_expr_f; struct set_int_range_lower : public phoenix_functor_quaternary { void operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function set_int_range_lower_f; struct set_int_range_upper : public phoenix_functor_quaternary { void operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function set_int_range_upper_f; struct validate_int_data_only_expr : public phoenix_functor_quaternary { void operator()(const expression &expr, bool &pass, variable_map &var_map, std::stringstream &error_msgs) const; }; extern boost::phoenix::function validate_int_data_only_expr_f; struct validate_double_expr : public phoenix_functor_ternary { void operator()(const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function validate_double_expr_f; struct set_double_range_lower : public phoenix_functor_quaternary { void operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function set_double_range_lower_f; struct set_double_range_upper : public phoenix_functor_quaternary { void operator()(range &range, const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function set_double_range_upper_f; struct set_double_offset_multiplier_loc : public phoenix_functor_quaternary { void operator()(offset_multiplier &offset_multiplier, const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function set_double_offset_multiplier_offset_f; struct set_double_offset_multiplier_multiplier : public phoenix_functor_quaternary { void operator()(offset_multiplier &offset_multiplier, const expression &expr, bool &pass, std::stringstream &error_msgs) const; }; extern boost::phoenix::function set_double_offset_multiplier_multiplier_f; struct validate_bare_type : public phoenix_functor_quinary { void operator()(bare_expr_type &bare_type_result, const bare_expr_type &el_type, const size_t &num_dims, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_bare_type_f; struct validate_array_block_var_decl : public phoenix_functor_septenary { void operator()(block_var_decl &var_decl_result, const block_var_type &el_type, const std::string &name, const std::vector &dims, const expression &def, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_array_block_var_decl_f; struct validate_array_local_var_decl : public phoenix_functor_septenary { void operator()(local_var_decl &var_decl_result, const local_var_type &el_type, const std::string &name, const std::vector &dims, const expression &def, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_array_local_var_decl_f; struct validate_single_block_var_decl : public phoenix_functor_ternary { void operator()(const block_var_decl &var_decl_result, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_single_block_var_decl_f; struct validate_single_local_var_decl : public phoenix_functor_ternary { void operator()(const local_var_decl &var_decl_result, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_single_local_var_decl_f; struct add_to_var_map : public phoenix_functor_quinary { template void operator()(const T &decl, variable_map &vm, bool &pass, const scope &var_scope, std::ostream &error_msgs) const; }; extern boost::phoenix::function add_to_var_map_f; struct validate_in_loop : public phoenix_functor_ternary { void operator()(bool in_loop, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function validate_in_loop_f; struct non_void_expression : public phoenix_functor_ternary { void operator()(const expression &e, bool &pass, std::ostream &error_msgs) const; }; extern boost::phoenix::function non_void_expression_f; struct set_var_scope : public phoenix_functor_binary { void operator()(scope &var_scope, const origin_block &program_block) const; }; extern boost::phoenix::function set_var_scope_f; struct set_data_origin : public phoenix_functor_unary { void operator()(scope &var_scope) const; }; extern boost::phoenix::function set_data_origin_f; struct set_var_scope_local : public phoenix_functor_binary { void operator()(scope &var_scope, const origin_block &program_block) const; }; extern boost::phoenix::function set_var_scope_local_f; struct reset_var_scope : public phoenix_functor_binary { void operator()(scope &var_scope, const scope &scope_enclosing) const; }; extern boost::phoenix::function reset_var_scope_f; // handle trace messages as needed for debugging struct trace : public phoenix_functor_unary { void operator()(const std::string &msg) const; }; extern boost::phoenix::function trace_f; // handle trace messages as needed for debugging struct trace_pass : public phoenix_functor_binary { void operator()(const std::string &msg, const bool &pass) const; }; extern boost::phoenix::function trace_pass_f; // called from: whitespace_grammar struct deprecate_pound_comment : public phoenix_functor_unary { void operator()(std::ostream &error_msgs) const; }; extern boost::phoenix::function deprecate_pound_comment_f; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/bare_type_grammar_def.hpp0000644000176200001440000000441513766554456026401 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_BARE_TYPE_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_BARE_TYPE_GRAMMAR_DEF_HPP #include #include #include #include #include #include namespace stan { namespace lang { template bare_type_grammar::bare_type_grammar(std::stringstream& error_msgs) : bare_type_grammar::base_type(bare_type_r), error_msgs_(error_msgs) { using boost::spirit::qi::_1; using boost::spirit::qi::_2; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::eps; using boost::spirit::qi::lit; bare_type_r.name( "bare type definition\n" " (no dimensions or constraints, just commas,\n" " e.g. real[,] for a 2D array or int for a single integer,\n" " and constrained types such as cov_matrix not allowed)"); bare_type_r = (type_identifier_r >> bare_dims_r)[validate_bare_type_f( _val, _1, _2, _pass, boost::phoenix::ref(error_msgs_))]; type_identifier_r.name( "bare type identifier\n" " legal values: void, int, real, vector, row_vector, matrix"); type_identifier_r %= lit("void")[assign_lhs_f(_val, bare_expr_type(void_type()))] | lit("int")[assign_lhs_f(_val, bare_expr_type(int_type()))] | lit("real")[assign_lhs_f(_val, bare_expr_type(double_type()))] | lit("vector")[assign_lhs_f(_val, bare_expr_type(vector_type()))] | lit("row_vector")[assign_lhs_f(_val, bare_expr_type(row_vector_type()))] | lit("matrix")[assign_lhs_f(_val, bare_expr_type(matrix_type()))]; bare_dims_r.name( "array dimensions,\n" " e.g., empty (not an array) [] (1D array) or [,] (2D array)"); bare_dims_r %= eps[assign_lhs_f(_val, static_cast(0))] >> -(lit('[')[assign_lhs_f(_val, static_cast(1))] > *(lit(',')[increment_size_t_f(_val)]) > end_bare_types_r); end_bare_types_r.name( "comma to indicate more dimensions" " or ] to end type declaration"); end_bare_types_r %= lit(']'); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/block_var_decls_grammar_inst.cpp0000644000176200001440000000034513766554456027753 0ustar liggesusers#include #include namespace stan { namespace lang { template struct block_var_decls_grammar; } } // namespace stan StanHeaders/inst/include/src/stan/lang/grammars/expression07_grammar_def.hpp0000644000176200001440000000323213766554456026771 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_EXPRESSION07_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_EXPRESSION07_GRAMMAR_DEF_HPP // probably don't need to turn off warnings now, but if so, uncomment // #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { template expression07_grammar::expression07_grammar( variable_map& var_map, std::stringstream& error_msgs, expression_grammar& eg) : expression07_grammar::base_type(expression07_r), var_map_(var_map), error_msgs_(error_msgs), term_g(var_map, error_msgs, eg) { using boost::spirit::qi::_1; using boost::spirit::qi::_pass; using boost::spirit::qi::_val; using boost::spirit::qi::eps; using boost::spirit::qi::labels::_r1; using boost::spirit::qi::lit; expression07_r.name("expression"); expression07_r %= term_g(_r1)[assign_lhs_f(_val, _1)] > *((lit('+') > term_g(_r1)[addition3_f( _val, _1, boost::phoenix::ref(error_msgs))]) | (lit('-') > term_g(_r1)[subtraction3_f( _val, _1, boost::phoenix::ref(error_msgs))])) > eps[validate_expr_type3_f(_val, _pass, boost::phoenix::ref(error_msgs_))]; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/grammars/indexes_grammar_def.hpp0000644000176200001440000000572413766554456026072 0ustar liggesusers#ifndef STAN_LANG_GRAMMARS_INDEXES_GRAMMAR_DEF_HPP #define STAN_LANG_GRAMMARS_INDEXES_GRAMMAR_DEF_HPP #include #include #include #include #include #include BOOST_FUSION_ADAPT_STRUCT(stan::lang::uni_idx, (stan::lang::expression, idx_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::multi_idx, (stan::lang::expression, idxs_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::lb_idx, (stan::lang::expression, lb_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::ub_idx, (stan::lang::expression, ub_)) BOOST_FUSION_ADAPT_STRUCT(stan::lang::lub_idx, (stan::lang::expression, lb_)(stan::lang::expression, ub_)) namespace stan { namespace lang { template indexes_grammar::indexes_grammar(variable_map& var_map, std::stringstream& error_msgs, expression_grammar& eg) : indexes_grammar::base_type(indexes_r), var_map_(var_map), error_msgs_(error_msgs), expression_g(eg) { using boost::spirit::qi::_1; using boost::spirit::qi::_pass; using boost::spirit::qi::_r1; using boost::spirit::qi::_val; using boost::spirit::qi::eps; using boost::spirit::qi::lit; // _r1 var scope indexes_r.name("indexes (zero or more)"); indexes_r %= lit("[") >> (index_r(_r1) % ',') > close_indexes_r; close_indexes_r.name("one or more container indexes followed by ']'"); close_indexes_r %= lit(']'); // _r1 var scope index_r.name( "index expression, one of: " "(int, int[], int:, :int, int:int, :)"); index_r %= lub_index_r(_r1) | lb_index_r(_r1) | uni_index_r(_r1) | multi_index_r(_r1) | ub_index_r(_r1) | omni_index_r(_r1); // _r1 var scope lub_index_r.name("index expression int:int"); lub_index_r %= int_expression_r(_r1) >> lit(":") >> int_expression_r(_r1); // _r1 var scope lb_index_r.name("index expression int:"); lb_index_r %= int_expression_r(_r1) >> lit(":"); // _r1 var scope uni_index_r.name("index expression int"); uni_index_r %= int_expression_r(_r1); // _r1 var scope multi_index_r.name("index expression int[]"); multi_index_r %= expression_g(_r1)[validate_ints_expression_f( _1, _pass, boost::phoenix::ref(error_msgs_))]; // _r1 var scope ub_index_r.name("index expression :int"); ub_index_r %= lit(":") >> int_expression_r(_r1); // _r1 var scope omni_index_r.name("index expression :"); omni_index_r = lit(":")[set_omni_idx_f(_val)] | eps[set_omni_idx_f(_val)]; // _r1 var scope int_expression_r.name("integer expression"); int_expression_r %= expression_g(_r1)[validate_int_expr_silent_f(_1, _pass)]; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/0000755000176200001440000000000013766604372020335 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/ast/fun/0000755000176200001440000000000013766554456021134 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/ast/fun/block_type_bounds_vis.hpp0000644000176200001440000000670213766554456026240 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_BOUNDS_VIS_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_BOUNDS_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get bounds from block_var_type. */ struct block_type_bounds_vis : public boost::static_visitor { /** * Construct a visitor. */ block_type_bounds_vis(); /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const block_array_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const cholesky_factor_corr_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const cholesky_factor_cov_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const corr_matrix_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const cov_matrix_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const double_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const ill_formed_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const int_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const matrix_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const ordered_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const positive_ordered_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const row_vector_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const simplex_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const unit_vector_block_type& x) const; /** * Return bounds for this type. * * @param x type * @return bounds */ range operator()(const vector_block_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_is_data_vis.hpp0000644000176200001440000000405513766554456026170 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_IS_DATA_VIS_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_IS_DATA_VIS_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get data restriction status for bare type. */ struct bare_type_is_data_vis : public boost::static_visitor { /** * Construct a visitor. */ bare_type_is_data_vis(); /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const bare_array_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const double_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const ill_formed_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const int_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const matrix_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const row_vector_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const vector_type& x) const; /** * Return variable restriction status for this type. * * @param x type * @return is_data flag */ bool operator()(const void_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_set_is_data_vis_def.hpp0000644000176200001440000000203213766554456027652 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_SET_IS_DATA_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_SET_IS_DATA_VIS_DEF_HPP #include namespace stan { namespace lang { bare_type_set_is_data_vis::bare_type_set_is_data_vis() {} void bare_type_set_is_data_vis::operator()(bare_array_type& x) const { x.is_data_ = true; x.element_type_.set_is_data(); } void bare_type_set_is_data_vis::operator()(double_type& x) const { x.is_data_ = true; } void bare_type_set_is_data_vis::operator()(ill_formed_type& x) const { // do nothing } void bare_type_set_is_data_vis::operator()(int_type& x) const { x.is_data_ = true; } void bare_type_set_is_data_vis::operator()(matrix_type& x) const { x.is_data_ = true; } void bare_type_set_is_data_vis::operator()(row_vector_type& x) const { x.is_data_ = true; } void bare_type_set_is_data_vis::operator()(vector_type& x) const { x.is_data_ = true; } void bare_type_set_is_data_vis::operator()(void_type& x) const { // do nothing } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/generate_expression.hpp0000644000176200001440000000145213766554456025720 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GENERATE_EXPRESSION_HPP #define STAN_LANG_AST_FUN_GENERATE_EXPRESSION_HPP #include #include namespace stan { namespace lang { struct expression; /** * Write the code generated by the specified expression to the * specified output stream, putting it in a user-readable format * if the user-facing flag is true. This is just the header for a * forward declaration defined in the generator. * * @param[in] e expression to write * @param[in] user_facing true if expression should be written so * that a user can understand it * @param[in, out] o stream to which expression is written */ void generate_expression(const expression& e, bool user_facing, std::ostream& o); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/print_scope.hpp0000644000176200001440000000071013766554456024170 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_PRINT_SCOPE_HPP #define STAN_LANG_AST_FUN_PRINT_SCOPE_HPP #include #include namespace stan { namespace lang { /** * Write a user-readable version of the specified variable scope * to the specified output stream. * * @param o output stream * @param var_scope variable scope */ void print_scope(std::ostream& o, const scope& var_scope); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_params_total_vis_def.hpp0000644000176200001440000000563113766554456030252 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_PARAMS_TOTAL_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_PARAMS_TOTAL_VIS_DEF_HPP #include #include namespace stan { namespace lang { block_type_params_total_vis::block_type_params_total_vis() {} expression block_type_params_total_vis::operator()( const block_array_type& x) const { expression result = x.contains().params_total(); std::vector lens = x.array_lens(); for (size_t i = 0; i < lens.size(); ++i) { result = binary_op(result, "*", lens[i]); } return result; } expression block_type_params_total_vis::operator()( const cholesky_factor_corr_block_type& x) const { // (K * (K - 1)) / 2 int_literal one(1); int_literal two(2); return binary_op(binary_op(x.K_, "*", binary_op(x.K_, "-", one)), "/", two); } expression block_type_params_total_vis::operator()( const cholesky_factor_cov_block_type& x) const { // (N * (N + 1)) / 2 + (M - N) * N int_literal one(1); int_literal two(2); return binary_op( binary_op(binary_op(x.N_, "*", binary_op(x.N_, "+", one)), "/", two), "+", binary_op(binary_op(x.M_, "-", x.N_), "*", x.N_)); } expression block_type_params_total_vis::operator()( const corr_matrix_block_type& x) const { // (K * (K - 1)) / 2 int_literal one(1); int_literal two(2); return binary_op(binary_op(x.K_, "*", binary_op(x.K_, "-", one)), "/", two); } expression block_type_params_total_vis::operator()( const cov_matrix_block_type& x) const { // K + (K * (K - 1 ) / 2) int_literal one(1); int_literal two(2); return binary_op( x.K_, "+", binary_op(binary_op(x.K_, "*", binary_op(x.K_, "-", one)), "/", two)); } expression block_type_params_total_vis::operator()( const double_block_type& x) const { return int_literal(1); } expression block_type_params_total_vis::operator()( const ill_formed_type& x) const { return int_literal(0); } expression block_type_params_total_vis::operator()( const int_block_type& x) const { return int_literal(1); } expression block_type_params_total_vis::operator()( const matrix_block_type& x) const { return binary_op(x.M_, "*", x.N_); } expression block_type_params_total_vis::operator()( const ordered_block_type& x) const { return x.K_; } expression block_type_params_total_vis::operator()( const positive_ordered_block_type& x) const { return x.K_; } expression block_type_params_total_vis::operator()( const row_vector_block_type& x) const { return x.N_; } expression block_type_params_total_vis::operator()( const simplex_block_type& x) const { int_literal one(1); return binary_op(x.K_, "-", one); } expression block_type_params_total_vis::operator()( const unit_vector_block_type& x) const { return x.K_; } expression block_type_params_total_vis::operator()( const vector_block_type& x) const { return x.N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_rng_suffix_def.hpp0000644000176200001440000000063513766554456025474 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_RNG_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_HAS_RNG_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { bool has_rng_suffix(const std::string& s) { int n = s.size(); return n > 4 && s[n - 1] == 'g' && s[n - 2] == 'n' && s[n - 3] == 'r' && s[n - 4] == '_'; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/returns_type_vis_def.hpp0000644000176200001440000000763513766554456026122 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_RETURNS_TYPE_VIS_DEF_HPP #define STAN_LANG_AST_FUN_RETURNS_TYPE_VIS_DEF_HPP #include #include namespace stan { namespace lang { returns_type_vis::returns_type_vis(const bare_expr_type& return_type, std::ostream& error_msgs) : return_type_(return_type), error_msgs_(error_msgs) {} bool returns_type_vis::operator()(const nil& st) const { error_msgs_ << "Expecting return, found nil statement." << std::endl; return false; } bool returns_type_vis::operator()(const assgn& st) const { error_msgs_ << "Expecting return, found assignment statement." << std::endl; return false; } bool returns_type_vis::operator()(const sample& st) const { error_msgs_ << "Expecting return, found sampling statement." << std::endl; return false; } bool returns_type_vis::operator()(const increment_log_prob_statement& t) const { error_msgs_ << "Expecting return, found increment_log_prob statement." << std::endl; return false; } bool returns_type_vis::operator()(const expression& st) const { error_msgs_ << "Expecting return, found increment_log_prob statement." << std::endl; return false; } bool returns_type_vis::operator()(const print_statement& st) const { error_msgs_ << "Expecting return, found print statement." << std::endl; return false; } bool returns_type_vis::operator()(const reject_statement& st) const { error_msgs_ << "Expecting return, found reject statement." << std::endl; return false; } bool returns_type_vis::operator()(const no_op_statement& st) const { error_msgs_ << "Expecting return, found no_op statement." << std::endl; return false; } bool returns_type_vis::operator()(const statements& st) const { // last statement in sequence must return type if (st.statements_.size() == 0) { error_msgs_ << ("Expecting return, found" " statement sequence with empty body.") << std::endl; return false; } return returns_type(return_type_, st.statements_.back(), error_msgs_); } bool returns_type_vis::operator()(const for_statement& st) const { // body must end in appropriate return return returns_type(return_type_, st.statement_, error_msgs_); } bool returns_type_vis::operator()(const for_array_statement& st) const { // body must end in appropriate return return returns_type(return_type_, st.statement_, error_msgs_); } bool returns_type_vis::operator()(const for_matrix_statement& st) const { // body must end in appropriate return return returns_type(return_type_, st.statement_, error_msgs_); } bool returns_type_vis::operator()(const while_statement& st) const { // body must end in appropriate return return returns_type(return_type_, st.body_, error_msgs_); } bool returns_type_vis::operator()(const break_continue_statement& st) const { // break/continue OK only as end of nested loop in void return bool pass = (return_type_.is_void_type()); if (!pass) error_msgs_ << "statement " << st.generate_ << " does not match return type"; return pass; } bool returns_type_vis::operator()(const conditional_statement& st) const { // all condition bodies must end in appropriate return if (st.bodies_.size() != (st.conditions_.size() + 1)) { error_msgs_ << ("Expecting return, found conditional" " without final else.") << std::endl; return false; } for (size_t i = 0; i < st.bodies_.size(); ++i) if (!returns_type(return_type_, st.bodies_[i], error_msgs_)) return false; return true; } bool returns_type_vis::operator()(const return_statement& st) const { // return checked for type return return_type_.is_void_type() || is_assignable(return_type_, st.return_value_.bare_type(), "Returned expression does not match return type", error_msgs_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_idx_vis.hpp0000644000176200001440000000250113766554456024522 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_IDX_VIS_HPP #define STAN_LANG_AST_FUN_WRITE_IDX_VIS_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to format idx for parser error messages. */ struct write_idx_vis : public boost::static_visitor { /** * Construct a visitor. */ write_idx_vis(); /** * Return string representation for idx. */ std::string operator()(const lb_idx& idx) const; /** * Return string representation for idx. */ std::string operator()(const lub_idx& idx) const; /** * Return string representation for idx. */ std::string operator()(const multi_idx& idx) const; /** * Return string representation for idx. */ std::string operator()(const omni_idx& idx) const; /** * Return string representation for idx. */ std::string operator()(const ub_idx& idx) const; /** * Return string representation for idx. */ std::string operator()(const uni_idx& idx) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_prob_fun_suffix.hpp0000644000176200001440000000076513766554456025706 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_PROB_FUN_SUFFIX_HPP #define STAN_LANG_AST_FUN_HAS_PROB_FUN_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return true if the function with the specified name has a * suffix indicating it is a probability function. * * @param[in] name function name * @return true if function anme has a suffix indicating it is a * probability function */ bool has_prob_fun_suffix(const std::string& name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_lp_suffix.hpp0000644000176200001440000000053213766554456024477 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_LP_SUFFIX_HPP #define STAN_LANG_AST_FUN_HAS_LP_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return true if the specified string has the suffix * "_lp". * * @param[in] name function name */ bool has_lp_suffix(const std::string& name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_var_vis_def.hpp0000644000176200001440000000701213766554456024767 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_VAR_VIS_DEF_HPP #define STAN_LANG_AST_FUN_HAS_VAR_VIS_DEF_HPP #include #include namespace stan { namespace lang { has_var_vis::has_var_vis(const variable_map& var_map) : var_map_(var_map) {} bool has_var_vis::operator()(const nil& e) const { return false; } bool has_var_vis::operator()(const int_literal& e) const { return false; } bool has_var_vis::operator()(const double_literal& e) const { return false; } bool has_var_vis::operator()(const array_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_var_vis::operator()(const matrix_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_var_vis::operator()(const row_vector_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_var_vis::operator()(const variable& e) const { scope var_scope = var_map_.get_scope(e.name_); return var_scope.par_or_tpar() || (var_scope.local_allows_var() && !(e.type_.innermost_type().is_int_type())); } bool has_var_vis::operator()(const fun& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_var_vis::operator()(const integrate_1d& e) const { // only init state and params may contain vars return boost::apply_visitor(*this, e.lb_.expr_) || boost::apply_visitor(*this, e.ub_.expr_) || boost::apply_visitor(*this, e.theta_.expr_); } bool has_var_vis::operator()(const integrate_ode& e) const { // only init state and params may contain vars return boost::apply_visitor(*this, e.y0_.expr_) || boost::apply_visitor(*this, e.theta_.expr_); } bool has_var_vis::operator()(const integrate_ode_control& e) const { // only init state and params may contain vars return boost::apply_visitor(*this, e.y0_.expr_) || boost::apply_visitor(*this, e.theta_.expr_); } bool has_var_vis::operator()(const algebra_solver& e) const { // only theta may contain vars return boost::apply_visitor(*this, e.theta_.expr_); } bool has_var_vis::operator()(const algebra_solver_control& e) const { // only theta may contain vars return boost::apply_visitor(*this, e.theta_.expr_); } bool has_var_vis::operator()(const map_rect& e) const { // only shared and job params may contain vars return boost::apply_visitor(*this, e.shared_params_.expr_) || boost::apply_visitor(*this, e.job_params_.expr_); } bool has_var_vis::operator()(const index_op& e) const { return boost::apply_visitor(*this, e.expr_.expr_); } bool has_var_vis::operator()(const index_op_sliced& e) const { return boost::apply_visitor(*this, e.expr_.expr_); } bool has_var_vis::operator()(const conditional_op& e) const { return boost::apply_visitor(*this, e.cond_.expr_) || boost::apply_visitor(*this, e.true_val_.expr_) || boost::apply_visitor(*this, e.false_val_.expr_); } bool has_var_vis::operator()(const binary_op& e) const { return boost::apply_visitor(*this, e.left.expr_) || boost::apply_visitor(*this, e.right.expr_); } bool has_var_vis::operator()(const unary_op& e) const { return boost::apply_visitor(*this, e.subject.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_multi_index.hpp0000644000176200001440000000063113766554456024661 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_MULTI_INDEX_HPP #define STAN_LANG_AST_FUN_IS_MULTI_INDEX_HPP #include namespace stan { namespace lang { /** * Return true if the specified index potentially takes more than * one value. * * @param idx index * @return true if index is not a unary index */ bool is_multi_index(const idx& idx); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/get_ccdf.hpp0000644000176200001440000000056713766554456023413 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GET_CCDF_HPP #define STAN_LANG_AST_FUN_GET_CCDF_HPP #include namespace stan { namespace lang { /** * Return the CCDF for the specified distribution. * * @param[in] dist_name name of distribution * @return CCDF for distribution */ std::string get_ccdf(const std::string& dist_name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_total_dims_vis_def.hpp0000644000176200001440000000176413766554456027545 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_TOTAL_DIMS_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_TOTAL_DIMS_VIS_DEF_HPP #include namespace stan { namespace lang { bare_type_total_dims_vis::bare_type_total_dims_vis() {} int bare_type_total_dims_vis::operator()(const bare_array_type& x) const { return x.dims() + x.contains().num_dims(); } int bare_type_total_dims_vis::operator()(const double_type& x) const { return 0; } int bare_type_total_dims_vis::operator()(const ill_formed_type& x) const { return 0; } int bare_type_total_dims_vis::operator()(const int_type& x) const { return 0; } int bare_type_total_dims_vis::operator()(const matrix_type& x) const { return 2; } int bare_type_total_dims_vis::operator()(const row_vector_type& x) const { return 1; } int bare_type_total_dims_vis::operator()(const vector_type& x) const { return 1; } int bare_type_total_dims_vis::operator()(const void_type& x) const { return 0; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_idx_vis_def.hpp0000644000176200001440000000204013766554456025336 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_IDX_VIS_DEF_HPP #define STAN_LANG_AST_FUN_WRITE_IDX_VIS_DEF_HPP #include #include #include namespace stan { namespace lang { write_idx_vis::write_idx_vis() {} std::string write_idx_vis::operator()(const lb_idx& idx) const { std::stringstream ss; ss << idx.lb_.to_string(); ss << ":"; return ss.str(); } std::string write_idx_vis::operator()(const lub_idx& idx) const { std::stringstream ss; ss << idx.lb_.to_string(); ss << ":"; ss << idx.ub_.to_string(); return ss.str(); } std::string write_idx_vis::operator()(const multi_idx& idx) const { return idx.idxs_.to_string(); } std::string write_idx_vis::operator()(const omni_idx& idx) const { return ":"; } std::string write_idx_vis::operator()(const ub_idx& idx) const { std::stringstream ss; ss << ":"; ss << idx.ub_.to_string(); return ss.str(); } std::string write_idx_vis::operator()(const uni_idx& idx) const { return idx.idx_.to_string(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_bounds_vis_def.hpp0000644000176200001440000000341713766554456027056 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_BOUNDS_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_BOUNDS_VIS_DEF_HPP #include namespace stan { namespace lang { block_type_bounds_vis::block_type_bounds_vis() {} range block_type_bounds_vis::operator()(const block_array_type& x) const { return range(); } range block_type_bounds_vis::operator()( const cholesky_factor_corr_block_type& x) const { return range(); } range block_type_bounds_vis::operator()( const cholesky_factor_cov_block_type& x) const { return range(); } range block_type_bounds_vis::operator()(const corr_matrix_block_type& x) const { return range(); } range block_type_bounds_vis::operator()(const cov_matrix_block_type& x) const { return range(); } range block_type_bounds_vis::operator()(const double_block_type& x) const { return x.bounds_; } range block_type_bounds_vis::operator()(const ill_formed_type& x) const { return range(); } range block_type_bounds_vis::operator()(const int_block_type& x) const { return x.bounds_; } range block_type_bounds_vis::operator()(const matrix_block_type& x) const { return x.bounds_; } range block_type_bounds_vis::operator()(const ordered_block_type& x) const { return range(); } range block_type_bounds_vis::operator()( const positive_ordered_block_type& x) const { return range(); } range block_type_bounds_vis::operator()(const row_vector_block_type& x) const { return x.bounds_; } range block_type_bounds_vis::operator()(const simplex_block_type& x) const { return range(); } range block_type_bounds_vis::operator()(const unit_vector_block_type& x) const { return range(); } range block_type_bounds_vis::operator()(const vector_block_type& x) const { return x.bounds_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/indexed_type_def.hpp0000644000176200001440000000511713766554456025150 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_INDEXED_TYPE_DEF_HPP #define STAN_LANG_AST_FUN_INDEXED_TYPE_DEF_HPP #include #include #include namespace stan { namespace lang { /* * indexed_type * * check each member of vector idxs * multi-idx doesn't change indexed type * uni-idx on array type reduces number of array dimensions * uni-idx on vector/row vector reduces to double * 2 uni-idxs on matrix reduces to double * 1 uni-idx + 1 multi-idx on matrix reduces to * vector or row_vector depending on position * */ bare_expr_type indexed_type(const expression& e, const std::vector& idxs) { // check idxs size, although parser should disallow this if (idxs.size() == 0) return e.bare_type(); // cannot have more indexes than there are dimensions, even if they're multi int idx_sz = idxs.size(); if (idx_sz > e.bare_type().num_dims()) return ill_formed_type(); // indexing starts with array dims 1 ... N int i = 0; int max_array_dims = e.bare_type().array_dims(); int array_dims = max_array_dims; for (; i < max_array_dims && i < idx_sz; ++i) { if (!is_multi_index(idxs[i])) array_dims--; } if (i == idx_sz && array_dims == 0) return e.bare_type().innermost_type(); if (i == idx_sz) return bare_array_type(e.bare_type().innermost_type(), array_dims); // index into vector/matrix size_t num_args = e.bare_type().num_dims() - e.bare_type().array_dims(); std::vector arg_slots(num_args, 0); for (size_t j = 0; j < arg_slots.size() && i < idx_sz; ++i, ++j) { if (!is_multi_index(idxs[i])) arg_slots[j] = 1; } // innermost type is vector/row_vector if (arg_slots.size() == 1 && arg_slots[0] == 1) { if (array_dims > 0) return bare_array_type(double_type(), array_dims); return double_type(); } if (arg_slots.size() == 1) { if (array_dims > 0) return bare_array_type(e.bare_type().innermost_type(), array_dims); return e.bare_type().innermost_type(); } // innermost type is matrix if (arg_slots[0] == 1 && arg_slots[1] == 1) { if (array_dims > 0) return bare_array_type(double_type(), array_dims); return double_type(); } if (arg_slots[0] == 1) { if (array_dims > 0) return bare_array_type(row_vector_type(), array_dims); return row_vector_type(); } if (arg_slots[1] == 1) { if (array_dims > 0) return bare_array_type(vector_type(), array_dims); return vector_type(); } if (array_dims > 0) return bare_array_type(matrix_type(), array_dims); return matrix_type(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_non_param_var.hpp0000644000176200001440000000164713766554456025332 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_HPP #define STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_HPP namespace stan { namespace lang { struct expression; struct variable_map; /** * Returns true if the specified expression contains a variable * that requires a Jacobian warning. This is either a transformed * variable or a local variable or a non-linear function of a * parameter. * *

Compare to has_var, which is similar, but * just tests for inclusion of variables declared in the * parameters, transformed parameters, or model block. * * @param e Expression to test. * @param var_map Variable mapping for origin and types of * variables. * @return true if expression contains a variable defined as a * transformed parameter, or is a local variable that is not * an integer. */ bool has_non_param_var(const expression& e, const variable_map& var_map); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/strip_cdf_suffix.hpp0000644000176200001440000000072013766554456025205 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_STRIP_CDF_SUFFIX_HPP #define STAN_LANG_AST_FUN_STRIP_CDF_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return the result of removing the suffix from the specified * function name indicating it is a CDF. * * @param[in] dist_fun name of function * @return result of removing suffix from function */ std::string strip_cdf_suffix(const std::string& dist_fun); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_no_op_statement_vis_def.hpp0000644000176200001440000000330713766554456027240 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NO_OP_STATEMENT_VIS_DEF_HPP #define STAN_LANG_AST_FUN_IS_NO_OP_STATEMENT_VIS_DEF_HPP #include namespace stan { namespace lang { bool is_no_op_statement_vis::operator()(const nil& st) const { return false; } bool is_no_op_statement_vis::operator()(const assgn& st) const { return false; } bool is_no_op_statement_vis::operator()(const sample& st) const { return false; } bool is_no_op_statement_vis::operator()( const increment_log_prob_statement& t) const { return false; } bool is_no_op_statement_vis::operator()(const expression& st) const { return false; } bool is_no_op_statement_vis::operator()(const statements& st) const { return false; } bool is_no_op_statement_vis::operator()(const for_statement& st) const { return false; } bool is_no_op_statement_vis ::operator()(const for_array_statement& st) const { return false; } bool is_no_op_statement_vis ::operator()(const for_matrix_statement& st) const { return false; } bool is_no_op_statement_vis::operator()(const conditional_statement& st) const { return false; } bool is_no_op_statement_vis::operator()(const while_statement& st) const { return false; } bool is_no_op_statement_vis::operator()( const break_continue_statement& st) const { return false; } bool is_no_op_statement_vis::operator()(const print_statement& st) const { return false; } bool is_no_op_statement_vis::operator()(const reject_statement& st) const { return false; } bool is_no_op_statement_vis::operator()(const no_op_statement& st) const { return true; } bool is_no_op_statement_vis::operator()(const return_statement& st) const { return false; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_expression_vis.hpp0000644000176200001440000000700613766554456026142 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_EXPRESSION_VIS_HPP #define STAN_LANG_AST_FUN_WRITE_EXPRESSION_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to format expression for parser error messages. */ struct write_expression_vis : public boost::static_visitor { /** * Construct a visitor. */ write_expression_vis(); /** * Return string representation for expression. */ std::string operator()(const nil& e) const; /** * Return string representation for expression. */ std::string operator()(const int_literal& e) const; /** * Return string representation for expression. */ std::string operator()(const double_literal& e) const; /** * Return string representation for expression. */ std::string operator()(const array_expr& e) const; /** * Return string representation for expression. */ std::string operator()(const matrix_expr& e) const; /** * Return string representation for expression. */ std::string operator()(const row_vector_expr& e) const; /** * Return string representation for expression. */ std::string operator()(const variable& e) const; /** * Return string representation for expression. */ std::string operator()(const fun& e) const; /** * Return string representation for expression. */ std::string operator()(const integrate_1d& e) const; /** * Return string representation for expression. */ std::string operator()(const integrate_ode& e) const; /** * Return string representation for expression. */ std::string operator()(const integrate_ode_control& e) const; /** * Return string representation for expression. */ std::string operator()(const algebra_solver& e) const; /** * Return string representation for expression. */ std::string operator()(const algebra_solver_control& e) const; /** * Return string representation for expression. */ std::string operator()(const map_rect& e) const; /** * Return string representation for expression. */ std::string operator()(const index_op& e) const; /** * Return string representation for expression. */ std::string operator()(const index_op_sliced& e) const; /** * Return string representation for expression. */ std::string operator()(const conditional_op& e) const; /** * Return string representation for expression. */ std::string operator()(const binary_op& e) const; /** * Return string representation for expression. */ std::string operator()(const unary_op& e) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/strip_ccdf_suffix_def.hpp0000644000176200001440000000077113766554456026174 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_STRIP_CCDF_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_STRIP_CCDF_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { std::string strip_ccdf_suffix(const std::string& fname) { if (ends_with("_lccdf", fname)) return fname.substr(0, fname.size() - 6); else if (ends_with("_ccdf_log", fname)) return fname.substr(0, fname.size() - 9); else return fname; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_user_defined_prob_function_def.hpp0000644000176200001440000000126513766554456030545 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_USER_DEFINED_PROB_FUNCTION_DEF_HPP #define STAN_LANG_AST_FUN_IS_USER_DEFINED_PROB_FUNCTION_DEF_HPP #include #include #include namespace stan { namespace lang { bool is_user_defined_prob_function(const std::string& name, const expression& variate, const std::vector& params) { std::vector variate_params; variate_params.push_back(variate); for (size_t i = 0; i < params.size(); ++i) variate_params.push_back(params[i]); return is_user_defined(name, variate_params); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_non_param_var_vis_def.hpp0000644000176200001440000001176613766554456027034 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_VIS_DEF_HPP #define STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_VIS_DEF_HPP #include #include #include namespace stan { namespace lang { bool is_linear_function(const std::string& name) { return name == "add" || name == "block" || name == "append_col" || name == "col" || name == "cols" || name == "diagonal" || name == "head" || name == "minus" || name == "negative_infinity" || name == "not_a_number" || name == "append_row" || name == "rep_matrix" || name == "rep_row_vector" || name == "rep_vector" || name == "row" || name == "rows" || name == "positive_infinity" || name == "segment" || name == "subtract" || name == "sum" || name == "tail" || name == "to_vector" || name == "to_row_vector" || name == "to_matrix" || name == "to_array_1d" || name == "to_array_2d" || name == "transpose"; } has_non_param_var_vis::has_non_param_var_vis(const variable_map& var_map) : var_map_(var_map) {} bool has_non_param_var_vis::operator()(const nil& e) const { return false; } bool has_non_param_var_vis::operator()(const int_literal& e) const { return false; } bool has_non_param_var_vis::operator()(const double_literal& e) const { return false; } bool has_non_param_var_vis::operator()(const array_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_non_param_var_vis::operator()(const matrix_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_non_param_var_vis::operator()(const row_vector_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool has_non_param_var_vis::operator()(const variable& e) const { scope var_scope = var_map_.get_scope(e.name_); return var_scope.tpar(); } bool has_non_param_var_vis::operator()(const integrate_1d& e) const { // if any vars, return true because integration will be nonlinear return boost::apply_visitor(*this, e.lb_.expr_) || boost::apply_visitor(*this, e.ub_.expr_) || boost::apply_visitor(*this, e.theta_.expr_); } bool has_non_param_var_vis::operator()(const integrate_ode& e) const { // if any vars, return true because integration will be nonlinear return boost::apply_visitor(*this, e.y0_.expr_) || boost::apply_visitor(*this, e.theta_.expr_); } bool has_non_param_var_vis::operator()(const integrate_ode_control& e) const { // if any vars, return true because integration will be nonlinear return boost::apply_visitor(*this, e.y0_.expr_) || boost::apply_visitor(*this, e.theta_.expr_); } bool has_non_param_var_vis::operator()(const algebra_solver& e) const { // if any vars, return true -- CHECK: nonlinearity? return boost::apply_visitor(*this, e.y_.expr_); } bool has_non_param_var_vis::operator()(const algebra_solver_control& e) const { // if any vars, return true return boost::apply_visitor(*this, e.y_.expr_); } bool has_non_param_var_vis::operator()(const map_rect& e) const { // if any vars, return true return boost::apply_visitor(*this, e.shared_params_.expr_) || boost::apply_visitor(*this, e.job_params_.expr_); } bool has_non_param_var_vis::operator()(const fun& e) const { // any function applied to non-linearly transformed var for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; // non-linear function applied to var if (!is_linear_function(e.name_)) { for (size_t i = 0; i < e.args_.size(); ++i) if (has_var(e.args_[i], var_map_)) return true; } return false; } bool has_non_param_var_vis::operator()(const index_op& e) const { return boost::apply_visitor(*this, e.expr_.expr_); } bool has_non_param_var_vis::operator()(const index_op_sliced& e) const { return boost::apply_visitor(*this, e.expr_.expr_); } bool has_non_param_var_vis::operator()(const conditional_op& e) const { if (has_non_param_var(e.cond_, var_map_) || has_non_param_var(e.true_val_, var_map_) || has_non_param_var(e.false_val_, var_map_)) return true; return false; } bool has_non_param_var_vis::operator()(const binary_op& e) const { if (e.op == "||" || e.op == "&&" || e.op == "==" || e.op == "!=" || e.op == "<" || e.op == "<=" || e.op == ">" || e.op == ">=") return true; if (has_non_param_var(e.left, var_map_) || has_non_param_var(e.right, var_map_)) return true; if (e.op == "*" || e.op == "/") return has_var(e.left, var_map_) && has_var(e.right, var_map_); return false; } bool has_non_param_var_vis::operator()(const unary_op& e) const { // only negation, which is linear, so recurse return has_non_param_var(e.subject, var_map_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/get_prob_fun_def.hpp0000644000176200001440000000116013766554456025132 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GET_PROB_FUN_DEF_HPP #define STAN_LANG_AST_FUN_GET_PROB_FUN_DEF_HPP #include #include namespace stan { namespace lang { std::string get_prob_fun(const std::string& dist_name) { if (function_signatures::instance().has_key(dist_name + "_log")) return dist_name + "_log"; else if (function_signatures::instance().has_key(dist_name + "_lpdf")) return dist_name + "_lpdf"; else if (function_signatures::instance().has_key(dist_name + "_lpmf")) return dist_name + "_lpmf"; else return dist_name; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_ccdf_suffix.hpp0000644000176200001440000000067213766554456024770 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_CCDF_SUFFIX_HPP #define STAN_LANG_AST_FUN_HAS_CCDF_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return true if the specified function name has a suffix * indicating it is a CCDF. * * @param[in] name of function * @return true if the function has a suffix indicating it is a CCDF */ bool has_ccdf_suffix(const std::string& name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_multi_index_vis.hpp0000644000176200001440000000244613766554456025550 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_MULTI_INDEX_VIS_HPP #define STAN_LANG_AST_FUN_IS_MULTI_INDEX_VIS_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor for callback to determine if an index is a multiple * index or a single index. */ struct is_multi_index_vis : public boost::static_visitor { /** * Construct a multi-index visitor. */ is_multi_index_vis(); /** * Return false. * * @param i index */ bool operator()(const uni_idx& i) const; /** * Return true. * * @param i index */ bool operator()(const multi_idx& i) const; /** * Return true. * * @param i index */ bool operator()(const omni_idx& i) const; /** * Return true. * * @param i index */ bool operator()(const lb_idx& i) const; /** * Return true. * * @param i index */ bool operator()(const ub_idx& i) const; /** * Return true. * * @param i index */ bool operator()(const lub_idx& i) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_order_id_vis.hpp0000644000176200001440000000203013766554456026342 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_ORDER_ID_VIS_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_ORDER_ID_VIS_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get a string which describes type wrapped by variant * bare_expr_type. Ordering is ill-formed < void < primitive < vector < matrix < * array. Array type ids constructed recursively. */ struct bare_type_order_id_vis : public boost::static_visitor { /** * Construct a visitor. */ bare_type_order_id_vis(); template std::string operator()(const T& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_type_arg1_vis_def.hpp0000644000176200001440000000455213766554456026115 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_TYPE_ARG1_VIS_DEF_HPP #define STAN_LANG_AST_FUN_VAR_TYPE_ARG1_VIS_DEF_HPP #include namespace stan { namespace lang { var_type_arg1_vis::var_type_arg1_vis() {} expression var_type_arg1_vis::operator()(const block_array_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()(const local_array_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()( const cholesky_factor_corr_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()( const cholesky_factor_cov_block_type& x) const { return x.M_; } expression var_type_arg1_vis::operator()( const corr_matrix_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()(const cov_matrix_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()(const double_block_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()(const double_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()(const ill_formed_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()(const int_block_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()(const int_type& x) const { return expression(nil()); } expression var_type_arg1_vis::operator()(const matrix_block_type& x) const { return x.M_; } expression var_type_arg1_vis::operator()(const matrix_local_type& x) const { return x.M_; } expression var_type_arg1_vis::operator()(const ordered_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()( const positive_ordered_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()(const row_vector_block_type& x) const { return x.N_; } expression var_type_arg1_vis::operator()(const row_vector_local_type& x) const { return x.N_; } expression var_type_arg1_vis::operator()(const simplex_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()( const unit_vector_block_type& x) const { return x.K_; } expression var_type_arg1_vis::operator()(const vector_block_type& x) const { return x.N_; } expression var_type_arg1_vis::operator()(const vector_local_type& x) const { return x.N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_rng_suffix.hpp0000644000176200001440000000053613766554456024656 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_RNG_SUFFIX_HPP #define STAN_LANG_AST_FUN_HAS_RNG_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return true if the specified string has the suffix * "_rng". * * @param[in] name function name */ bool has_rng_suffix(const std::string& name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_nonempty.hpp0000644000176200001440000000064713766554456024220 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NONEMPTY_HPP #define STAN_LANG_AST_FUN_IS_NONEMPTY_HPP #include namespace stan { namespace lang { /** * Returns true if the specified string contains a character other * than a whitespace character. * * @param s string to test * @return true if string contains a non-space character */ bool is_nonempty(const std::string& s); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_user_defined.hpp0000644000176200001440000000140513766554456024774 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_USER_DEFINED_HPP #define STAN_LANG_AST_FUN_IS_USER_DEFINED_HPP #include #include namespace stan { namespace lang { struct expression; struct fun; /** * Return true if the specified function was declared in the * functions block. * * @param[in] fx function with arguments */ bool is_user_defined(const fun& fx); /** * Return true if a function with the specified name and arguments * was defined in the functions block. * * @param[in] name function name * @param[in] args function arguments * @return true if function is defined in the functions block */ bool is_user_defined(const std::string& name, const std::vector& args); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_nil_vis.hpp0000644000176200001440000000341413766554456024005 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NIL_VIS_HPP #define STAN_LANG_AST_FUN_IS_NIL_VIS_HPP #include namespace stan { namespace lang { struct nil; struct int_literal; struct double_literal; struct array_expr; struct matrix_expr; struct row_vector_expr; struct variable; struct fun; struct integrate_1d; struct integrate_ode; struct integrate_ode_control; struct algebra_solver; struct algebra_solver_control; struct map_rect; struct index_op; struct index_op_sliced; struct conditional_op; struct binary_op; struct unary_op; /** * Callback functor for determining if one of the variant types * making up an expression is nil. */ struct is_nil_vis : public boost::static_visitor { bool operator()(const nil& x) const; bool operator()(const int_literal& x) const; bool operator()(const double_literal& x) const; bool operator()(const array_expr& x) const; bool operator()(const matrix_expr& x) const; bool operator()(const row_vector_expr& x) const; bool operator()(const variable& x) const; bool operator()(const fun& x) const; bool operator()(const integrate_1d& x) const; bool operator()(const integrate_ode& x) const; bool operator()(const integrate_ode_control& x) const; bool operator()(const algebra_solver& x) const; bool operator()(const algebra_solver_control& x) const; bool operator()(const map_rect& x) const; bool operator()(const index_op& x) const; // NOLINT(runtime/explicit) bool operator()(const index_op_sliced& x) const; // NOLINT bool operator()(const conditional_op& x) const; // NOLINT bool operator()(const binary_op& x) const; // NOLINT(runtime/explicit) bool operator()(const unary_op& x) const; // NOLINT(runtime/explicit) }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_expression_vis_def.hpp0000644000176200001440000001271613766554456026764 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_EXPRESSION_VIS_DEF_HPP #define STAN_LANG_AST_FUN_WRITE_EXPRESSION_VIS_DEF_HPP #include #include #include #include #include namespace stan { namespace lang { write_expression_vis::write_expression_vis() {} std::string write_expression_vis::operator()(const nil& st) const { return "nil"; } std::string write_expression_vis::operator()(const int_literal& e) const { return boost::lexical_cast(e.val_); } std::string write_expression_vis::operator()(const double_literal& e) const { return e.string_; } std::string write_expression_vis::operator()(const array_expr& e) const { std::stringstream ss; ss << "{ "; for (size_t i = 0; i < e.args_.size(); ++i) { if (i > 0) ss << ", "; ss << e.args_[i].to_string(); } ss << " }"; return ss.str(); } std::string write_expression_vis::operator()(const matrix_expr& e) const { std::stringstream ss; ss << "[ "; for (size_t i = 0; i < e.args_.size(); ++i) { if (i > 0) ss << ", "; ss << e.args_[i].to_string(); } ss << " ]"; return ss.str(); } std::string write_expression_vis::operator()(const row_vector_expr& e) const { std::stringstream ss; ss << "[ "; for (size_t i = 0; i < e.args_.size(); ++i) { if (i > 0) ss << ", "; ss << e.args_[i].to_string(); } ss << " ]"; return ss.str(); } std::string write_expression_vis::operator()(const variable& e) const { return e.name_; } std::string write_expression_vis::operator()(const fun& e) const { std::stringstream ss; if (e.original_name_.size() > 0) ss << e.original_name_; else ss << e.name_; ss << "("; for (size_t i = 0; i < e.args_.size(); ++i) { if (i > 0) ss << ", "; ss << e.args_[i].to_string(); } ss << ")"; return ss.str(); } std::string write_expression_vis::operator()(const integrate_1d& e) const { std::stringstream ss; ss << e.function_name_ << "(" << e.lb_.to_string() << ", " << e.ub_.to_string() << ", " << e.theta_.to_string() << ", " << e.x_r_.to_string() << ", " << e.x_i_.to_string() << ", " << e.rel_tol_.to_string() << ")"; return ss.str(); } std::string write_expression_vis::operator()(const integrate_ode& e) const { std::stringstream ss; ss << e.integration_function_name_ << "(" << e.system_function_name_ << ", " << e.y0_.to_string() << ", " << e.t0_.to_string() << ", " << e.ts_.to_string() << ", " << e.x_.to_string() << ", " << e.x_int_.to_string() << ")"; return ss.str(); } std::string write_expression_vis::operator()( const integrate_ode_control& e) const { std::stringstream ss; ss << e.integration_function_name_ << "(" << e.system_function_name_ << ", " << e.y0_.to_string() << ", " << e.t0_.to_string() << ", " << e.ts_.to_string() << ", " << e.x_.to_string() << ", " << e.x_int_.to_string() << ", " << e.rel_tol_.to_string() << ", " << e.abs_tol_.to_string() << ", " << e.max_num_steps_.to_string() << ")"; return ss.str(); } std::string write_expression_vis::operator()(const algebra_solver& e) const { std::stringstream ss; ss << e.system_function_name_ << ", " << e.y_.to_string() << ", " << e.theta_.to_string() << ", " << e.x_r_.to_string() << ", " << e.x_i_.to_string() << ")"; return ss.str(); } std::string write_expression_vis::operator()( const algebra_solver_control& e) const { std::stringstream ss; ss << e.system_function_name_ << ", " << e.y_.to_string() << ", " << e.theta_.to_string() << ", " << e.x_r_.to_string() << ", " << e.x_i_.to_string() << ", " << e.rel_tol_.to_string() << ", " << e.fun_tol_.to_string() << ", " << e.max_num_steps_.to_string() << ")"; return ss.str(); } std::string write_expression_vis::operator()(const map_rect& e) const { std::stringstream ss; ss << e.call_id_ << ", " << e.fun_name_ << ", " << e.shared_params_.to_string() << ", " << e.job_params_.to_string() << ", " << e.job_data_r_.to_string() << ", " << e.job_data_i_.to_string() << ")"; return ss.str(); } std::string write_expression_vis::operator()(const index_op& e) const { std::stringstream ss; ss << e.expr_.to_string() << "["; for (size_t i = 0; i < e.dimss_.size(); ++i) { if (i > 0) ss << ", "; if (e.dimss_[i].size() == 1) { ss << e.dimss_[i][0].to_string(); } else { ss << "["; for (size_t j = 0; j < e.dimss_[i].size(); ++j) { if (j > 0) ss << ", "; ss << e.dimss_[i][j].to_string(); } ss << "]"; } } ss << "]"; return ss.str(); } std::string write_expression_vis::operator()(const index_op_sliced& e) const { std::stringstream ss; ss << e.expr_.to_string() << "["; for (size_t i = 0; i < e.idxs_.size(); ++i) { if (i > 0) ss << ", "; ss << e.idxs_[i].to_string(); } ss << "]"; return ss.str(); } std::string write_expression_vis::operator()(const conditional_op& e) const { std::stringstream ss; ss << e.cond_.to_string() << " ? " << e.true_val_.to_string() << " : " << e.false_val_.to_string(); return ss.str(); } std::string write_expression_vis::operator()(const binary_op& e) const { std::stringstream ss; ss << e.left.to_string() << " " << e.op << " " << e.right.to_string(); return ss.str(); } std::string write_expression_vis::operator()(const unary_op& e) const { std::stringstream ss; ss << e.op << e.subject.to_string(); return ss.str(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/strip_cdf_suffix_def.hpp0000644000176200001440000000076413766554456026033 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_STRIP_CDF_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_STRIP_CDF_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { std::string strip_cdf_suffix(const std::string& fname) { if (ends_with("_lcdf", fname)) return fname.substr(0, fname.size() - 5); else if (ends_with("_cdf_log", fname)) return fname.substr(0, fname.size() - 8); else return fname; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_is_data_vis_def.hpp0000644000176200001440000000200513766554456026777 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_IS_DATA_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_IS_DATA_VIS_DEF_HPP #include namespace stan { namespace lang { bare_type_is_data_vis::bare_type_is_data_vis() {} bool bare_type_is_data_vis::operator()(const bare_array_type& x) const { return x.contains().is_data(); } bool bare_type_is_data_vis::operator()(const double_type& x) const { return x.is_data_; } bool bare_type_is_data_vis::operator()(const ill_formed_type& x) const { return false; } bool bare_type_is_data_vis::operator()(const int_type& x) const { return x.is_data_; } bool bare_type_is_data_vis::operator()(const matrix_type& x) const { return x.is_data_; } bool bare_type_is_data_vis::operator()(const row_vector_type& x) const { return x.is_data_; } bool bare_type_is_data_vis::operator()(const vector_type& x) const { return x.is_data_; } bool bare_type_is_data_vis::operator()(const void_type& x) const { return false; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_no_op_statement_vis.hpp0000644000176200001440000000706113766554456026423 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NO_OP_STATEMENT_VIS_HPP #define STAN_LANG_AST_FUN_IS_NO_OP_STATEMENT_VIS_HPP #include namespace stan { namespace lang { struct nil; struct assgn; struct sample; struct increment_log_prob_statement; struct expression; struct statements; struct for_statement; struct for_array_statement; struct for_matrix_statement; struct conditional_statement; struct while_statement; struct break_continue_statement; struct print_statement; struct reject_statement; struct no_op_statement; struct return_statement; /** * Visitor to determine if a statement is a no-op statement. */ struct is_no_op_statement_vis : public boost::static_visitor { /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const nil& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const assgn& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const sample& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const increment_log_prob_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const expression& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const statements& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const for_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const for_array_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const for_matrix_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const conditional_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const while_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const break_continue_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const print_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const reject_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return true */ bool operator()(const no_op_statement& st) const; /** * Return true if the specified statement is a no-op statement. * * @param st statement * @return false */ bool operator()(const return_statement& st) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_user_defined_def.hpp0000644000176200001440000000160213766554456025611 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_USER_DEFINED_DEF_HPP #define STAN_LANG_AST_FUN_IS_USER_DEFINED_DEF_HPP #include #include #include #include namespace stan { namespace lang { bool is_user_defined(const fun& fx) { return is_user_defined(fx.name_, fx.args_); } bool is_user_defined(const std::string& name, const std::vector& args) { std::vector arg_types; for (size_t i = 0; i < args.size(); ++i) arg_types.push_back(args[i].bare_type()); function_signature_t sig; int matches = function_signatures::instance().get_signature_matches( name, arg_types, sig); if (matches != 1) return false; std::pair name_sig(name, sig); return function_signatures::instance().is_user_defined(name_sig); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/returns_type_def.hpp0000644000176200001440000000105713766554456025231 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_RETURNS_TYPE_DEF_HPP #define STAN_LANG_AST_FUN_RETURNS_TYPE_DEF_HPP #include #include #include namespace stan { namespace lang { bool returns_type(const bare_expr_type& return_type, const statement& statement, std::ostream& error_msgs) { if (return_type.is_void_type()) return true; returns_type_vis vis(return_type, error_msgs); return boost::apply_visitor(vis, statement.statement_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/expression_bare_type_vis.hpp0000644000176200001440000001075313766554456026765 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_EXPRESSION_BARE_TYPE_VIS_HPP #define STAN_LANG_AST_FUN_EXPRESSION_BARE_TYPE_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { struct expression_bare_type_vis : public boost::static_visitor { /** * Construct a visitor. */ expression_bare_type_vis(); /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const nil& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const int_literal& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const double_literal& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const array_expr& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const matrix_expr& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const row_vector_expr& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const variable& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const fun& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const integrate_1d& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const integrate_ode& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const integrate_ode_control& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const algebra_solver& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const algebra_solver_control& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const map_rect& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const index_op& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const index_op_sliced& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const conditional_op& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const binary_op& e) const; /** * Return the bare_expr_type corresponding to this expression * * @return bare expression type */ bare_expr_type operator()(const unary_op& e) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/expression_bare_type_vis_def.hpp0000644000176200001440000000456713766554456027611 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_EXPRESSION_BARE_TYPE_VIS_DEF_HPP #define STAN_LANG_AST_FUN_EXPRESSION_BARE_TYPE_VIS_DEF_HPP #include namespace stan { namespace lang { expression_bare_type_vis::expression_bare_type_vis() {} bare_expr_type expression_bare_type_vis::operator()(const nil& st) const { return ill_formed_type(); } bare_expr_type expression_bare_type_vis::operator()( const int_literal& e) const { return int_type(); } bare_expr_type expression_bare_type_vis::operator()( const double_literal& e) const { return double_type(); } bare_expr_type expression_bare_type_vis::operator()(const array_expr& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()( const matrix_expr& e) const { return matrix_type(); } bare_expr_type expression_bare_type_vis::operator()( const row_vector_expr& e) const { return row_vector_type(); } bare_expr_type expression_bare_type_vis::operator()(const variable& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()(const fun& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()( const integrate_1d& e) const { return double_type(); } bare_expr_type expression_bare_type_vis::operator()( const integrate_ode& e) const { return bare_array_type(double_type(), 2); } bare_expr_type expression_bare_type_vis::operator()( const integrate_ode_control& e) const { return bare_array_type(double_type(), 2); } bare_expr_type expression_bare_type_vis::operator()( const algebra_solver& e) const { return vector_type(); } bare_expr_type expression_bare_type_vis::operator()( const algebra_solver_control& e) const { return vector_type(); } bare_expr_type expression_bare_type_vis::operator()(const map_rect& e) const { return vector_type(); } bare_expr_type expression_bare_type_vis::operator()(const index_op& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()( const index_op_sliced& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()( const conditional_op& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()(const binary_op& e) const { return e.type_; } bare_expr_type expression_bare_type_vis::operator()(const unary_op& e) const { return e.type_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_is_specialized_vis.hpp0000644000176200001440000000714213766554456027734 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_IS_SPECIALIZED_VIS_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_IS_SPECIALIZED_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to check for specialized block_var_type, i.e., * wrapped type is not one of int, real, vector, row_vector, matrix, or * ill-formed. */ struct block_type_is_specialized_vis : public boost::static_visitor { /** * Construct a visitor. */ block_type_is_specialized_vis(); /** * Return true if contained type is specialized. * * @param x type * @return bool */ bool operator()(const block_array_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const cholesky_factor_corr_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const cholesky_factor_cov_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const corr_matrix_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const cov_matrix_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const double_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const ill_formed_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const int_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const matrix_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const ordered_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const positive_ordered_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const row_vector_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const simplex_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const unit_vector_block_type& x) const; /** * Return true if type is specialized. * * @param x type * @return bool */ bool operator()(const vector_block_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/fun_name_exists.hpp0000644000176200001440000000063613766554456025041 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_FUN_NAME_EXISTS_HPP #define STAN_LANG_AST_FUN_FUN_NAME_EXISTS_HPP #include namespace stan { namespace lang { /** * Return true if the function name has been declared as a * built-in or by the user. * * @param name name of function * @return true if it has been declared */ bool fun_name_exists(const std::string& name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_is_specialized_vis_def.hpp0000644000176200001440000000366213766554456030555 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_IS_SPECIALIZED_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_IS_SPECIALIZED_VIS_DEF_HPP #include namespace stan { namespace lang { block_type_is_specialized_vis::block_type_is_specialized_vis() {} bool block_type_is_specialized_vis::operator()( const block_array_type& x) const { return x.contains().is_specialized(); } bool block_type_is_specialized_vis::operator()( const cholesky_factor_corr_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const cholesky_factor_cov_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const corr_matrix_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const cov_matrix_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const double_block_type& x) const { return false; } bool block_type_is_specialized_vis::operator()(const ill_formed_type& x) const { return false; } bool block_type_is_specialized_vis::operator()(const int_block_type& x) const { return false; } bool block_type_is_specialized_vis::operator()( const matrix_block_type& x) const { return false; } bool block_type_is_specialized_vis::operator()( const ordered_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const positive_ordered_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const row_vector_block_type& x) const { return false; } bool block_type_is_specialized_vis::operator()( const simplex_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const unit_vector_block_type& x) const { return true; } bool block_type_is_specialized_vis::operator()( const vector_block_type& x) const { return false; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_space_def.hpp0000644000176200001440000000047113766554456024253 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_SPACE_DEF_HPP #define STAN_LANG_AST_FUN_IS_SPACE_DEF_HPP #include #include namespace stan { namespace lang { bool is_space(char c) { return stan::io::is_whitespace(c); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_nonempty_def.hpp0000644000176200001440000000057613766554456025037 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NONEMPTY_DEF_HPP #define STAN_LANG_AST_FUN_IS_NONEMPTY_DEF_HPP #include #include namespace stan { namespace lang { bool is_nonempty(const std::string& s) { for (size_t i = 0; i < s.size(); ++i) if (!is_space(s[i])) return true; return false; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/get_cdf_def.hpp0000644000176200001440000000100013766554456024045 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GET_CDF_DEF_HPP #define STAN_LANG_AST_FUN_GET_CDF_DEF_HPP #include #include namespace stan { namespace lang { std::string get_cdf(const std::string& dist_name) { if (function_signatures::instance().has_key(dist_name + "_cdf_log")) return dist_name + "_cdf_log"; else if (function_signatures::instance().has_key(dist_name + "_lcdf")) return dist_name + "_lcdf"; else return dist_name; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_occurs_vis.hpp0000644000176200001440000001241013766554456024672 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_OCCURS_VIS_HPP #define STAN_LANG_AST_FUN_VAR_OCCURS_VIS_HPP #include #include namespace stan { namespace lang { struct nil; struct int_literal; struct double_literal; struct array_expr; struct matrix_expr; struct row_vector_expr; struct variable; struct fun; struct integrate_1d; struct integrate_ode; struct integrate_ode_control; struct algebra_solver; struct algebra_solver_control; struct map_rect; struct index_op; struct index_op_sliced; struct conditional_op; struct binary_op; struct unary_op; struct var_occurs_vis : public boost::static_visitor { /** * Construct a visitor to detect whether the specified variable * occurs in a statement. * * @param e variable to detect */ explicit var_occurs_vis(const variable& e); /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return false */ bool operator()(const nil& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return false */ bool operator()(const int_literal& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return false */ bool operator()(const double_literal& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in any of the array * expression elements */ bool operator()(const array_expr& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in any of the matrix * expression elements */ bool operator()(const matrix_expr& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in any of the row_vector * expression elements */ bool operator()(const row_vector_expr& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if variable is equal to the specifed variable */ bool operator()(const variable& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const fun& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const integrate_1d& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const integrate_ode& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const integrate_ode_control& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const algebra_solver& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const algebra_solver_control& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the arguments */ bool operator()(const map_rect& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the variable being * indexed or in any of the indexes */ bool operator()(const index_op& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the variable being * indexed or in any of the indexes */ bool operator()(const index_op_sliced& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the conditional or * result expressions */ bool operator()(const conditional_op& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in either of the operands */ bool operator()(const binary_op& e) const; /** * Return true if the variable occurs in the specified * expression. * * @param[in] e expression * @return true if the variable occurs in the operand */ bool operator()(const unary_op& e) const; /** * The name of the variable for which to search. */ const std::string var_name_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/promote_primitive.hpp0000644000176200001440000000236413766554456025427 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_PROMOTE_PRIMITIVE_HPP #define STAN_LANG_AST_FUN_PROMOTE_PRIMITIVE_HPP #include namespace stan { namespace lang { struct bare_expr_type; /** * Primitive types are scalar `int` or `double`. * Single primitive type promotes (sic) to itself, * i.e., `int` promotes to `int`, `double` promotes to `double`. * Cannont promote non-primitive types to `int` or `double` so * function returns `ill_formed_type` for all other types. * * @param et expression type * @return promoted expression type */ bare_expr_type promote_primitive(const bare_expr_type& et); /** * Promote pair of primitive types to `double` type when appropriate. * Pair (`int`, `double`) or (`double`, `int`) promotes to `double`. * Pair (`int`, `int`) promotes (sic) to `int`, likewise, * pair (`double`, `double`) promotes (sic) to `double`. * All other possible argument pairs have at least one non-primitive type, * therefore function returns `ill_formed_type`. * * @param et1 first expression type * @param et2 second expression type * @return promoted expression type */ bare_expr_type promote_primitive(const bare_expr_type& et1, const bare_expr_type& et2); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/indexed_type.hpp0000644000176200001440000000120013766554456024317 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_INDEXED_TYPE_HPP #define STAN_LANG_AST_FUN_INDEXED_TYPE_HPP #include namespace stan { namespace lang { struct bare_expr_type; struct expression; struct idx; /** * Return the type of the expression indexed by the generalized * index sequence. Return a type with base type * ill_formed_type if there are too many indexes. * * @param[in] e Expression being indexed. * @param[in] idxs Index sequence. * @return Type of expression applied to indexes. */ bare_expr_type indexed_type(const expression& e, const std::vector& idxs); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_var_vis.hpp0000644000176200001440000001251113766554456024151 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_VAR_VIS_HPP #define STAN_LANG_AST_FUN_HAS_VAR_VIS_HPP #include #include namespace stan { namespace lang { struct nil; struct int_literal; struct double_literal; struct array_expr; struct matrix_expr; struct row_vector_expr; struct variable; struct fun; struct integrate_ode; struct integrate_ode_control; struct algebra_solver; struct algebra_solver_control; struct map_rect; struct index_op; struct index_op_sliced; struct conditional_op; struct binary_op; struct unary_op; /** * Visitor to detect if an expression contains a non-data * variable. */ struct has_var_vis : public boost::static_visitor { /** * Construct a non-data variable detection visitor. * @param[in] var_map global variable declaration mapping */ explicit has_var_vis(const variable_map& var_map); /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const nil& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const int_literal& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const double_literal& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const array_expr& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const matrix_expr& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const row_vector_expr& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const variable& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const integrate_1d& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const integrate_ode& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const integrate_ode_control& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const algebra_solver& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const algebra_solver_control& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const map_rect& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const fun& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const index_op& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const index_op_sliced& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const conditional_op& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const binary_op& e) const; /** * Return true if the specified expression contains a non-data * variable. * * @param e expression * @return true if expression contains a non-data variable */ bool operator()(const unary_op& e) const; /** * Reference to the global variable declaration mapping. */ const variable_map& var_map_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/get_ccdf_def.hpp0000644000176200001440000000100713766554456024217 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GET_CCDF_DEF_HPP #define STAN_LANG_AST_FUN_GET_CCDF_DEF_HPP #include #include namespace stan { namespace lang { std::string get_ccdf(const std::string& dist_name) { if (function_signatures::instance().has_key(dist_name + "_ccdf_log")) return dist_name + "_ccdf_log"; else if (function_signatures::instance().has_key(dist_name + "_lccdf")) return dist_name + "_lccdf"; else return dist_name; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/ends_with_def.hpp0000644000176200001440000000055513766554456024454 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_ENDS_WITH_DEF_HPP #define STAN_LANG_AST_FUN_ENDS_WITH_DEF_HPP #include namespace stan { namespace lang { bool ends_with(const std::string& suffix, const std::string& s) { size_t idx = s.rfind(suffix); return idx != std::string::npos && idx == (s.size() - suffix.size()); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/strip_prob_fun_suffix.hpp0000644000176200001440000000101313766554456026257 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_STRIP_PROB_FUN_SUFFIX_HPP #define STAN_LANG_AST_FUN_STRIP_PROB_FUN_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return the result of stripping the suffix indicating it is a * probability function from the specified function name. * * @param[in] dist_fun name of probability function * @return the probability function with the suffix stripped off */ std::string strip_prob_fun_suffix(const std::string& dist_fun); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_multi_index_vis_def.hpp0000644000176200001440000000134013766554456026356 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_MULTI_INDEX_VIS_DEF_HPP #define STAN_LANG_AST_FUN_IS_MULTI_INDEX_VIS_DEF_HPP #include namespace stan { namespace lang { is_multi_index_vis::is_multi_index_vis() {} bool is_multi_index_vis::operator()(const uni_idx& i) const { return false; } bool is_multi_index_vis::operator()(const multi_idx& i) const { return true; } bool is_multi_index_vis::operator()(const omni_idx& i) const { return true; } bool is_multi_index_vis::operator()(const lb_idx& i) const { return true; } bool is_multi_index_vis::operator()(const ub_idx& i) const { return true; } bool is_multi_index_vis::operator()(const lub_idx& i) const { return true; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_space.hpp0000644000176200001440000000072713766554456023441 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_SPACE_HPP #define STAN_LANG_AST_FUN_IS_SPACE_HPP namespace stan { namespace lang { /** * Returns true if the specified character is an ASCII whitespace * character (space, newline, carriage return, tab). * This call delegates to the function * stan::io::is_whitespace. * * @param c character to test * @return true if character is whitespace */ bool is_space(char c); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_type_arg2_vis.hpp0000644000176200001440000001222013766554456025267 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_TYPE_ARG2_VIS_HPP #define STAN_LANG_AST_FUN_VAR_TYPE_ARG2_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get num cols from square and rect matrix types, * returns nil expression otherwise. * Note: square matrix types have single dimension * that is returned as value for both `arg1` and `arg2`. */ struct var_type_arg2_vis : public boost::static_visitor { /** * Construct a visitor. */ var_type_arg2_vis(); /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const block_array_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const local_array_type& x) const; /** * Return number of cols for matrix types. * * @param x type * @return expression num_cols */ expression operator()(const cholesky_factor_corr_block_type& x) const; /** * Return number of cols for matrix types. * * @param x type * @return expression num_cols */ expression operator()(const cholesky_factor_cov_block_type& x) const; /** * Return number of cols for matrix types. * * @param x type * @return expression num_cols */ expression operator()(const corr_matrix_block_type& x) const; /** * Return number of cols for matrix types. * * @param x type * @return expression num_cols */ expression operator()(const cov_matrix_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const double_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const double_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const ill_formed_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const int_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const int_type& x) const; /** * Return number of cols for matrix types. * * @param x type * @return expression num_cols */ expression operator()(const matrix_block_type& x) const; /** * Return number of cols for matrix types. * * @param x type * @return expression num_cols */ expression operator()(const matrix_local_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const ordered_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const positive_ordered_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const row_vector_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const row_vector_local_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const simplex_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const unit_vector_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const vector_block_type& x) const; /** * Return nil for non-matrix types. * * @param x type * @return nil expression */ expression operator()(const vector_local_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_non_param_var_vis.hpp0000644000176200001440000001330213766554456026202 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_VIS_HPP #define STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_VIS_HPP #include #include namespace stan { namespace lang { /** * Visitor to determine if an expression contains a variable that * is not declared as a parameter. */ struct has_non_param_var_vis : public boost::static_visitor { /** * Construct the visitor with the specified global variable * declaration mapping. This class will hold a reference to the * specified variable map, but will not alter it. * * @param[in] var_map */ explicit has_non_param_var_vis(const variable_map& var_map); /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const nil& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const int_literal& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const double_literal& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const array_expr& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const matrix_expr& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const row_vector_expr& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const variable& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const integrate_1d& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const integrate_ode& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const integrate_ode_control& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const algebra_solver& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const algebra_solver_control& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const map_rect& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const fun& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const index_op& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const index_op_sliced& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const conditional_op& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const binary_op& e) const; /** * Return true if the specified expression contains a variable * not declared as a parameter. * * @param[in] e expression * @return true if contains a variable not declared as a parameter */ bool operator()(const unary_op& e) const; /** * Reference to global variable declaration map. */ const variable_map& var_map_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/print_scope_def.hpp0000644000176200001440000000312613766554456025012 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_PRINT_SCOPE_DEF_HPP #define STAN_LANG_AST_FUN_PRINT_SCOPE_DEF_HPP #include namespace stan { namespace lang { void print_scope(std::ostream& o, const scope& var_scope) { if (var_scope.program_block() == model_name_origin) o << "model name"; else if (var_scope.program_block() == data_origin) o << "data"; else if (var_scope.program_block() == transformed_data_origin) o << "transformed data"; else if (var_scope.program_block() == parameter_origin) o << "parameter"; else if (var_scope.program_block() == transformed_parameter_origin) o << "transformed parameter"; else if (var_scope.program_block() == derived_origin) o << "generated quantities"; else if (var_scope.program_block() == function_argument_origin) o << "function argument"; else if (var_scope.program_block() == function_argument_origin_lp) o << "function argument '_lp' suffixed"; else if (var_scope.program_block() == function_argument_origin_rng) o << "function argument '_rng' suffixed"; else if (var_scope.program_block() == void_function_argument_origin) o << "void function argument"; else if (var_scope.program_block() == void_function_argument_origin_lp) o << "void function argument '_lp' suffixed"; else if (var_scope.program_block() == void_function_argument_origin_rng) o << "void function argument '_rng' suffixed"; else if (var_scope.program_block() == loop_identifier_origin) o << "loop identifier"; else o << "UNKNOWN ORIGIN=" << var_scope.program_block(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_cdf_suffix_def.hpp0000644000176200001440000000053613766554456025442 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_CDF_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_HAS_CDF_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { bool has_cdf_suffix(const std::string& fname) { return ends_with("_lcdf", fname) || ends_with("_cdf_log", fname); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_assignable_def.hpp0000644000176200001440000000164713766554456025276 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_ASSIGNABLE_DEF_HPP #define STAN_LANG_AST_FUN_IS_ASSIGNABLE_DEF_HPP #include #include #include namespace stan { namespace lang { bool is_assignable(const bare_expr_type& l_type, const bare_expr_type& r_type, const std::string& failure_message, std::ostream& error_msgs) { bool assignable = true; if (l_type.num_dims() != r_type.num_dims()) { assignable = false; error_msgs << "Mismatched array dimensions."; } if (!(l_type == r_type || (l_type.is_double_type() && r_type.is_int_type()))) { assignable = false; error_msgs << "Base type mismatch. "; } if (!assignable) error_msgs << failure_message << std::endl << " LHS type = " << l_type << "; RHS type = " << r_type << std::endl; return assignable; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_non_param_var_def.hpp0000644000176200001440000000064713766554456026147 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_DEF_HPP #define STAN_LANG_AST_FUN_HAS_NON_PARAM_VAR_DEF_HPP #include #include namespace stan { namespace lang { bool has_non_param_var(const expression& e, const variable_map& var_map) { has_non_param_var_vis vis(var_map); return boost::apply_visitor(vis, e.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_cdf_suffix.hpp0000644000176200001440000000066413766554456024626 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_CDF_SUFFIX_HPP #define STAN_LANG_AST_FUN_HAS_CDF_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return true if the specified function name has a suffix * indicating it is a CDF. * * @param[in] name of function * @return true if the function has a suffix indicating it is a CDF */ bool has_cdf_suffix(const std::string& name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_order_id_vis_def.hpp0000644000176200001440000000213613766554456027167 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_ORDER_ID_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_ORDER_ID_VIS_DEF_HPP #include #include namespace stan { namespace lang { bare_type_order_id_vis::bare_type_order_id_vis() {} template std::string bare_type_order_id_vis::operator()(const T& x) const { return x.oid(); } template std::string bare_type_order_id_vis::operator()( const bare_array_type&) const; template std::string bare_type_order_id_vis::operator()( const double_type&) const; template std::string bare_type_order_id_vis::operator()( const ill_formed_type&) const; template std::string bare_type_order_id_vis::operator()(const int_type&) const; template std::string bare_type_order_id_vis::operator()( const matrix_type&) const; template std::string bare_type_order_id_vis::operator()( const row_vector_type&) const; template std::string bare_type_order_id_vis::operator()( const vector_type&) const; template std::string bare_type_order_id_vis::operator()(const void_type&) const; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_user_defined_prob_function.hpp0000644000176200001440000000134313766554456027724 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_USER_DEFINED_PROB_FUNCTION_HPP #define STAN_LANG_AST_FUN_IS_USER_DEFINED_PROB_FUNCTION_HPP #include #include namespace stan { namespace lang { struct expression; /** * Return true if a probability function with the specified name, * random variate and parameters is user defined. * * @param[in] name function name * @param[in] variate random variable for probability function * @param[in] params parameters to probability function */ bool is_user_defined_prob_function(const std::string& name, const expression& variate, const std::vector& params); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_offset_multiplier_vis.hpp0000644000176200001440000001002313766554456030471 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_OFFSET_MULTIPLIER_VIS_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_OFFSET_MULTIPLIER_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get offset_multiplier from block_var_type. */ struct block_type_offset_multiplier_vis : public boost::static_visitor { /** * Construct a visitor. */ block_type_offset_multiplier_vis(); /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const block_array_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const cholesky_factor_corr_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const cholesky_factor_cov_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const corr_matrix_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const cov_matrix_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const double_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const ill_formed_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const int_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const matrix_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const ordered_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const positive_ordered_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const row_vector_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const simplex_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const unit_vector_block_type &x) const; /** * Return offset_multiplier for this type. * * @param x type * @return offset_multiplier */ offset_multiplier operator()(const vector_block_type &x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_params_total_vis.hpp0000644000176200001440000001033313766554456027427 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_PARAMS_TOTAL_VIS_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_PARAMS_TOTAL_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to build an expression for the total number of parameters * a parameter variable of this type contributes to a model. */ struct block_type_params_total_vis : public boost::static_visitor { /** * Construct a visitor. */ block_type_params_total_vis(); /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const block_array_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const cholesky_factor_corr_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const cholesky_factor_cov_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const corr_matrix_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const cov_matrix_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const double_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const ill_formed_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const int_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const matrix_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const ordered_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const positive_ordered_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const row_vector_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const simplex_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const unit_vector_block_type& x) const; /** * Return an expression for the number of parameters for this type. * * @param x type * @return expression */ expression operator()(const vector_block_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_vis.hpp0000644000176200001440000001142213766554456024500 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_VIS_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get bare type for local and block var types. */ struct bare_type_vis : public boost::static_visitor { /** * Construct a visitor. */ bare_type_vis(); /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const block_array_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const local_array_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const cholesky_factor_corr_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const cholesky_factor_cov_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const corr_matrix_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const cov_matrix_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const double_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const double_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const ill_formed_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const int_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const int_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const matrix_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const matrix_local_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const ordered_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const positive_ordered_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const row_vector_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const row_vector_local_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const simplex_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const unit_vector_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const vector_block_type& x) const; /** * Return equivalent bare type. * * @param x type * @return bare type */ bare_expr_type operator()(const vector_local_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_assignable.hpp0000644000176200001440000000165113766554456024453 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_ASSIGNABLE_HPP #define STAN_LANG_AST_FUN_IS_ASSIGNABLE_HPP #include #include namespace stan { namespace lang { struct bare_expr_type; /** * Return true if an expression of the right-hand side type is * assignable to a variable of the left-hand side type, writing * the failure message to the error messages if the asisgnment is * not legal. * * @param[in] l_type type of expression being assigned to * @param[in] r_type type of value expression * @param[in] failure_message message to write if assignment is * not possible * @param[in, out] error_msgs stream to which error messages are * written * @return true if the assignment is legal */ bool is_assignable(const bare_expr_type& l_type, const bare_expr_type& r_type, const std::string& failure_message, std::ostream& error_msgs); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_set_is_data_vis.hpp0000644000176200001440000000321513766554456027040 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_SET_IS_DATA_VIS_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_SET_IS_DATA_VIS_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get data restriction status for bare type. */ struct bare_type_set_is_data_vis : public boost::static_visitor { /** * Construct a visitor. */ bare_type_set_is_data_vis(); /** * Do nothing - bare_array_type elements must be updated. * * @param x type */ void operator()(bare_array_type& x) const; /** * Set `is_data_` flag to true. * * @param x type */ void operator()(double_type& x) const; /** * Do nothing. * * @param x type */ void operator()(ill_formed_type& x) const; /** * Set `is_data_` flag to true. * * @param x type */ void operator()(int_type& x) const; /** * Set `is_data_` flag to true. * * @param x type */ void operator()(matrix_type& x) const; /** * Set `is_data_` flag to true. * * @param x type */ void operator()(row_vector_type& x) const; /** * Set `is_data_` flag to true. * * @param x type */ void operator()(vector_type& x) const; /** * Do nothing. * * @param x type */ void operator()(void_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_ccdf_suffix_def.hpp0000644000176200001440000000054313766554456025603 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_CCDF_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_HAS_CCDF_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { bool has_ccdf_suffix(const std::string& fname) { return ends_with("_lccdf", fname) || ends_with("_ccdf_log", fname); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_nil.hpp0000644000176200001440000000053013766554456023120 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NIL_HPP #define STAN_LANG_AST_FUN_IS_NIL_HPP namespace stan { namespace lang { struct expression; /** * Return true if the specified expression is nil. * * @param e expression to test * @return true if expression is nil */ bool is_nil(const expression& e); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/infer_type_indexing_def.hpp0000644000176200001440000000202213766554456026510 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_INFER_TYPE_INDEXING_DEF_HPP #define STAN_LANG_AST_FUN_INFER_TYPE_INDEXING_DEF_HPP #include namespace stan { namespace lang { bare_expr_type infer_type_indexing(const bare_expr_type& bare_type, size_t num_index_dims) { if (num_index_dims == 0) return bare_type; if (bare_type.num_dims() >= 0 && num_index_dims > static_cast(bare_type.num_dims())) return ill_formed_type(); bare_expr_type tmp = bare_type; while (tmp.array_dims() > 0 && num_index_dims > 0) { tmp = tmp.array_element_type(); --num_index_dims; } if (num_index_dims == 0) return tmp; if ((tmp.is_vector_type() || tmp.is_row_vector_type()) && num_index_dims == 1) return double_type(); if (tmp.is_matrix_type() && num_index_dims == 2) return double_type(); if (tmp.is_matrix_type() && num_index_dims == 1) return row_vector_type(); return bare_expr_type(ill_formed_type()); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/strip_ccdf_suffix.hpp0000644000176200001440000000072413766554456025354 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_STRIP_CCDF_SUFFIX_HPP #define STAN_LANG_AST_FUN_STRIP_CCDF_SUFFIX_HPP #include namespace stan { namespace lang { /** * Return the result of removing the suffix from the specified * function name indicating it is a CCDF. * * @param[in] dist_fun name of function * @return result of removing suffix from function */ std::string strip_ccdf_suffix(const std::string& dist_fun); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_nil_vis_def.hpp0000644000176200001440000000334513766554456024626 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NIL_VIS_DEF_HPP #define STAN_LANG_AST_FUN_IS_NIL_VIS_DEF_HPP #include namespace stan { namespace lang { bool is_nil_vis::operator()(const nil& /*x*/) const { return true; } bool is_nil_vis::operator()(const int_literal& /*x*/) const { return false; } bool is_nil_vis::operator()(const double_literal& /* x */) const { return false; } bool is_nil_vis::operator()(const array_expr& /* x */) const { return false; } bool is_nil_vis::operator()(const matrix_expr& /* x */) const { return false; } bool is_nil_vis::operator()(const row_vector_expr& /* x */) const { return false; } bool is_nil_vis::operator()(const variable& /* x */) const { return false; } bool is_nil_vis::operator()(const integrate_1d& /* x */) const { return false; } bool is_nil_vis::operator()(const fun& /* x */) const { return false; } bool is_nil_vis::operator()(const integrate_ode& /* x */) const { return false; } bool is_nil_vis::operator()(const integrate_ode_control& /* x */) const { return false; } bool is_nil_vis::operator()(const algebra_solver& /* x */) const { return false; } bool is_nil_vis::operator()(const algebra_solver_control& /* x */) const { return false; } bool is_nil_vis::operator()(const map_rect& /* x */) const { return false; } bool is_nil_vis::operator()(const index_op& /* x */) const { return false; } bool is_nil_vis::operator()(const index_op_sliced& /* x */) const { return false; } bool is_nil_vis::operator()(const conditional_op& /* x */) const { return false; } bool is_nil_vis::operator()(const binary_op& /* x */) const { return false; } bool is_nil_vis::operator()(const unary_op& /* x */) const { return false; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_occurs_vis_def.hpp0000644000176200001440000000601413766554456025513 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_OCCURS_VIS_DEF_HPP #define STAN_LANG_AST_FUN_VAR_OCCURS_VIS_DEF_HPP #include #include namespace stan { namespace lang { var_occurs_vis::var_occurs_vis(const variable& e) : var_name_(e.name_) {} bool var_occurs_vis::operator()(const nil& st) const { return false; } bool var_occurs_vis::operator()(const int_literal& e) const { return false; } bool var_occurs_vis::operator()(const double_literal& e) const { return false; } bool var_occurs_vis::operator()(const array_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool var_occurs_vis::operator()(const matrix_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool var_occurs_vis::operator()(const row_vector_expr& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool var_occurs_vis::operator()(const variable& e) const { return var_name_ == e.name_; } bool var_occurs_vis::operator()(const fun& e) const { for (size_t i = 0; i < e.args_.size(); ++i) if (boost::apply_visitor(*this, e.args_[i].expr_)) return true; return false; } bool var_occurs_vis::operator()(const integrate_1d& e) const { return false; // no refs persist out of integrate_1d() call } bool var_occurs_vis::operator()(const integrate_ode& e) const { return false; // no refs persist out of integrate_ode() call } bool var_occurs_vis::operator()(const integrate_ode_control& e) const { return false; // no refs persist out of integrate_ode_control() call } bool var_occurs_vis::operator()(const algebra_solver& e) const { return false; // no refs persist out of algebra_solver() call } bool var_occurs_vis::operator()(const algebra_solver_control& e) const { return false; // no refs persist out of algebra_solver_control() call } bool var_occurs_vis::operator()(const map_rect& e) const { return false; // no refs persist out of map_rect() call } bool var_occurs_vis::operator()(const index_op& e) const { // refs only persist out of expression, not indexes return boost::apply_visitor(*this, e.expr_.expr_); } bool var_occurs_vis::operator()(const index_op_sliced& e) const { return boost::apply_visitor(*this, e.expr_.expr_); } bool var_occurs_vis::operator()(const conditional_op& e) const { return boost::apply_visitor(*this, e.cond_.expr_) || boost::apply_visitor(*this, e.true_val_.expr_) || boost::apply_visitor(*this, e.false_val_.expr_); } bool var_occurs_vis::operator()(const binary_op& e) const { return boost::apply_visitor(*this, e.left.expr_) || boost::apply_visitor(*this, e.right.expr_); } bool var_occurs_vis::operator()(const unary_op& e) const { return boost::apply_visitor(*this, e.subject.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/ends_with.hpp0000644000176200001440000000072513766554456023635 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_ENDS_WITH_HPP #define STAN_LANG_AST_FUN_ENDS_WITH_HPP #include namespace stan { namespace lang { /** * Returns true if the specified suffix appears at the end of the * specified string. * * @param suffix suffix to test * @param s string in which to search * @return true if the string ends with the suffix */ bool ends_with(const std::string& suffix, const std::string& s); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_type_arg1_vis.hpp0000644000176200001440000001220213766554456025266 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_TYPE_ARG1_VIS_HPP #define STAN_LANG_AST_FUN_VAR_TYPE_ARG1_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to get vector length/num rows from vector, matrix types, * returns nil expression otherwise. */ struct var_type_arg1_vis : public boost::static_visitor { /** * Construct a visitor. */ var_type_arg1_vis(); /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const block_array_type& x) const; /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const local_array_type& x) const; /** * Return number of rows for matrix types. * * @param x type * @return expression num_rows */ expression operator()(const cholesky_factor_corr_block_type& x) const; /** * Return number of rows for matrix types. * * @param x type * @return expression num_rows */ expression operator()(const cholesky_factor_cov_block_type& x) const; /** * Return number of rows for matrix types. * * @param x type * @return expression num_rows */ expression operator()(const corr_matrix_block_type& x) const; /** * Return number of rows for matrix types. * * @param x type */ expression operator()(const cov_matrix_block_type& x) const; /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const double_block_type& x) const; /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const double_type& x) const; /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const ill_formed_type& x) const; /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const int_block_type& x) const; /** * Return nil for non-vector and non-matrix types. * * @param x type * @return nil expression */ expression operator()(const int_type& x) const; /** * Return number of rows for matrix types. * * @param x type * @return expression num_rows */ expression operator()(const matrix_block_type& x) const; /** * Return number of rows for matrix types. * * @param x type * @return expression num_rows */ expression operator()(const matrix_local_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const ordered_block_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const positive_ordered_block_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const row_vector_block_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const row_vector_local_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const simplex_block_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const unit_vector_block_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const vector_block_type& x) const; /** * Return length for vector types. * * @param x type * @return expression length */ expression operator()(const vector_local_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/strip_prob_fun_suffix_def.hpp0000644000176200001440000000112313766554456027077 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_STRIP_PROB_FUN_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_STRIP_PROB_FUN_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { std::string strip_prob_fun_suffix(const std::string& fname) { if (ends_with("_lpdf", fname)) return fname.substr(0, fname.size() - 5); else if (ends_with("_lpmf", fname)) return fname.substr(0, fname.size() - 5); else if (ends_with("_log", fname)) return fname.substr(0, fname.size() - 4); else return fname; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/returns_type_vis.hpp0000644000176200001440000001303113766554456025267 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_RETURNS_TYPE_VIS_HPP #define STAN_LANG_AST_FUN_RETURNS_TYPE_VIS_HPP #include #include #include namespace stan { namespace lang { struct nil; struct assgn; struct sample; struct increment_log_prob_statement; struct expression; struct statements; struct for_statement; struct for_array_statement; struct for_matrix_statement; struct conditional_statement; struct while_statement; struct break_continue_statement; struct print_statement; struct reject_statement; struct no_op_statement; struct return_statement; /** * Visitor for reporting an error message if the statement is not * a return statement with a type specified at construction time. */ struct returns_type_vis : public boost::static_visitor { /** * Construct visitor expecting a return statement with an * expression of the specified type, writing error messages to * the specified stream. * * @param[in] return_type type of return expression * @param[in, out] error_msgs stream to which error messages are * written */ returns_type_vis(const bare_expr_type& return_type, std::ostream& error_msgs); /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const nil& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const assgn& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const sample& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const increment_log_prob_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const expression& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const statements& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const for_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const for_array_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const for_matrix_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const conditional_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const while_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const break_continue_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const print_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const reject_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return false */ bool operator()(const no_op_statement& st) const; /** * Return true if the specified statement is a return statement * with an expression of the type specified at construction * time. * * @param[in] st statement * @return true if the specifieid return type returns an * expression of the type specified at construction time */ bool operator()(const return_statement& st) const; /** * The type of the returned expression expected. */ bare_expr_type return_type_; /** * Stream to which error messages are written. */ std::ostream& error_msgs_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_type_arg2_vis_def.hpp0000644000176200001440000000472213766554456026115 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_TYPE_ARG2_VIS_DEF_HPP #define STAN_LANG_AST_FUN_VAR_TYPE_ARG2_VIS_DEF_HPP #include namespace stan { namespace lang { var_type_arg2_vis::var_type_arg2_vis() {} expression var_type_arg2_vis::operator()(const block_array_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const local_array_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()( const cholesky_factor_corr_block_type& x) const { return x.K_; } expression var_type_arg2_vis::operator()( const cholesky_factor_cov_block_type& x) const { return x.N_; } expression var_type_arg2_vis::operator()( const corr_matrix_block_type& x) const { return x.K_; } expression var_type_arg2_vis::operator()(const cov_matrix_block_type& x) const { return x.K_; } expression var_type_arg2_vis::operator()(const double_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const double_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const ill_formed_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const int_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const int_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const matrix_block_type& x) const { return x.N_; } expression var_type_arg2_vis::operator()(const matrix_local_type& x) const { return x.N_; } expression var_type_arg2_vis::operator()(const ordered_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()( const positive_ordered_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const row_vector_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const row_vector_local_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const simplex_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()( const unit_vector_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const vector_block_type& x) const { return expression(nil()); } expression var_type_arg2_vis::operator()(const vector_local_type& x) const { return expression(nil()); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_lp_suffix_def.hpp0000644000176200001440000000056013766554456025316 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_LP_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_HAS_LP_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { bool has_lp_suffix(const std::string& s) { int n = s.size(); return n > 3 && s[n - 1] == 'p' && s[n - 2] == 'l' && s[n - 3] == '_'; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_type_name_vis.hpp0000644000176200001440000001121513766554456025357 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_TYPE_NAME_VIS_HPP #define STAN_LANG_AST_FUN_VAR_TYPE_NAME_VIS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to Stan language name for type. */ struct var_type_name_vis : public boost::static_visitor { /** * Construct a visitor. */ var_type_name_vis(); /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const block_array_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const local_array_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const cholesky_factor_corr_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const cholesky_factor_cov_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const corr_matrix_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const cov_matrix_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const double_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const double_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const ill_formed_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const int_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const int_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const matrix_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const matrix_local_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const ordered_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const positive_ordered_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const row_vector_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const row_vector_local_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const simplex_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const unit_vector_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const vector_block_type& x) const; /** * Return name for this type. * * @param x type * @return name */ std::string operator()(const vector_local_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_var.hpp0000644000176200001440000000152413766554456023272 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_VAR_HPP #define STAN_LANG_AST_FUN_HAS_VAR_HPP namespace stan { namespace lang { struct expression; struct variable_map; /** * Returns true if the specified expression contains a variable * that is defined as a parameter, defined as a transformed * parameter, or is a local variable that is not an integer. * *

Compare to has_nonparam_var, which is similar, * but excludes variables declared as parameters. * * @param e Expression to test. * @param var_map Variable mapping for origin and types of * variables. * @return true if expression contains a variable defined as as a * parameter, defined as a transformedparameter, or is a local * variable that is not an integer. */ bool has_var(const expression& e, const variable_map& var_map); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/num_index_op_dims.hpp0000644000176200001440000000077613766554456025357 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_NUM_INDEX_OP_DIMS_HPP #define STAN_LANG_AST_FUN_NUM_INDEX_OP_DIMS_HPP #include #include namespace stan { namespace lang { struct expression; /** * Return the total number of index_op dimensions when the specified * vectors of expressions are concatenated. * * @param dimss vector of vector of dimension expressions */ std::size_t num_index_op_dims( const std::vector >& dimss); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/get_cdf.hpp0000644000176200001440000000056613766554456023247 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GET_CDF_HPP #define STAN_LANG_AST_FUN_GET_CDF_HPP #include namespace stan { namespace lang { /** * Return the name of the CDF for the specified distribution name. * * @param dist_name name of distribution * @return name of CDF */ std::string get_cdf(const std::string& dist_name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/fun_name_exists_def.hpp0000644000176200001440000000052413766554456025653 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_FUN_NAME_EXISTS_DEF_HPP #define STAN_LANG_AST_FUN_FUN_NAME_EXISTS_DEF_HPP #include #include namespace stan { namespace lang { bool fun_name_exists(const std::string& name) { return function_signatures::instance().has_key(name); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/template.hpp0000644000176200001440000000020013766554456023450 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_ #define STAN_LANG_AST_FUN_ namespace stan { namespace lang { /** */ } } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_block_var_type_def.hpp0000644000176200001440000000211113766554456026673 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_BLOCK_VAR_TYPE_DEF_HPP #define STAN_LANG_AST_FUN_WRITE_BLOCK_VAR_TYPE_DEF_HPP #include #include namespace stan { namespace lang { std::ostream &write_block_var_type(std::ostream &o, block_var_type type) { block_var_type el_type = type; if (type.array_dims() > 0) { o << type.array_dims() << "-dim array of " << type.array_contains().name(); el_type = type.array_contains(); } else { o << type.name(); } if (el_type.has_def_bounds()) { range bounds = el_type.bounds(); o << "<"; if (bounds.has_low()) o << " lower"; if (bounds.has_low() && bounds.has_high()) o << ","; if (bounds.has_high()) o << " upper"; o << ">"; } if (el_type.has_def_offset_multiplier()) { offset_multiplier ls = el_type.ls(); o << "<"; if (ls.has_offset()) o << " offset"; if (ls.has_offset() && ls.has_multiplier()) o << ","; if (ls.has_multiplier()) o << " multiplier"; o << ">"; } return o; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/get_prob_fun.hpp0000644000176200001440000000067513766554456024326 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_GET_PROB_FUN_HPP #define STAN_LANG_AST_FUN_GET_PROB_FUN_HPP #include namespace stan { namespace lang { /** * Return the probability function (density or mass) for the * specified distribution name. * * @param[in] dist_name name of distribution * @return probability function for distribution */ std::string get_prob_fun(const std::string& dist_name); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_total_dims_vis.hpp0000644000176200001440000000360013766554456026716 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_TOTAL_DIMS_VIS_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_TOTAL_DIMS_VIS_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Visitor to count total number of dimensions for a bare_expr_type. * Total is array dimensions and +1 for vectors or +2 for matrices. */ struct bare_type_total_dims_vis : public boost::static_visitor { /** * Construct a bare_type_total_dims visitor. */ bare_type_total_dims_vis(); /** * Returns total number of dimensions. * * @param x type */ int operator()(const bare_array_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const double_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const ill_formed_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const int_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const matrix_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const row_vector_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const vector_type& x) const; /** * Returns total number of dimensions. * * @param x type */ int operator()(const void_type& x) const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/promote_primitive_def.hpp0000644000176200001440000000113013766554456026233 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_PROMOTE_PRIMITIVE_DEF_HPP #define STAN_LANG_AST_FUN_PROMOTE_PRIMITIVE_DEF_HPP #include namespace stan { namespace lang { bare_expr_type promote_primitive(const bare_expr_type& et) { if (!et.is_primitive()) return ill_formed_type(); return et; } bare_expr_type promote_primitive(const bare_expr_type& et1, const bare_expr_type& et2) { if (!et1.is_primitive() || !et2.is_primitive()) return ill_formed_type(); return et1.is_double_type() ? et1 : et2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/bare_type_vis_def.hpp0000644000176200001440000000501613766554456025320 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BARE_TYPE_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BARE_TYPE_VIS_DEF_HPP #include namespace stan { namespace lang { bare_type_vis::bare_type_vis() {} bare_expr_type bare_type_vis::operator()(const block_array_type& x) const { return bare_array_type(x.contains().bare_type(), x.dims()); } bare_expr_type bare_type_vis::operator()(const local_array_type& x) const { return bare_array_type(x.contains().bare_type(), x.dims()); } bare_expr_type bare_type_vis::operator()( const cholesky_factor_corr_block_type& x) const { return matrix_type(); } bare_expr_type bare_type_vis::operator()( const cholesky_factor_cov_block_type& x) const { return matrix_type(); } bare_expr_type bare_type_vis::operator()( const corr_matrix_block_type& x) const { return matrix_type(); } bare_expr_type bare_type_vis::operator()(const cov_matrix_block_type& x) const { return matrix_type(); } bare_expr_type bare_type_vis::operator()(const double_block_type& x) const { return double_type(); } bare_expr_type bare_type_vis::operator()(const double_type& x) const { return double_type(); } bare_expr_type bare_type_vis::operator()(const ill_formed_type& x) const { return ill_formed_type(); } bare_expr_type bare_type_vis::operator()(const int_block_type& x) const { return int_type(); } bare_expr_type bare_type_vis::operator()(const int_type& x) const { return int_type(); } bare_expr_type bare_type_vis::operator()(const matrix_block_type& x) const { return matrix_type(); } bare_expr_type bare_type_vis::operator()(const matrix_local_type& x) const { return matrix_type(); } bare_expr_type bare_type_vis::operator()(const ordered_block_type& x) const { return vector_type(); } bare_expr_type bare_type_vis::operator()( const positive_ordered_block_type& x) const { return vector_type(); } bare_expr_type bare_type_vis::operator()(const row_vector_block_type& x) const { return row_vector_type(); } bare_expr_type bare_type_vis::operator()(const row_vector_local_type& x) const { return row_vector_type(); } bare_expr_type bare_type_vis::operator()(const simplex_block_type& x) const { return vector_type(); } bare_expr_type bare_type_vis::operator()( const unit_vector_block_type& x) const { return vector_type(); } bare_expr_type bare_type_vis::operator()(const vector_block_type& x) const { return vector_type(); } bare_expr_type bare_type_vis::operator()(const vector_local_type& x) const { return vector_type(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_bare_expr_type_def.hpp0000644000176200001440000000176213766554456026713 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_BARE_EXPR_TYPE_DEF_HPP #define STAN_LANG_AST_FUN_WRITE_BARE_EXPR_TYPE_DEF_HPP #include #include namespace stan { namespace lang { std::ostream& write_bare_expr_type(std::ostream& o, bare_expr_type type) { if (type.array_dims() > 0) { int commas = type.array_dims() - 1; o << type.array_contains(); o << "[ "; for (int i = 0; i < commas; ++i) o << ", "; o << "]"; } else { if (type.is_data()) o << "data "; if (type.is_int_type()) o << "int"; else if (type.is_double_type()) o << "real"; else if (type.is_vector_type()) o << "vector"; else if (type.is_row_vector_type()) o << "row_vector"; else if (type.is_matrix_type()) o << "matrix"; else if (type.is_ill_formed_type()) o << "ill-formed"; else if (type.is_void_type()) o << "void"; else o << "UNKNOWN"; } return o; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/returns_type.hpp0000644000176200001440000000162413766554456024413 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_RETURNS_TYPE_HPP #define STAN_LANG_AST_FUN_RETURNS_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Return true if the specified statement is a return statement * returning an expression of the specified type, otherwise return * false and write an error message to the specified error stream. * * @param[in] return_type expected type of returned expression * @param[in] statement statement to test * @param[in, out] error_msgs stream to which error messages are * written * @return true if the specified statement is a return statement * with a return expression of the specified type */ bool returns_type(const bare_expr_type& return_type, const statement& statement, std::ostream& error_msgs); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_nil_def.hpp0000644000176200001440000000052513766554456023742 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_NIL_DEF_HPP #define STAN_LANG_AST_FUN_IS_NIL_DEF_HPP #include #include namespace stan { namespace lang { bool is_nil(const expression& e) { is_nil_vis ino; return boost::apply_visitor(ino, e.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/infer_type_indexing.hpp0000644000176200001440000000111713766554456025676 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_INFER_TYPE_INDEXING_HPP #define STAN_LANG_AST_FUN_INFER_TYPE_INDEXING_HPP #include namespace stan { namespace lang { /** * Return the expression type resulting from indexing the * specified expression with the specified number of indexes. * * @param e type of the variable being indexed * @param num_indexes number of indexes provided * @return bare_expr_type of indexed expression */ bare_expr_type infer_type_indexing(const bare_expr_type& e, size_t num_indexes); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_var_def.hpp0000644000176200001440000000057713766554456024117 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_VAR_DEF_HPP #define STAN_LANG_AST_FUN_HAS_VAR_DEF_HPP #include #include namespace stan { namespace lang { bool has_var(const expression& e, const variable_map& var_map) { has_var_vis vis(var_map); return boost::apply_visitor(vis, e.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/num_index_op_dims_def.hpp0000644000176200001440000000065613766554456026172 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_NUM_INDEX_OP_DIMS_DEF_HPP #define STAN_LANG_AST_FUN_NUM_INDEX_OP_DIMS_DEF_HPP #include #include namespace stan { namespace lang { size_t num_index_op_dims(const std::vector >& dimss) { size_t total = 0U; for (size_t i = 0; i < dimss.size(); ++i) total += dimss[i].size(); return total; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/has_prob_fun_suffix_def.hpp0000644000176200001440000000063513766554456026520 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_HAS_PROB_FUN_SUFFIX_DEF_HPP #define STAN_LANG_AST_FUN_HAS_PROB_FUN_SUFFIX_DEF_HPP #include #include namespace stan { namespace lang { bool has_prob_fun_suffix(const std::string& fname) { return ends_with("_lpdf", fname) || ends_with("_lpmf", fname) || ends_with("_log", fname); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/block_type_offset_multiplier_vis_def.hpp0000644000176200001440000000450213766554456031314 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_BLOCK_TYPE_OFFSET_MULTIPLIER_VIS_DEF_HPP #define STAN_LANG_AST_FUN_BLOCK_TYPE_OFFSET_MULTIPLIER_VIS_DEF_HPP #include namespace stan { namespace lang { block_type_offset_multiplier_vis::block_type_offset_multiplier_vis() {} offset_multiplier block_type_offset_multiplier_vis::operator()( const block_array_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const cholesky_factor_corr_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const cholesky_factor_cov_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const corr_matrix_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const cov_matrix_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const double_block_type &x) const { return x.ls_; } offset_multiplier block_type_offset_multiplier_vis::operator()( const ill_formed_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const int_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const matrix_block_type &x) const { return x.ls_; } offset_multiplier block_type_offset_multiplier_vis::operator()( const ordered_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const positive_ordered_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const row_vector_block_type &x) const { return x.ls_; } offset_multiplier block_type_offset_multiplier_vis::operator()( const simplex_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const unit_vector_block_type &x) const { return offset_multiplier(); } offset_multiplier block_type_offset_multiplier_vis::operator()( const vector_block_type &x) const { return x.ls_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_block_var_type.hpp0000644000176200001440000000075713766554456026073 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_BLOCK_VAR_TYPE_HPP #define STAN_LANG_AST_FUN_WRITE_BLOCK_VAR_TYPE_HPP #include #include namespace stan { namespace lang { /** * Write a user-readable version of the specified variable type * to the specified output stream. * * @param o output stream * @param type variable type */ std::ostream& write_block_var_type(std::ostream& o, block_var_type type); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/write_bare_expr_type.hpp0000644000176200001440000000077513766554456026100 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_WRITE_BARE_EXPR_TYPE_HPP #define STAN_LANG_AST_FUN_WRITE_BARE_EXPR_TYPE_HPP #include #include namespace stan { namespace lang { /** * Write a user-readable version of the specified bare expression * type to the specified output stream. * * @param o output stream * @param type bare expression type */ std::ostream& write_bare_expr_type(std::ostream& o, bare_expr_type type); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/var_type_name_vis_def.hpp0000644000176200001440000000471613766554456026205 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_VAR_TYPE_NAME_VIS_DEF_HPP #define STAN_LANG_AST_FUN_VAR_TYPE_NAME_VIS_DEF_HPP #include #include namespace stan { namespace lang { var_type_name_vis::var_type_name_vis() {} std::string var_type_name_vis::operator()(const block_array_type& x) const { return "array"; } std::string var_type_name_vis::operator()(const local_array_type& x) const { return "array"; } std::string var_type_name_vis::operator()( const cholesky_factor_corr_block_type& x) const { return "cholesky_factor_corr"; } std::string var_type_name_vis::operator()( const cholesky_factor_cov_block_type& x) const { return "cholesky_factor_cov"; } std::string var_type_name_vis::operator()( const corr_matrix_block_type& x) const { return "corr_matrix"; } std::string var_type_name_vis::operator()( const cov_matrix_block_type& x) const { return "cov_matrix"; } std::string var_type_name_vis::operator()(const double_block_type& x) const { return "real"; } std::string var_type_name_vis::operator()(const double_type& x) const { return "real"; } std::string var_type_name_vis::operator()(const ill_formed_type& x) const { return "ill_formed"; } std::string var_type_name_vis::operator()(const int_block_type& x) const { return "int"; } std::string var_type_name_vis::operator()(const int_type& x) const { return "int"; } std::string var_type_name_vis::operator()(const matrix_block_type& x) const { return "matrix"; } std::string var_type_name_vis::operator()(const matrix_local_type& x) const { return "matrix"; } std::string var_type_name_vis::operator()(const ordered_block_type& x) const { return "ordered"; } std::string var_type_name_vis::operator()( const positive_ordered_block_type& x) const { return "positive_ordered"; } std::string var_type_name_vis::operator()( const row_vector_block_type& x) const { return "row_vector"; } std::string var_type_name_vis::operator()( const row_vector_local_type& x) const { return "row_vector"; } std::string var_type_name_vis::operator()(const simplex_block_type& x) const { return "simplex"; } std::string var_type_name_vis::operator()( const unit_vector_block_type& x) const { return "unit_vector"; } std::string var_type_name_vis::operator()(const vector_block_type& x) const { return "vector"; } std::string var_type_name_vis::operator()(const vector_local_type& x) const { return "vector"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/fun/is_multi_index_def.hpp0000644000176200001440000000055513766554456025504 0ustar liggesusers#ifndef STAN_LANG_AST_FUN_IS_MULTI_INDEX_DEF_HPP #define STAN_LANG_AST_FUN_IS_MULTI_INDEX_DEF_HPP #include #include namespace stan { namespace lang { bool is_multi_index(const idx& idx) { is_multi_index_vis v; return boost::apply_visitor(v, idx.idx_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/scope_def.hpp0000644000176200001440000000625413766554456023013 0ustar liggesusers#ifndef STAN_LANG_AST_SCOPE_DEF_HPP #define STAN_LANG_AST_SCOPE_DEF_HPP #include #include namespace stan { namespace lang { scope::scope() : program_block_(model_name_origin), is_local_(false) {} scope::scope(const origin_block& program_block) : program_block_(program_block), is_local_(false) {} scope::scope(const origin_block& program_block, const bool& is_local) : program_block_(program_block), is_local_(is_local) {} origin_block scope::program_block() const { return program_block_; } bool scope::is_local() const { return is_local_; } bool scope::local_allows_var() const { return is_local_ && program_block_ != transformed_data_origin && program_block_ != derived_origin; } bool scope::par_or_tpar() const { return !is_local_ && (program_block_ == parameter_origin || program_block_ == transformed_parameter_origin); } bool scope::tpar() const { return program_block_ == transformed_parameter_origin; } bool scope::fun() const { return program_block_ == function_argument_origin || program_block_ == function_argument_origin_lp || program_block_ == function_argument_origin_rng || program_block_ == void_function_argument_origin || program_block_ == void_function_argument_origin_lp || program_block_ == void_function_argument_origin_rng; } bool scope::non_void_fun() const { return program_block_ == function_argument_origin || program_block_ == function_argument_origin_lp || program_block_ == function_argument_origin_rng; } bool scope::void_fun() const { return program_block_ == void_function_argument_origin || program_block_ == void_function_argument_origin_lp || program_block_ == void_function_argument_origin_rng; } bool scope::allows_assignment() const { return !(program_block_ == data_origin || program_block_ == parameter_origin); } bool scope::allows_lp_fun() const { return program_block_ == model_name_origin || program_block_ == transformed_parameter_origin || program_block_ == function_argument_origin_lp || program_block_ == void_function_argument_origin_lp; } bool scope::allows_rng() const { return program_block_ == derived_origin || program_block_ == transformed_data_origin || program_block_ == function_argument_origin_rng || program_block_ == void_function_argument_origin_rng; } bool scope::allows_sampling() const { return program_block_ == model_name_origin || program_block_ == function_argument_origin_lp || program_block_ == void_function_argument_origin_lp; } bool scope::allows_size() const { return is_local_ || program_block_ == data_origin || program_block_ == transformed_data_origin || program_block_ == function_argument_origin || program_block_ == function_argument_origin_lp || program_block_ == function_argument_origin_rng || program_block_ == void_function_argument_origin || program_block_ == void_function_argument_origin_lp || program_block_ == void_function_argument_origin_rng; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/0000755000176200001440000000000013766554456021325 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/ast/type/void_type.hpp0000644000176200001440000000075013766554456024042 0ustar liggesusers#ifndef STAN_LANG_AST_VOID_TYPE_HPP #define STAN_LANG_AST_VOID_TYPE_HPP #include namespace stan { namespace lang { /** * Void type. */ struct void_type { /** * True if variable type declared with "data" qualifier. * Always false. */ bool is_data_; /** * Construct a void type with default values. */ void_type(); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/block_var_type.hpp0000644000176200001440000001774413766554456025056 0ustar liggesusers#ifndef STAN_LANG_AST_BLOCK_VAR_TYPE_HPP #define STAN_LANG_AST_BLOCK_VAR_TYPE_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Block variable types */ struct block_array_type; struct cholesky_factor_corr_block_type; struct cholesky_factor_cov_block_type; struct corr_matrix_block_type; struct cov_matrix_block_type; struct double_block_type; struct ill_formed_type; struct int_block_type; struct matrix_block_type; struct ordered_block_type; struct positive_ordered_block_type; struct row_vector_block_type; struct simplex_block_type; struct unit_vector_block_type; struct vector_block_type; struct block_var_type { /** * Recursive wrapper for block variable types. */ typedef boost::variant< boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper> block_t; /** * The block variable type held by this wrapper. */ block_t var_type_; /** * Construct a block var type with default values. */ block_var_type(); /** * Construct a block var type with the specified type. * * @param type block variable type */ block_var_type(const block_var_type &type); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const ill_formed_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type( const cholesky_factor_corr_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type( const cholesky_factor_cov_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const corr_matrix_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const cov_matrix_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const double_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const int_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const matrix_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const ordered_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type( const positive_ordered_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const row_vector_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const simplex_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const unit_vector_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const vector_block_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const block_array_type &x); // NOLINT(runtime/explicit) /** * Construct a block var type with the specified type. * * @param x block variable type */ block_var_type(const block_t &x); // NOLINT(runtime/explicit) /** * Returns expression for length of vector types or * number of rows for matrix type, nil otherwise. */ expression arg1() const; /** * Returns expression for number of columns for matrix types, * nil otherwise. */ expression arg2() const; /** * If `var_type` is `block_array_type`, returns the innermost type * contained in the array, otherwise will return `ill_formed_type`. */ block_var_type array_contains() const; /** * Returns number of array dimensions for this type. * Returns 0 for non-array types. */ int array_dims() const; /** * Returns array element type if `var_type_` is `block_array_type`, * ill_formed_type otherwise. (Call `is_array_type()` first.) */ block_var_type array_element_type() const; /** * Returns array length for block_array_type, nil otherwise. */ expression array_len() const; /** * Returns vector of array lengths for block_array_type, * empty vector otherwise. */ std::vector array_lens() const; /** * Returns equivalent bare_expr_type (unsized) for this block type. */ bare_expr_type bare_type() const; /** * Returns bounds for this type. */ range bounds() const; /** * Returns true if there are specified upper and/or lower bounds * for this type (contained type for arrays), false otherwise. */ bool has_def_bounds() const; /** * Returns offset and multiplier for this type. */ offset_multiplier ls() const; /** * Returns true if there are specified offset and/or multiplier * for this type (contained type for arrays), false otherwise. */ bool has_def_offset_multiplier() const; /** * Returns true if `var_type_` is `block_array_type`, false otherwise. */ bool is_array_type() const; /** * Returns true if `var_type_` has either specified bounds or * is a specialized vector or matrix type. */ bool is_constrained() const; /** * Returns true if `var_type_` is a specialized vector or matrix type. * If `var_type_` is array type, evaluates contained type. */ bool is_specialized() const; /** * If array type, returns innermost type, * otherwise returns this type. */ block_var_type innermost_type() const; /** * Returns Stan language type name. */ std::string name() const; /** * Returns total number of dimensions for container type. * Returns 0 for scalar types. */ int num_dims() const; /** * Returns an expression for the number of parameters * a parameter variable of this type contributes to a model. */ expression params_total() const; }; /** * Stream a user-readable version of the block_var_type to the * specified output stream, returning the specified argument * output stream to allow chaining. * * @param o output stream * @param x expression type * @return argument output stream */ std::ostream &operator<<(std::ostream &o, const block_var_type &x); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/row_vector_type.hpp0000644000176200001440000000127313766554456025273 0ustar liggesusers#ifndef STAN_LANG_AST_ROW_VECTOR_TYPE_HPP #define STAN_LANG_AST_ROW_VECTOR_TYPE_HPP #include namespace stan { namespace lang { /** * Row vector type. */ struct row_vector_type { /** * True if variable type declared with "data" qualifier. */ bool is_data_; /** * Construct a row vector type with default values. */ row_vector_type(); /** * Construct a row vector type with the specified data-only variable flag. * * @param is_data true when var is specified data-only */ explicit row_vector_type(bool is_data); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/matrix_local_type.hpp0000644000176200001440000000151613766554456025560 0ustar liggesusers#ifndef STAN_LANG_AST_MATRIX_LOCAL_TYPE_HPP #define STAN_LANG_AST_MATRIX_LOCAL_TYPE_HPP #include namespace stan { namespace lang { /** * Matrix local var type. */ struct matrix_local_type { /** * Number of rows */ expression M_; /** * Number of columns */ expression N_; /** * Construct a local var type with default values. */ matrix_local_type(); /** * Construct a local var type with specified values. * Sizes should be int expressions - constructor doesn't check. * * @param M num rows * @param N num columns */ matrix_local_type(const expression& M, const expression& N); /** * Get M (num rows). */ expression M() const; /** * Get N (num cols). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/cholesky_factor_cov_block_type_def.hpp0000644000176200001440000000116213766554456031115 0ustar liggesusers#ifndef STAN_LANG_AST_CHOLESKY_FACTOR_COV_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_CHOLESKY_FACTOR_COV_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { cholesky_factor_cov_block_type::cholesky_factor_cov_block_type( const expression& M, const expression& N) : M_(M), N_(N) {} cholesky_factor_cov_block_type::cholesky_factor_cov_block_type() : cholesky_factor_cov_block_type(nil(), nil()) {} expression cholesky_factor_cov_block_type::M() const { return M_; } expression cholesky_factor_cov_block_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/cholesky_factor_cov_block_type.hpp0000644000176200001440000000172613766554456030305 0ustar liggesusers#ifndef STAN_LANG_AST_CHOLESKY_FACTOR_COV_BLOCK_TYPE_HPP #define STAN_LANG_AST_CHOLESKY_FACTOR_COV_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Cholesky factor for covariance matrix block var type. * * Note: no 1-arg constructor for square matrix; * both row and column dimensions always required. */ struct cholesky_factor_cov_block_type { /** * Number of rows. */ expression M_; /** * Number of columns. */ expression N_; /** * Construct a block var type with default values. */ cholesky_factor_cov_block_type(); /** * Construct a block var type with specified values. * * @param M num rows * @param N num columns */ cholesky_factor_cov_block_type(const expression& M, const expression& N); /** * Get M (num rows). */ expression M() const; /** * Get N (num cols). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/cholesky_factor_corr_block_type.hpp0000644000176200001440000000142313766554456030455 0ustar liggesusers#ifndef STAN_LANG_AST_CHOLESKY_FACTOR_CORR_BLOCK_TYPE_HPP #define STAN_LANG_AST_CHOLESKY_FACTOR_CORR_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Cholesky factor for a correlation matrix block var type. */ struct cholesky_factor_corr_block_type { /** * Number of rows and columns. */ expression K_; /** * Construct a block var type with default values. */ cholesky_factor_corr_block_type(); /** * Construct a block var type with specified values. * * @param K corr matrix num rows, columns */ explicit cholesky_factor_corr_block_type(const expression& K); /** * Get K (corr matrix num rows, columns) */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/vector_block_type.hpp0000644000176200001440000000335113766554456025555 0ustar liggesusers#ifndef STAN_LANG_AST_VECTOR_BLOCK_TYPE_HPP #define STAN_LANG_AST_VECTOR_BLOCK_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Vector block var type. */ struct vector_block_type { /** * Bounds constraints */ range bounds_; /** * Offset and multiplier */ offset_multiplier ls_; /** * Vector length */ expression N_; /** * Construct a block var type with default values. */ vector_block_type(); /** * Construct a block var type with specified values. * Length should be int expression - constructor doesn't check. * * @param bounds variable upper and/or lower bounds * @param ls variable offset and multiplier * @param N vector length */ vector_block_type(const range &bounds, const offset_multiplier &ls, const expression &N); /** * Construct a block var type with specified values. * Length should be int expression - constructor doesn't check. * * @param bounds variable upper and/or lower bounds * @param N vector length */ vector_block_type(const range &bounds, const expression &N); /** * Construct a block var type with specified values. * Length should be int expression - constructor doesn't check. * * @param ls variable offset and multiplier * @param N vector length */ vector_block_type(const offset_multiplier &ls, const expression &N); /** * Get bounds. */ range bounds() const; /** * Get offset and multiplier. */ offset_multiplier ls() const; /** * Get N (num rows). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/vector_type.hpp0000644000176200001440000000123313766554456024400 0ustar liggesusers#ifndef STAN_LANG_AST_VECTOR_TYPE_HPP #define STAN_LANG_AST_VECTOR_TYPE_HPP #include namespace stan { namespace lang { /** * Vector type. */ struct vector_type { /** * True if variable type declared with "data" qualifier. */ bool is_data_; /** * Construct a vector type with default values. */ vector_type(); /** * Construct a vector type with the specified data-only variable flag. * * @param is_data true when var is specified data-only */ explicit vector_type(bool is_data); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/row_vector_type_def.hpp0000644000176200001440000000070713766554456026112 0ustar liggesusers#ifndef STAN_LANG_AST_ROW_VECTOR_TYPE_DEF_HPP #define STAN_LANG_AST_ROW_VECTOR_TYPE_DEF_HPP #include #include namespace stan { namespace lang { row_vector_type::row_vector_type(bool is_data) : is_data_(is_data) {} row_vector_type::row_vector_type() : row_vector_type(false) {} std::string row_vector_type::oid() const { return "05_row_vector_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/corr_matrix_block_type_def.hpp0000644000176200001440000000070113766554456027416 0ustar liggesusers#ifndef STAN_LANG_AST_CORR_MATRIX_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_CORR_MATRIX_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { corr_matrix_block_type::corr_matrix_block_type(const expression& K) : K_(K) {} corr_matrix_block_type::corr_matrix_block_type() : corr_matrix_block_type(nil()) {} expression corr_matrix_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/simplex_block_type.hpp0000644000176200001440000000121413766554456025730 0ustar liggesusers#ifndef STAN_LANG_AST_SIMPLEX_BLOCK_TYPE_HPP #define STAN_LANG_AST_SIMPLEX_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Simplex block var type. */ struct simplex_block_type { /** * Simplex vector */ expression K_; /** * Construct a block var type with default values. */ simplex_block_type(); /** * Construct a block var type with specified values. * * @param K num columns for simplex */ explicit simplex_block_type(const expression& K); /** * Get K (num columns) */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/unit_vector_block_type.hpp0000644000176200001440000000134013766554456026610 0ustar liggesusers#ifndef STAN_LANG_AST_UNIT_VECTOR_BLOCK_TYPE_HPP #define STAN_LANG_AST_UNIT_VECTOR_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Unit vector block var type. */ struct unit_vector_block_type { /** * Unit vector length */ expression K_; /** * Construct a block var type with default values. */ unit_vector_block_type(); /** * Construct a block var type with specified values. * Size should be int expression - constructor doesn't check. * * @param K number of columns */ explicit unit_vector_block_type(const expression& K); /** * Get K (num cols). */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/positive_ordered_block_type_def.hpp0000644000176200001440000000075513766554456030444 0ustar liggesusers#ifndef STAN_LANG_AST_POSITIVE_ORDERED_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_POSITIVE_ORDERED_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { positive_ordered_block_type::positive_ordered_block_type(const expression& K) : K_(K) {} positive_ordered_block_type::positive_ordered_block_type() : positive_ordered_block_type(nil()) {} expression positive_ordered_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/int_type_def.hpp0000644000176200001440000000060113766554456024504 0ustar liggesusers#ifndef STAN_LANG_AST_INT_TYPE_DEF_HPP #define STAN_LANG_AST_INT_TYPE_DEF_HPP #include #include namespace stan { namespace lang { int_type::int_type(bool is_data) : is_data_(is_data) {} int_type::int_type() : int_type(false) {} std::string int_type::oid() const { return "02_int_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/block_var_type_def.hpp0000644000176200001440000001170513766554456025663 0ustar liggesusers#ifndef STAN_LANG_AST_BLOCK_VAR_TYPE_DEF_HPP #define STAN_LANG_AST_BLOCK_VAR_TYPE_DEF_HPP #include #include #include #include #include #include namespace stan { namespace lang { block_var_type::block_var_type() : var_type_(ill_formed_type()) {} block_var_type::block_var_type(const block_var_type &x) : var_type_(x.var_type_) {} block_var_type::block_var_type(const block_t &x) : var_type_(x) {} block_var_type::block_var_type(const ill_formed_type &x) : var_type_(x) {} block_var_type::block_var_type(const cholesky_factor_corr_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const cholesky_factor_cov_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const corr_matrix_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const cov_matrix_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const double_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const int_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const matrix_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const ordered_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const positive_ordered_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const row_vector_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const simplex_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const unit_vector_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const vector_block_type &x) : var_type_(x) {} block_var_type::block_var_type(const block_array_type &x) : var_type_(x) {} expression block_var_type::arg1() const { var_type_arg1_vis vis; return boost::apply_visitor(vis, var_type_); } expression block_var_type::arg2() const { var_type_arg2_vis vis; return boost::apply_visitor(vis, var_type_); } block_var_type block_var_type::array_contains() const { if (boost::get(&var_type_)) { block_array_type vt = boost::get(var_type_); return vt.contains(); } return ill_formed_type(); } int block_var_type::array_dims() const { if (boost::get(&var_type_)) { block_array_type vt = boost::get(var_type_); return vt.dims(); } return 0; } block_var_type block_var_type::array_element_type() const { if (boost::get(&var_type_)) { block_array_type vt = boost::get(var_type_); return vt.element_type(); } return ill_formed_type(); } expression block_var_type::array_len() const { if (boost::get(&var_type_)) { block_array_type vt = boost::get(var_type_); return vt.array_len(); } return expression(nil()); } std::vector block_var_type::array_lens() const { if (boost::get(&var_type_)) { block_array_type vt = boost::get(var_type_); return vt.array_lens(); } return std::vector(); } bare_expr_type block_var_type::bare_type() const { bare_type_vis vis; return boost::apply_visitor(vis, var_type_); } range block_var_type::bounds() const { block_type_bounds_vis vis; return boost::apply_visitor(vis, var_type_); } bool block_var_type::has_def_bounds() const { if (this->bounds().has_low() || this->bounds().has_high()) return true; return false; } offset_multiplier block_var_type::ls() const { block_type_offset_multiplier_vis vis; return boost::apply_visitor(vis, var_type_); } bool block_var_type::has_def_offset_multiplier() const { if (this->ls().has_offset() || this->ls().has_multiplier()) return true; return false; } block_var_type block_var_type::innermost_type() const { if (boost::get(&var_type_)) { block_array_type vt = boost::get(var_type_); return vt.contains(); } return var_type_; } bool block_var_type::is_array_type() const { if (boost::get(&var_type_)) return true; return false; } bool block_var_type::is_constrained() const { return has_def_bounds() || is_specialized(); } bool block_var_type::is_specialized() const { block_type_is_specialized_vis vis; return boost::apply_visitor(vis, var_type_); } std::string block_var_type::name() const { var_type_name_vis vis; return boost::apply_visitor(vis, var_type_); } int block_var_type::num_dims() const { return this->bare_type().num_dims(); } expression block_var_type::params_total() const { block_type_params_total_vis vis; return boost::apply_visitor(vis, var_type_); } std::ostream &operator<<(std::ostream &o, const block_var_type &var_type) { write_block_var_type(o, var_type); return o; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/ordered_block_type_def.hpp0000644000176200001440000000063513766554456026517 0ustar liggesusers#ifndef STAN_LANG_AST_ORDERED_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_ORDERED_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { ordered_block_type::ordered_block_type(const expression& K) : K_(K) {} ordered_block_type::ordered_block_type() : ordered_block_type(nil()) {} expression ordered_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/unit_vector_block_type_def.hpp0000644000176200001440000000070113766554456027426 0ustar liggesusers#ifndef STAN_LANG_AST_UNIT_VECTOR_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_UNIT_VECTOR_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { unit_vector_block_type::unit_vector_block_type(const expression& K) : K_(K) {} unit_vector_block_type::unit_vector_block_type() : unit_vector_block_type(nil()) {} expression unit_vector_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/block_array_type.hpp0000644000176200001440000000336413766554456025375 0ustar liggesusers#ifndef STAN_LANG_AST_BLOCK_ARRAY_TYPE_HPP #define STAN_LANG_AST_BLOCK_ARRAY_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Block array type for Stan variables and expressions (recursive). */ struct block_array_type { /** * The array element type. */ block_var_type element_type_; /** * The length of this array. */ expression array_len_; /** * Construct an array block var type with default values. */ block_array_type(); /** * Construct a block array type with the specified element type * and array length. * Length should be int expression - constructor doesn't check. * * @param el_type element type * @param len array length */ block_array_type(const block_var_type& el_type, const expression& len); /** * Construct a multi-dimensional block array type with the * specified element sized dimensions. * Lengths should be int expression - constructor doesn't check. * * @param el_type element type * @param lens vector of array lengths */ block_array_type(const block_var_type& el_type, const std::vector& lens); /** * Returns type of elements stored in innermost array. */ block_var_type contains() const; /** * Returns number of array dimensions. */ int dims() const; /** * Returns top-level array element type. */ block_var_type element_type() const; /** * Returns the length of this array. */ expression array_len() const; /** * Returns a vector of lengths of all array dimensions. */ std::vector array_lens() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/matrix_type.hpp0000644000176200001440000000123313766554456024402 0ustar liggesusers#ifndef STAN_LANG_AST_MATRIX_TYPE_HPP #define STAN_LANG_AST_MATRIX_TYPE_HPP #include namespace stan { namespace lang { /** * Matrix type. */ struct matrix_type { /** * True if variable type declared with "data" qualifier. */ bool is_data_; /** * Construct a matrix type with default values. */ matrix_type(); /** * Construct a matrix type with the specified data-only variable flag. * * @param is_data true when var is specified data-only */ explicit matrix_type(bool is_data); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/row_vector_local_type.hpp0000644000176200001440000000134413766554456026444 0ustar liggesusers#ifndef STAN_LANG_AST_ROW_VECTOR_LOCAL_TYPE_HPP #define STAN_LANG_AST_ROW_VECTOR_LOCAL_TYPE_HPP #include namespace stan { namespace lang { /** * Row vector local var type. */ struct row_vector_local_type { /** * Row vector length */ expression N_; /** * Construct a local var type with default values. */ row_vector_local_type(); /** * Construct a local var type with specified values. * Arg `N` should be int expression - constructor doesn't check. * * @param N num columns for row vector */ explicit row_vector_local_type(const expression& N); /** * Get N (num cols). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/matrix_block_type_def.hpp0000644000176200001440000000257313766554456026402 0ustar liggesusers#ifndef STAN_LANG_AST_MATRIX_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_MATRIX_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { matrix_block_type::matrix_block_type(const range &bounds, const offset_multiplier &ls, const expression &M, const expression &N) : bounds_(bounds), ls_(ls), M_(M), N_(N) { if (bounds.has_low() || bounds.has_high()) if (ls.has_offset() || ls.has_multiplier()) throw std::invalid_argument( "Block type cannot have both a bound and" "a offset/multiplier."); } matrix_block_type::matrix_block_type(const range &bounds, const expression &M, const expression &N) : bounds_(bounds), ls_(offset_multiplier()), M_(M), N_(N) {} matrix_block_type::matrix_block_type(const offset_multiplier &ls, const expression &M, const expression &N) : bounds_(range()), ls_(ls), M_(M), N_(N) {} matrix_block_type::matrix_block_type() : matrix_block_type(range(), nil(), nil()) {} range matrix_block_type::bounds() const { return bounds_; } offset_multiplier matrix_block_type::ls() const { return ls_; } expression matrix_block_type::M() const { return M_; } expression matrix_block_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/ill_formed_type_def.hpp0000644000176200001440000000057113766554456026034 0ustar liggesusers#ifndef STAN_LANG_AST_ILL_FORMED_TYPE_DEF_HPP #define STAN_LANG_AST_ILL_FORMED_TYPE_DEF_HPP #include #include namespace stan { namespace lang { ill_formed_type::ill_formed_type() : is_data_(false) {} std::string ill_formed_type::oid() const { return "00_ill_formed_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/cholesky_factor_corr_block_type_def.hpp0000644000176200001440000000102213766554456031266 0ustar liggesusers#ifndef STAN_LANG_AST_CHOLESKY_FACTOR_CORR_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_CHOLESKY_FACTOR_CORR_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { cholesky_factor_corr_block_type::cholesky_factor_corr_block_type( const expression& K) : K_(K) {} cholesky_factor_corr_block_type::cholesky_factor_corr_block_type() : cholesky_factor_corr_block_type(nil()) {} expression cholesky_factor_corr_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/int_block_type_def.hpp0000644000176200001440000000061513766554456025663 0ustar liggesusers#ifndef STAN_LANG_AST_INT_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_INT_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { int_block_type::int_block_type() : bounds_(nil(), nil()) {} int_block_type::int_block_type(const range& bounds) : bounds_(bounds) {} range int_block_type::bounds() const { return bounds_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/positive_ordered_block_type.hpp0000644000176200001440000000137613766554456027626 0ustar liggesusers#ifndef STAN_LANG_AST_POSITIVE_ORDERED_BLOCK_TYPE_HPP #define STAN_LANG_AST_POSITIVE_ORDERED_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Positive ordered block var type. */ struct positive_ordered_block_type { /** * Size of positive ordered vector */ expression K_; /** * Construct a block var type with default values. */ positive_ordered_block_type(); /** * Construct a block var type with specified values. * Size should be int expression - constructor doesn't check. * * @param K size */ explicit positive_ordered_block_type(const expression& K); /** * Get K (num cols). */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/bare_array_type_def.hpp0000644000176200001440000000345413766554456026032 0ustar liggesusers#ifndef STAN_LANG_AST_BARE_ARRAY_TYPE_DEF_HPP #define STAN_LANG_AST_BARE_ARRAY_TYPE_DEF_HPP #include #include #include namespace stan { namespace lang { bare_expr_type to_element_type(const bare_expr_type& el_type, size_t num_dims) { if (num_dims == 0) return ill_formed_type(); if (el_type.is_ill_formed_type()) return ill_formed_type(); if (el_type.is_array_type()) return ill_formed_type(); if (num_dims == 1) return el_type; // build single or nested array bare_array_type bat(el_type); bat.is_data_ = el_type.is_data(); bare_expr_type bet(bat); for (size_t i = 1; i < num_dims; ++i) { bet = bare_expr_type(bat); bat = bare_array_type(bet); bat.is_data_ = bet.is_data(); } return bet; } bare_array_type::bare_array_type() : element_type_(ill_formed_type()), is_data_(false) {} bare_array_type::bare_array_type(const bare_expr_type& el_type) : element_type_(el_type), is_data_(el_type.is_data()) {} bare_array_type::bare_array_type(const bare_expr_type& el_type, size_t num_dims) : element_type_(to_element_type(el_type, num_dims)), is_data_(el_type.is_data()) {} bare_expr_type bare_array_type::contains() const { bare_expr_type cur_type(element_type_); while (cur_type.is_array_type()) { cur_type = cur_type.array_element_type(); } return cur_type; } int bare_array_type::dims() const { if (element_type_.is_ill_formed_type()) return 0; int total = 1; bare_expr_type cur_type(element_type_); while (cur_type.is_array_type()) { total += 1; cur_type = cur_type.array_element_type(); } return total; } std::string bare_array_type::oid() const { std::string oid = std::string("array_") + element_type_.order_id(); return oid; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/matrix_block_type.hpp0000644000176200001440000000402113766554456025552 0ustar liggesusers#ifndef STAN_LANG_AST_MATRIX_BLOCK_TYPE_HPP #define STAN_LANG_AST_MATRIX_BLOCK_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Matrix block var type. */ struct matrix_block_type { /** * Bounds constraints */ range bounds_; /** * Offset and multiplier */ offset_multiplier ls_; /** * Number of rows (arg_1) */ expression M_; /** * Number of columns (arg_2) */ expression N_; /** * Construct a block var type with default values. */ matrix_block_type(); /** * Construct a block var type with specified values. * Sizes should be int expressions - constructor doesn't check. * * @param bounds variable upper and/or lower bounds * @param ls variable offset and multiplier * @param M num rows * @param N num columns */ matrix_block_type(const range &bounds, const offset_multiplier &ls, const expression &M, const expression &N); /** * Construct a block var type with specified values. * Sizes should be int expressions - constructor doesn't check. * * @param bounds variable upper and/or lower bounds * @param M num rows * @param N num columns */ matrix_block_type(const range &bounds, const expression &M, const expression &N); /** * Construct a block var type with specified values. * Sizes should be int expressions - constructor doesn't check. * * @param ls variable offset and multiplier * @param M num rows * @param N num columns */ matrix_block_type(const offset_multiplier &ls, const expression &M, const expression &N); /** * Get bounds. */ range bounds() const; /** * Get offset and multiplier. */ offset_multiplier ls() const; /** * Get M (num rows). */ expression M() const; /** * Get N (num cols). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/double_type.hpp0000644000176200001440000000123313766554456024350 0ustar liggesusers#ifndef STAN_LANG_AST_DOUBLE_TYPE_HPP #define STAN_LANG_AST_DOUBLE_TYPE_HPP #include namespace stan { namespace lang { /** * Double type. */ struct double_type { /** * True if variable type declared with "data" qualifier. */ bool is_data_; /** * Construct a double type with default values. */ double_type(); /** * Construct a double type with the specified data-only variable flag. * * @param is_data true when var is specified data-only */ explicit double_type(bool is_data); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/block_array_type_def.hpp0000644000176200001440000000346113766554456026211 0ustar liggesusers#ifndef STAN_LANG_AST_BLOCK_ARRAY_TYPE_DEF_HPP #define STAN_LANG_AST_BLOCK_ARRAY_TYPE_DEF_HPP #include #include namespace stan { namespace lang { block_array_type::block_array_type(const block_var_type& el_type, const expression& len) : element_type_(el_type), array_len_(len) {} block_array_type::block_array_type() : block_array_type(ill_formed_type(), nil()) {} block_array_type::block_array_type(const block_var_type& el_type, const std::vector& lens) : element_type_(el_type), array_len_(lens[0]) { if (lens.size() == 1) { return; } if (lens.size() == 0) { element_type_ = ill_formed_type(); return; } block_array_type tmp(el_type, lens[lens.size() - 1]); for (size_t i = lens.size() - 2; i > 0; --i) { tmp = block_array_type(tmp, lens[i]); } element_type_ = tmp; } int block_array_type::dims() const { int total = 1; for (block_var_type cur_type(element_type_); cur_type.is_array_type(); cur_type = cur_type.array_element_type()) ++total; return total; } block_var_type block_array_type::contains() const { block_var_type cur_type(element_type_); while (cur_type.is_array_type()) { cur_type = cur_type.array_element_type(); } return cur_type; } block_var_type block_array_type::element_type() const { return element_type_; } expression block_array_type::array_len() const { return array_len_; } std::vector block_array_type::array_lens() const { std::vector result = {array_len_}; for (block_var_type cur_type(element_type_); cur_type.is_array_type(); cur_type = cur_type.array_element_type()) result.push_back(cur_type.array_len()); return result; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/cov_matrix_block_type_def.hpp0000644000176200001440000000066513766554456027251 0ustar liggesusers#ifndef STAN_LANG_AST_COV_MATRIX_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_COV_MATRIX_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { cov_matrix_block_type::cov_matrix_block_type(const expression& K) : K_(K) {} cov_matrix_block_type::cov_matrix_block_type() : cov_matrix_block_type(nil()) {} expression cov_matrix_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/vector_block_type_def.hpp0000644000176200001440000000227713766554456026401 0ustar liggesusers#ifndef STAN_LANG_AST_VECTOR_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_VECTOR_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { vector_block_type::vector_block_type(const range &bounds, const offset_multiplier &ls, const expression &N) : bounds_(bounds), ls_(ls), N_(N) { if (bounds.has_low() || bounds.has_high()) if (ls.has_offset() || ls.has_multiplier()) throw std::invalid_argument( "Block type cannot have both a bound and" "a offset/multiplier."); } vector_block_type::vector_block_type(const range &bounds, const expression &N) : bounds_(bounds), ls_(offset_multiplier()), N_(N) {} vector_block_type::vector_block_type(const offset_multiplier &ls, const expression &N) : bounds_(range()), ls_(ls), N_(N) {} vector_block_type::vector_block_type() : vector_block_type(range(), nil()) {} range vector_block_type::bounds() const { return bounds_; } offset_multiplier vector_block_type::ls() const { return ls_; } expression vector_block_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/row_vector_local_type_def.hpp0000644000176200001440000000066513766554456027267 0ustar liggesusers#ifndef STAN_LANG_AST_ROW_VECTOR_LOCAL_TYPE_DEF_HPP #define STAN_LANG_AST_ROW_VECTOR_LOCAL_TYPE_DEF_HPP #include namespace stan { namespace lang { row_vector_local_type::row_vector_local_type(const expression& N) : N_(N) {} row_vector_local_type::row_vector_local_type() : row_vector_local_type(nil()) {} expression row_vector_local_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/double_block_type_def.hpp0000644000176200001440000000171013766554456026340 0ustar liggesusers#ifndef STAN_LANG_AST_DOUBLE_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_DOUBLE_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { double_block_type::double_block_type(const range &bounds, const offset_multiplier &ls) : bounds_(bounds), ls_(ls) { if (bounds.has_low() || bounds.has_high()) if (ls.has_offset() || ls.has_multiplier()) throw std::invalid_argument( "Block type cannot have both a bound and" "an offset/multiplier."); } double_block_type::double_block_type(const range &bounds) : bounds_(bounds) {} double_block_type::double_block_type(const offset_multiplier &ls) : ls_(ls) {} double_block_type::double_block_type() : double_block_type(range(), offset_multiplier()) {} range double_block_type::bounds() const { return bounds_; } offset_multiplier double_block_type::ls() const { return ls_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/vector_type_def.hpp0000644000176200001440000000063713766554456025225 0ustar liggesusers#ifndef STAN_LANG_AST_VECTOR_TYPE_DEF_HPP #define STAN_LANG_AST_VECTOR_TYPE_DEF_HPP #include #include namespace stan { namespace lang { vector_type::vector_type(bool is_data) : is_data_(is_data) {} vector_type::vector_type() : vector_type(false) {} std::string vector_type::oid() const { return "04_vector_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/vector_local_type.hpp0000644000176200001440000000126613766554456025560 0ustar liggesusers#ifndef STAN_LANG_AST_VECTOR_LOCAL_TYPE_HPP #define STAN_LANG_AST_VECTOR_LOCAL_TYPE_HPP #include namespace stan { namespace lang { /** * Vector local var type. */ struct vector_local_type { /** * Vector length */ expression N_; /** * Construct a local var type with default values. */ vector_local_type(); /** * Construct a local var type with specified values. * Length should be int expression - constructor doesn't check. * * @param N num rows */ explicit vector_local_type(const expression& N); /** * Get N (num rows). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/simplex_block_type_def.hpp0000644000176200001440000000063513766554456026554 0ustar liggesusers#ifndef STAN_LANG_AST_SIMPLEX_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_SIMPLEX_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { simplex_block_type::simplex_block_type(const expression& K) : K_(K) {} simplex_block_type::simplex_block_type() : simplex_block_type(nil()) {} expression simplex_block_type::K() const { return K_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/vector_local_type_def.hpp0000644000176200001440000000062513766554456026374 0ustar liggesusers#ifndef STAN_LANG_AST_VECTOR_LOCAL_TYPE_DEF_HPP #define STAN_LANG_AST_VECTOR_LOCAL_TYPE_DEF_HPP #include namespace stan { namespace lang { vector_local_type::vector_local_type(const expression& N) : N_(N) {} vector_local_type::vector_local_type() : vector_local_type(nil()) {} expression vector_local_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/double_type_def.hpp0000644000176200001440000000063713766554456025175 0ustar liggesusers#ifndef STAN_LANG_AST_DOUBLE_TYPE_DEF_HPP #define STAN_LANG_AST_DOUBLE_TYPE_DEF_HPP #include #include namespace stan { namespace lang { double_type::double_type(bool is_data) : is_data_(is_data) {} double_type::double_type() : double_type(false) {} std::string double_type::oid() const { return "03_double_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/bare_array_type.hpp0000644000176200001440000000253213766554456025210 0ustar liggesusers#ifndef STAN_LANG_AST_BARE_ARRAY_TYPE_HPP #define STAN_LANG_AST_BARE_ARRAY_TYPE_HPP #include #include namespace stan { namespace lang { struct bare_expr_type; /** * Bare array type for Stan variables and expressions (recursive). */ struct bare_array_type { /** * The array element type. */ bare_expr_type element_type_; /** * True if variable type declared with "data" qualifier. */ bool is_data_; /** * Construct a bare array type with default values. */ bare_array_type(); /** * Construct a bare array type with the specified element type. * * @param el_type element type */ explicit bare_array_type(const bare_expr_type& el_type); /** * Construct a bare array type with the specified element type * and the specified number of dimensions. * * @param el_type element type * @param num_dims */ bare_array_type(const bare_expr_type& el_type, size_t num_dims); /** * Returns type of elements stored in innermost array. */ bare_expr_type contains() const; /** * Returns number of array dimensions for well-formed types. * Returns 0 if element type is ill-formed. */ int dims() const; /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/corr_matrix_block_type.hpp0000644000176200001440000000140213766554456026577 0ustar liggesusers#ifndef STAN_LANG_AST_CORR_MATRIX_BLOCK_TYPE_HPP #define STAN_LANG_AST_CORR_MATRIX_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Correlation matrix block var type. */ struct corr_matrix_block_type { /** * Number of rows and columns */ expression K_; /** * Construct a block var type with default values. */ corr_matrix_block_type(); /** * Construct a block var type with specified values. * Size should be int expression - constructor doesn't check. * * @param K corr matrix size */ explicit corr_matrix_block_type(const expression& K); /** * Get K (corr matrix num rows, columns) */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/ill_formed_type.hpp0000644000176200001440000000101513766554456025210 0ustar liggesusers#ifndef STAN_LANG_AST_ILL_FORMED_TYPE_HPP #define STAN_LANG_AST_ILL_FORMED_TYPE_HPP #include namespace stan { namespace lang { /** * Ill_Formed type. */ struct ill_formed_type { /** * True if variable type declared with "data" qualifier. * Always false. */ bool is_data_; /** * Construct an ill_formed type with default values. */ ill_formed_type(); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/void_type_def.hpp0000644000176200001440000000051713766554456024661 0ustar liggesusers#ifndef STAN_LANG_AST_VOID_TYPE_DEF_HPP #define STAN_LANG_AST_VOID_TYPE_DEF_HPP #include #include namespace stan { namespace lang { void_type::void_type() : is_data_(false) {} std::string void_type::oid() const { return "01_void_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/row_vector_block_type_def.hpp0000644000176200001440000000250013766554456027255 0ustar liggesusers#ifndef STAN_LANG_AST_ROW_VECTOR_BLOCK_TYPE_DEF_HPP #define STAN_LANG_AST_ROW_VECTOR_BLOCK_TYPE_DEF_HPP #include namespace stan { namespace lang { row_vector_block_type::row_vector_block_type(const range &bounds, const offset_multiplier &ls, const expression &N) : bounds_(bounds), ls_(ls), N_(N) { if (bounds.has_low() || bounds.has_high()) if (ls.has_offset() || ls.has_multiplier()) throw std::invalid_argument( "Block type cannot have both a bound and" "a offset/multiplier."); } row_vector_block_type::row_vector_block_type(const range &bounds, const expression &N) : bounds_(bounds), ls_(offset_multiplier()), N_(N) {} row_vector_block_type::row_vector_block_type(const offset_multiplier &ls, const expression &N) : bounds_(range()), ls_(ls), N_(N) {} row_vector_block_type::row_vector_block_type() : row_vector_block_type(range(), nil()) {} range row_vector_block_type::bounds() const { return bounds_; } offset_multiplier row_vector_block_type::ls() const { return ls_; } expression row_vector_block_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/local_var_type.hpp0000644000176200001440000001137713766554456025052 0ustar liggesusers#ifndef STAN_LANG_AST_LOCAL_VAR_TYPE_HPP #define STAN_LANG_AST_LOCAL_VAR_TYPE_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Local variable types have sized container types. */ struct local_array_type; struct double_type; struct ill_formed_type; struct int_type; struct matrix_local_type; struct row_vector_local_type; struct vector_local_type; struct local_var_type { /** * Recursive wrapper for local variable types. */ typedef boost::variant, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper > local_t; /** * The local variable type held by this wrapper. */ local_t var_type_; /** * Construct a bare var type with default values. */ local_var_type(); /** * Construct a local var type * * @param x local variable type raw variant type. */ local_var_type(const local_var_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const ill_formed_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const double_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const int_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const matrix_local_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const row_vector_local_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const vector_local_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const local_array_type& x); // NOLINT(runtime/explicit) /** * Construct a local var type with the specified type. * * @param x local variable type */ local_var_type(const local_t& x); // NOLINT(runtime/explicit) /** * Returns expression for length of vector types or * number of rows for matrix type, nil otherwise. */ expression arg1() const; /** * Returns expression for number of columns for matrix types, * nil otherwise. */ expression arg2() const; /** * If `var_type` is `local_array_type`, returns the innermost type * contained in the array, otherwise will return `ill_formed_type`. */ local_var_type array_contains() const; /** * Returns number of array dimensions for this type. * Returns 0 for non-array types. */ int array_dims() const; /** * Returns array element type if `var_type_` is `local_array_type`, * ill_formed_type otherwise. (Call `is_array_type()` first.) */ local_var_type array_element_type() const; /** * Returns array length for local_array_type, nil otherwise. */ expression array_len() const; /** * Returns vector of array lengths for local_array_type, * empty vector otherwise. */ std::vector array_lens() const; /** * Returns equivalent bare_expr_type (unsized) for this local type. */ bare_expr_type bare_type() const; /** * If array type, returns innermost type, * otherwise returns this type. */ local_var_type innermost_type() const; /** * Returns true if `var_type_` is `local_array_type`, false otherwise. */ bool is_array_type() const; /** * Returns Stan language type name. */ std::string name() const; /** * Returns total number of dimensions for container type. * Returns 0 for scalar types. */ int num_dims() const; }; /** * Stream a user-readable version of the local_var_type to the * specified output stream, returning the specified argument * output stream to allow chaining. * * @param o output stream * @param x expression type * @return argument output stream */ std::ostream& operator<<(std::ostream& o, const local_var_type& x); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/bare_expr_type.hpp0000644000176200001440000001537613766554456025062 0ustar liggesusers#ifndef STAN_LANG_AST_BARE_EXPR_TYPE_HPP #define STAN_LANG_AST_BARE_EXPR_TYPE_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Bare type for Stan variables and expressions. */ struct bare_array_type; struct double_type; struct ill_formed_type; struct int_type; struct matrix_type; struct row_vector_type; struct vector_type; struct void_type; struct bare_expr_type { /** * Recursive wrapper for bare types. */ typedef boost::variant, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper > bare_t; /** * The bare type held by this wrapper. */ bare_t bare_type_; /** * Construct a bare var type with default values. */ bare_expr_type(); /** * Construct a bare var type with the specified variant type. * * @param type bare type raw variant type. */ bare_expr_type(const bare_expr_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const ill_formed_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const double_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const int_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const matrix_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const row_vector_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const vector_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const void_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const bare_array_type& type); // NOLINT(runtime/explicit) /** * Construct a bare type with the specified type. * * @param type bare type */ bare_expr_type(const bare_t& type); // NOLINT(runtime/explicit) /** * Return true if the specified bare type is the same as * this bare type. * * @param bare_type Other bare type. * @return result of equality test. */ bool operator==(const bare_expr_type& bare_type) const; /** * Return true if the specified bare type is not the same as * this bare type. * * @param bare_type Other bare type. * @return result of inequality test. */ bool operator!=(const bare_expr_type& bare_type) const; /** * Return true if this bare type `order_id_` * is less than that of the specified bare type. * * @param bare_type Other bare type. * @return result of comparison. */ bool operator<(const bare_expr_type& bare_type) const; /** * Return true if this bare type `order_id_` * is less than or equal to that of the specified bare type. * * @param bare_type Other bare type. * @return result of comparison. */ bool operator<=(const bare_expr_type& bare_type) const; /** * Return true if this bare type `order_id_` * is greater than that of the specified bare type. * * @param bare_type Other bare type. * @return result of comparison. */ bool operator>(const bare_expr_type& bare_type) const; /** * Return true if this bare type `order_id_` * is greater than or equal to that of the specified bare type. * * @param bare_type Other bare type. * @return result of comparison. */ bool operator>=(const bare_expr_type& bare_type) const; /** * Returns the element type for `bare_array_type`, otherwise * will return `ill_formed_type`. */ bare_expr_type array_element_type() const; /** * If `bare_type` is `bare_array_type`, returns the innermost type * contained in the array, otherwise will return `ill_formed_type`. */ bare_expr_type array_contains() const; /** * Returns number of array dimensions for this type. * Returns 0 for non-array types. */ int array_dims() const; /** * If array type, returns bare_expr_type of innermost type, * otherwise returns this type. */ bare_expr_type innermost_type() const; /** * Returns true if `bare_type_` is `bare_array_type`, false otherwise. */ bool is_array_type() const; /** * Returns value of `bare_type_` member var `is_data_`. */ bool is_data() const; /** * Returns true if `bare_type_` is `double_type`, false otherwise. */ bool is_double_type() const; /** * Returns true if `bare_type_` is `ill_formed_type`, false otherwise. */ bool is_ill_formed_type() const; /** * Returns true if `bare_type_` is `int_type`, false otherwise. */ bool is_int_type() const; /** * Returns true if `bare_type_` is `matrix_type`, false otherwise. */ bool is_matrix_type() const; /** * Returns true if `bare_type_` is `int_type` or `double_type`, false * otherwise. */ bool is_primitive() const; /** * Returns true if `bare_type_` is `row_vector_type`, false otherwise. */ bool is_row_vector_type() const; /** * Returns true if `bare_type_` is `vector_type`, false otherwise. */ bool is_vector_type() const; /** * Returns true if `bare_type_` is `void_type`, false otherwise. */ bool is_void_type() const; /** * Returns total number of dimensions for container type. * Returns 0 for scalar types. */ int num_dims() const; /** * Returns order id for this bare type. */ std::string order_id() const; /** * Set flag `is_data` to true */ void set_is_data(); }; /** * Stream a user-readable version of the bare_expr_type to the * specified output stream, returning the specified argument * output stream to allow chaining. * * @param o output stream * @param x expression type * @return argument output stream */ std::ostream& operator<<(std::ostream& o, const bare_expr_type& x); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/int_type.hpp0000644000176200001440000000120713766554456023671 0ustar liggesusers#ifndef STAN_LANG_AST_INT_TYPE_HPP #define STAN_LANG_AST_INT_TYPE_HPP #include namespace stan { namespace lang { /** * Integer type. */ struct int_type { /** * True if variable type declared with "data" qualifier. */ bool is_data_; /** * Construct a int type with default values. */ int_type(); /** * Construct a int type with the specified data-only variable flag. * * @param is_data true when var is specified data-only */ explicit int_type(bool is_data); /** * Returns identity string for this type. */ std::string oid() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/row_vector_block_type.hpp0000644000176200001440000000347313766554456026451 0ustar liggesusers#ifndef STAN_LANG_AST_ROW_VECTOR_BLOCK_TYPE_HPP #define STAN_LANG_AST_ROW_VECTOR_BLOCK_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Row vector block var type. */ struct row_vector_block_type { /** * Bounds constraints */ range bounds_; /** * Offset and multiplier */ offset_multiplier ls_; /** * Row vector length */ expression N_; /** * Construct a block var type with default values. */ row_vector_block_type(); /** * Construct a block var type with specified values. * Arg `N` should be int expression - constructor doesn't check. * * @param bounds variable upper and/or lower bounds * @param ls variable offset and multiplier * @param N num columns for row vector */ row_vector_block_type(const range &bounds, const offset_multiplier &ls, const expression &N); /** * Construct a block var type with specified values. * Arg `N` should be int expression - constructor doesn't check. * * @param bounds variable upper and/or lower bounds * @param N num columns for row vector */ row_vector_block_type(const range &bounds, const expression &N); /** * Construct a block var type with specified values. * Arg `N` should be int expression - constructor doesn't check. * * @param ls variable offset and multiplier * @param N num columns for row vector */ row_vector_block_type(const offset_multiplier &ls, const expression &N); /** * Get bounds. */ range bounds() const; /** * Get offset and multiplier. */ offset_multiplier ls() const; /** * Get N (num cols). */ expression N() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/cov_matrix_block_type.hpp0000644000176200001440000000137213766554456026427 0ustar liggesusers#ifndef STAN_LANG_AST_COV_MATRIX_BLOCK_TYPE_HPP #define STAN_LANG_AST_COV_MATRIX_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Covariance matrix block var type. */ struct cov_matrix_block_type { /** * Number of rows and columns */ expression K_; /** * Construct a block var type with default values. */ cov_matrix_block_type(); /** * Construct a block var type with specified values. * Size should be int expression - constructor doesn't check. * * @param K cov matrix size */ explicit cov_matrix_block_type(const expression& K); /** * Get K (cov matrix num rows, columns) */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/matrix_local_type_def.hpp0000644000176200001440000000076413766554456026402 0ustar liggesusers#ifndef STAN_LANG_AST_MATRIX_LOCAL_TYPE_DEF_HPP #define STAN_LANG_AST_MATRIX_LOCAL_TYPE_DEF_HPP #include namespace stan { namespace lang { matrix_local_type::matrix_local_type(const expression& M, const expression& N) : M_(M), N_(N) {} matrix_local_type::matrix_local_type() : matrix_local_type(nil(), nil()) {} expression matrix_local_type::M() const { return M_; } expression matrix_local_type::N() const { return N_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/order_id.hpp0000644000176200001440000000064013766554456023625 0ustar liggesusers#ifndef STAN_LANG_AST_TYPE_ORDER_ID_HPP #define STAN_LANG_AST_TYPE_ORDER_ID_HPP #include namespace stan { namespace lang { /** * String used to identify and impose lexicographic ordering on * variable and expression types. */ struct order_id { /** * String constant for variable and expression type. */ static const std::string ORDER_ID; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/ordered_block_type.hpp0000644000176200001440000000135113766554456025675 0ustar liggesusers#ifndef STAN_LANG_AST_ORDERED_BLOCK_TYPE_HPP #define STAN_LANG_AST_ORDERED_BLOCK_TYPE_HPP #include #include namespace stan { namespace lang { /** * Ordered block var type. */ struct ordered_block_type { /** * Length of ordered vector */ expression K_; /** * Construct a block var type with default values. */ ordered_block_type(); /** * Construct a block var type with specified values. * Size should be int expression - constructor doesn't check. * * @param K size */ explicit ordered_block_type(const expression& K); /** * Get K (num cols). */ expression K() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/local_array_type.hpp0000644000176200001440000000336313766554456025374 0ustar liggesusers#ifndef STAN_LANG_AST_LOCAL_ARRAY_TYPE_HPP #define STAN_LANG_AST_LOCAL_ARRAY_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Local array type for Stan variables and expressions (recursive). */ struct local_array_type { /** * The array element type. */ local_var_type element_type_; /** * The length of this array. */ expression array_len_; /** * Construct an array local var type with default values. */ local_array_type(); /** * Construct a local array type with the specified element type * and array length. * Length should be int expression - constructor doesn't check. * * @param el_type element type * @param len array length */ local_array_type(const local_var_type& el_type, const expression& len); /** * Construct a multi-dimensional local array type with the * specified element sized dimensions. * Lengths should be int expression - constructor doesn't check. * * @param el_type element type * @param lens vector of array lengths */ local_array_type(const local_var_type& el_type, const std::vector& lens); /** * Returns type of elements stored in innermost array. */ local_var_type contains() const; /** * Returns number of array dimensions. */ int dims() const; /** * Returns top-level array element type. */ local_var_type element_type() const; /** * Returns the length of this array. */ expression array_len() const; /** * Returns a vector of lengths of all array dimensions. */ std::vector array_lens() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/local_array_type_def.hpp0000644000176200001440000000346113766554456026211 0ustar liggesusers#ifndef STAN_LANG_AST_LOCAL_ARRAY_TYPE_DEF_HPP #define STAN_LANG_AST_LOCAL_ARRAY_TYPE_DEF_HPP #include #include namespace stan { namespace lang { local_array_type::local_array_type(const local_var_type& el_type, const expression& len) : element_type_(el_type), array_len_(len) {} local_array_type::local_array_type() : local_array_type(ill_formed_type(), nil()) {} local_array_type::local_array_type(const local_var_type& el_type, const std::vector& lens) : element_type_(el_type), array_len_(lens[0]) { if (lens.size() == 1) { return; } if (lens.size() == 0) { element_type_ = ill_formed_type(); return; } local_array_type tmp(el_type, lens[lens.size() - 1]); for (size_t i = lens.size() - 2; i > 0; --i) { tmp = local_array_type(tmp, lens[i]); } element_type_ = tmp; } int local_array_type::dims() const { int total = 1; for (local_var_type cur_type(element_type_); cur_type.is_array_type(); cur_type = cur_type.array_element_type()) ++total; return total; } local_var_type local_array_type::contains() const { local_var_type cur_type(element_type_); while (cur_type.is_array_type()) { cur_type = cur_type.array_element_type(); } return cur_type; } local_var_type local_array_type::element_type() const { return element_type_; } expression local_array_type::array_len() const { return array_len_; } std::vector local_array_type::array_lens() const { std::vector result = {array_len_}; for (local_var_type cur_type(element_type_); cur_type.is_array_type(); cur_type = cur_type.array_element_type()) result.push_back(cur_type.array_len()); return result; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/local_var_type_def.hpp0000644000176200001440000000657013766554456025667 0ustar liggesusers#ifndef STAN_LANG_AST_LOCAL_VAR_TYPE_DEF_HPP #define STAN_LANG_AST_LOCAL_VAR_TYPE_DEF_HPP #include #include #include #include #include #include namespace stan { namespace lang { local_var_type::local_var_type() : var_type_(ill_formed_type()) {} local_var_type::local_var_type(const local_var_type& x) : var_type_(x.var_type_) {} local_var_type::local_var_type(const local_t& x) : var_type_(x) {} local_var_type::local_var_type(const ill_formed_type& x) : var_type_(x) {} local_var_type::local_var_type(const int_type& x) : var_type_(x) {} local_var_type::local_var_type(const double_type& x) : var_type_(x) {} local_var_type::local_var_type(const vector_local_type& x) : var_type_(x) {} local_var_type::local_var_type(const row_vector_local_type& x) : var_type_(x) {} local_var_type::local_var_type(const matrix_local_type& x) : var_type_(x) {} local_var_type::local_var_type(const local_array_type& x) : var_type_(x) {} expression local_var_type::arg1() const { var_type_arg1_vis vis; return boost::apply_visitor(vis, var_type_); } expression local_var_type::arg2() const { var_type_arg2_vis vis; return boost::apply_visitor(vis, var_type_); } local_var_type local_var_type::array_contains() const { if (boost::get(&var_type_)) { local_array_type vt = boost::get(var_type_); return vt.contains(); } return ill_formed_type(); } int local_var_type::array_dims() const { if (boost::get(&var_type_)) { local_array_type vt = boost::get(var_type_); return vt.dims(); } return 0; } local_var_type local_var_type::array_element_type() const { if (boost::get(&var_type_)) { local_array_type vt = boost::get(var_type_); return vt.element_type(); } return ill_formed_type(); } expression local_var_type::array_len() const { if (boost::get(&var_type_)) { local_array_type vt = boost::get(var_type_); return vt.array_len(); } return expression(nil()); } std::vector local_var_type::array_lens() const { if (boost::get(&var_type_)) { local_array_type vt = boost::get(var_type_); return vt.array_lens(); } return std::vector(); } bare_expr_type local_var_type::bare_type() const { bare_type_vis vis; return boost::apply_visitor(vis, var_type_); } local_var_type local_var_type::innermost_type() const { if (boost::get(&var_type_)) { local_array_type vt = boost::get(var_type_); return vt.contains(); } return var_type_; } bool local_var_type::is_array_type() const { if (boost::get(&var_type_)) return true; return false; } std::string local_var_type::name() const { var_type_name_vis vis; return boost::apply_visitor(vis, var_type_); } int local_var_type::num_dims() const { return this->bare_type().num_dims(); } std::ostream& operator<<(std::ostream& o, const local_var_type& var_type) { write_bare_expr_type(o, var_type.bare_type()); return o; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/int_block_type.hpp0000644000176200001440000000121313766554456025040 0ustar liggesusers#ifndef STAN_LANG_AST_INT_BLOCK_TYPE_HPP #define STAN_LANG_AST_INT_BLOCK_TYPE_HPP #include namespace stan { namespace lang { /** * Integer block var type. */ struct int_block_type { /** * Bounds constraints */ range bounds_; /** * Construct a block var type with default values. */ int_block_type(); /** * Construct a block var type with specified values. * * @param bounds variable upper and/or lower bounds */ explicit int_block_type(const range& bounds); /** * Get bounds constraints. */ range bounds() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/bare_expr_type_def.hpp0000644000176200001440000001303713766554456025670 0ustar liggesusers#ifndef STAN_LANG_AST_BARE_EXPR_TYPE_DEF_HPP #define STAN_LANG_AST_BARE_EXPR_TYPE_DEF_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { bare_expr_type::bare_expr_type() : bare_type_(ill_formed_type()) {} bare_expr_type::bare_expr_type(const bare_expr_type& x) : bare_type_(x.bare_type_) {} bare_expr_type::bare_expr_type(const bare_t& x) : bare_type_(x) {} bare_expr_type::bare_expr_type(const ill_formed_type& x) : bare_type_(ill_formed_type()) {} bare_expr_type::bare_expr_type(const void_type& x) : bare_type_(void_type()) {} bare_expr_type::bare_expr_type(const int_type& x) : bare_type_(int_type(x.is_data_)) {} bare_expr_type::bare_expr_type(const double_type& x) : bare_type_(double_type(x.is_data_)) {} bare_expr_type::bare_expr_type(const vector_type& x) : bare_type_(vector_type(x.is_data_)) {} bare_expr_type::bare_expr_type(const row_vector_type& x) : bare_type_(row_vector_type(x.is_data_)) {} bare_expr_type::bare_expr_type(const matrix_type& x) : bare_type_(matrix_type(x.is_data_)) {} bare_expr_type::bare_expr_type(const bare_array_type& x) : bare_type_(bare_array_type(x.element_type_)) {} bare_expr_type bare_expr_type::array_element_type() const { if (boost::get(&bare_type_)) { bare_array_type bat = boost::get(bare_type_); return bat.element_type_; } return ill_formed_type(); } bare_expr_type bare_expr_type::array_contains() const { if (boost::get(&bare_type_)) { bare_array_type bat = boost::get(bare_type_); return bat.contains(); } return ill_formed_type(); } int bare_expr_type::array_dims() const { if (boost::get(&bare_type_)) { bare_array_type bat = boost::get(bare_type_); return bat.dims(); } return 0; } bare_expr_type bare_expr_type::innermost_type() const { if (boost::get(&bare_type_)) { bare_array_type bat = boost::get(bare_type_); return bat.contains(); } return bare_type_; } bool bare_expr_type::is_array_type() const { if (boost::get(&bare_type_)) return true; return false; } bool bare_expr_type::is_data() const { bare_type_is_data_vis vis; return boost::apply_visitor(vis, bare_type_); } bool bare_expr_type::is_double_type() const { return order_id() == double_type().oid(); } bool bare_expr_type::is_ill_formed_type() const { return order_id() == ill_formed_type().oid(); } bool bare_expr_type::is_int_type() const { return order_id() == int_type().oid(); } bool bare_expr_type::is_matrix_type() const { return order_id() == matrix_type().oid(); } bool bare_expr_type::is_primitive() const { return order_id() == int_type().oid() || order_id() == double_type().oid(); } bool bare_expr_type::is_row_vector_type() const { return order_id() == row_vector_type().oid(); } bool bare_expr_type::is_vector_type() const { return order_id() == vector_type().oid(); } bool bare_expr_type::is_void_type() const { return order_id() == void_type().oid(); } int bare_expr_type::num_dims() const { bare_type_total_dims_vis vis; return boost::apply_visitor(vis, bare_type_); } std::string bare_expr_type::order_id() const { bare_type_order_id_vis vis; return boost::apply_visitor(vis, bare_type_); } void bare_expr_type::set_is_data() { bare_type_set_is_data_vis vis; return boost::apply_visitor(vis, bare_type_); } bool bare_expr_type::operator==(const bare_expr_type& bare_type) const { return order_id() == bare_type.order_id(); } bool bare_expr_type::operator!=(const bare_expr_type& bare_type) const { return order_id() != bare_type.order_id(); } bool bare_expr_type::operator<(const bare_expr_type& bare_type) const { if (is_data() == bare_type.is_data()) return order_id() < bare_type.order_id(); return is_data() < bare_type.is_data(); } bool bare_expr_type::operator>(const bare_expr_type& bare_type) const { if (is_data() == bare_type.is_data()) return order_id() > bare_type.order_id(); return is_data() > bare_type.is_data(); } bool bare_expr_type::operator<=(const bare_expr_type& bare_type) const { if (is_data() == bare_type.is_data()) return order_id() <= bare_type.order_id(); return is_data() <= bare_type.is_data(); } bool bare_expr_type::operator>=(const bare_expr_type& bare_type) const { if (is_data() == bare_type.is_data()) return order_id() >= bare_type.order_id(); return is_data() >= bare_type.is_data(); } std::ostream& operator<<(std::ostream& o, const bare_expr_type& bare_type) { write_bare_expr_type(o, bare_type); return o; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/matrix_type_def.hpp0000644000176200001440000000063713766554456025227 0ustar liggesusers#ifndef STAN_LANG_AST_MATRIX_TYPE_DEF_HPP #define STAN_LANG_AST_MATRIX_TYPE_DEF_HPP #include #include namespace stan { namespace lang { matrix_type::matrix_type(bool is_data) : is_data_(is_data) {} matrix_type::matrix_type() : matrix_type(false) {} std::string matrix_type::oid() const { return "06_matrix_type"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/type/double_block_type.hpp0000644000176200001440000000241213766554456025522 0ustar liggesusers#ifndef STAN_LANG_AST_DOUBLE_BLOCK_TYPE_HPP #define STAN_LANG_AST_DOUBLE_BLOCK_TYPE_HPP #include #include namespace stan { namespace lang { /** * Double block var type. */ struct double_block_type { /** * Bounds constraints */ range bounds_; /** * Offset and multiplier */ offset_multiplier ls_; /** * Construct a block var type with default values. */ double_block_type(); /** * Construct a block var type with specified values. * * @param bounds variable upper and/or lower bounds * @param ls variable offset and multiplier */ explicit double_block_type(const range &bounds, const offset_multiplier &ls); /** * Construct a block var type with specified values. * * @param bounds variable upper and/or lower bounds */ explicit double_block_type(const range &bounds); /** * Construct a block var type with specified values. * * @param ls variable offset and multiplier */ explicit double_block_type(const offset_multiplier &ls); /** * Get bounds constraints. */ range bounds() const; /** * Get offset and multiplier. */ offset_multiplier ls() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/origin_block.hpp0000644000176200001440000000366713766554456023532 0ustar liggesusers#ifndef STAN_LANG_AST_ORIGIN_BLOCK_HPP #define STAN_LANG_AST_ORIGIN_BLOCK_HPP namespace stan { namespace lang { /** * The type of a variable indicating where a variable was * declared. This is a typedef rather than an enum to get around * forward declaration issues with enums in header files. */ typedef int origin_block; /** * Origin of variable is the name of the model. */ const int model_name_origin = 0; /** * The origin of the variable is the data block. */ const int data_origin = 1; /** * The origin of the variable is the transformed data block. */ const int transformed_data_origin = 2; /** * The origin of the variable is the parameter block. */ const int parameter_origin = 3; /** * The origin of the variable is the transformed parameter block. */ const int transformed_parameter_origin = 4; /** * The origin of the variable is generated quantities. */ const int derived_origin = 5; /** * The variable arose as a function argument to a non-void * function that does not end in _lp or _rng. */ const int function_argument_origin = 6; /** * The variable arose as an argument to a non-void function with * the _lp suffix. */ const int function_argument_origin_lp = 7; /** * The variable arose as an argument to a non-void function with * the _rng suffix. */ const int function_argument_origin_rng = 8; /** * The variable arose as an argument to a function returning void * that does not have the _lp or _rng suffix. */ const int void_function_argument_origin = 9; /** * The variable arose as an argument to a function returning void * with _lp suffix. function returning void */ const int void_function_argument_origin_lp = 10; /** * The variable arose as an argument to a function returning void * with an _rng suffix. */ const int void_function_argument_origin_rng = 11; /** * The variable arose as a loop identifier */ const int loop_identifier_origin = 12; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/0000755000176200001440000000000013766554456021271 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/ast/node/variable.hpp0000644000176200001440000000145313766554456023572 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_VARIABLE_HPP #define STAN_LANG_AST_NODE_VARIABLE_HPP #include #include #include namespace stan { namespace lang { /** * Structure to hold a variable. */ struct variable { /** * Name of variable. */ std::string name_; /** * Type of variable. */ bare_expr_type type_; /** * Construct a default variable. */ variable(); /** * Construct a variable with the specified name and nil type. * * @param name variable name */ variable(const std::string& name); // NOLINT(runtime/explicit) /** * Set the variable type. * * @param bare_type bare expression type */ void set_type(const bare_expr_type& bare_type); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/conditional_op_def.hpp0000644000176200001440000000117613766554456025626 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_CONDITIONAL_OP_DEF_HPP #define STAN_LANG_AST_NODE_CONDITIONAL_OP_DEF_HPP #include namespace stan { namespace lang { conditional_op::conditional_op() : has_var_(false) {} conditional_op::conditional_op(const expression& cond, const expression& true_val, const expression& false_val) : cond_(cond), true_val_(true_val), false_val_(false_val), type_(promote_primitive(true_val.bare_type(), false_val.bare_type())), has_var_(false), scope_() {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/row_vector_expr.hpp0000644000176200001440000000202213766554456025225 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ROW_VECTOR_EXPR_HPP #define STAN_LANG_AST_NODE_ROW_VECTOR_EXPR_HPP #include #include #include namespace stan { namespace lang { struct expresssion; /** * Structure to hold a row_vector expression. */ struct row_vector_expr { /** * Sequence of expressions for row_vector values. */ std::vector args_; /** * True if there is a variable within any of the expressions * that is a parameter, transformed parameter, or non-integer * local variable. */ bool has_var_; /** * Scope of this row_vector expression. * */ scope row_vector_expr_scope_; /** * Construct a default row_vector expression. */ row_vector_expr(); /** * Construct an row_vector expression from the specified sequence of * expressions. * * @param args sequence of arguments */ explicit row_vector_expr(const std::vector& args); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/row_vector_expr_def.hpp0000644000176200001440000000072213766554456026050 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ROW_VECTOR_EXPR_DEF_HPP #define STAN_LANG_AST_NODE_ROW_VECTOR_EXPR_DEF_HPP #include #include namespace stan { namespace lang { row_vector_expr::row_vector_expr() : args_(), has_var_(false), row_vector_expr_scope_() {} row_vector_expr::row_vector_expr(const std::vector& args) : args_(args), has_var_(false), row_vector_expr_scope_() {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/statement.hpp0000644000176200001440000001341513766554456024012 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_STATEMENT_HPP #define STAN_LANG_AST_NODE_STATEMENT_HPP #include #include namespace stan { namespace lang { struct nil; struct assgn; struct sample; struct increment_log_prob_statement; struct expression; struct statements; struct for_statement; struct for_array_statement; struct for_matrix_statement; struct conditional_statement; struct while_statement; struct break_continue_statement; struct print_statement; struct reject_statement; struct return_statement; struct no_op_statement; /** * Structure to wrap the variant type of statements. */ struct statement { /** * The variant type of statements. */ typedef boost::variant, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper > statement_t; /** * Construct a default (nil) statement. */ statement(); /** * Construct a statement from the specified raw variant type * wrapper. * * @param st statement variant type */ statement(const statement_t& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const nil& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const assgn& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const sample& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const increment_log_prob_statement& st); // NOLINT /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const expression& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const statements& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const for_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const for_array_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const for_matrix_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const conditional_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const while_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const break_continue_statement& st); // NOLINT /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const print_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const reject_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const no_op_statement& st); // NOLINT(runtime/explicit) /** * Construct a statement variant type wrapper from the specified * basic statement. * * @param st basic statement */ statement(const return_statement& st); // NOLINT(runtime/explicit) /** * Return true if the basic statement held by the variant type * in this wrapper is the no-op statement. * * @return true if this is a no-op statement wrapper */ bool is_no_op_statement() const; /** * The statement variant type held by this wrapper. */ statement_t statement_; /** * The line in the source code where the statement begins. */ std::size_t begin_line_; /** * The line in the source code where the statement ends. */ std::size_t end_line_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/multi_idx.hpp0000644000176200001440000000110713766554456023777 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_MULTI_IDX_HPP #define STAN_LANG_AST_NODE_MULTI_IDX_HPP #include namespace stan { namespace lang { struct multi_idx { /** * Multiple indexes (array of integers). */ expression idxs_; /** * Construct a default (nil) multi-index. */ multi_idx(); /** * Construct a multiple index from the specified indexes. * * @param idxs indexes expression (array of integers) */ multi_idx(const expression& idxs); // NOLINT(runtime/explicit) }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/break_continue_statement.hpp0000644000176200001440000000131313766554456027054 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_BREAK_CONTINUE_STATEMENT_HPP #define STAN_LANG_AST_NODE_BREAK_CONTINUE_STATEMENT_HPP #include namespace stan { namespace lang { /** * AST structure for break and continue statements. */ struct break_continue_statement { /** * Construct an uninitialized break or continue statement. */ break_continue_statement(); /** * Construct a break or continue statement that generates the * specified string. * * @param generate "break" or "continue" */ explicit break_continue_statement(const std::string& generate); /** * Text to generate, "break" or "continue". */ std::string generate_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/algebra_solver_control_def.hpp0000644000176200001440000000143313766554456027350 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ALGEBRA_SOLVER_CONTROL_DEF_HPP #define STAN_LANG_AST_NODE_ALGEBRA_SOLVER_CONTROL_DEF_HPP #include #include namespace stan { namespace lang { algebra_solver_control::algebra_solver_control() {} algebra_solver_control::algebra_solver_control( const std::string& system_function_name, const expression& y, const expression& theta, const expression& x_r, const expression& x_i, const expression& rel_tol, const expression& fun_tol, const expression& max_num_steps) : system_function_name_(system_function_name), y_(y), theta_(theta), x_r_(x_r), x_i_(x_i), rel_tol_(rel_tol), fun_tol_(fun_tol), max_num_steps_(max_num_steps) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/no_op_statement.hpp0000644000176200001440000000040313766554456025175 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_NO_OP_STATEMENT_HPP #define STAN_LANG_AST_NODE_NO_OP_STATEMENT_HPP namespace stan { namespace lang { /** * AST node for the no-operation statement. */ struct no_op_statement {}; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/integrate_ode_control_def.hpp0000644000176200001440000000172113766554456027172 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INTEGRATE_ODE_CONTROL_DEF_HPP #define STAN_LANG_AST_NODE_INTEGRATE_ODE_CONTROL_DEF_HPP #include #include namespace stan { namespace lang { integrate_ode_control::integrate_ode_control() {} integrate_ode_control::integrate_ode_control( const std::string& integration_function_name, const std::string& system_function_name, const expression& y0, const expression& t0, const expression& ts, const expression& theta, const expression& x, const expression& x_int, const expression& rel_tol, const expression& abs_tol, const expression& max_num_steps) : integration_function_name_(integration_function_name), system_function_name_(system_function_name), y0_(y0), t0_(t0), ts_(ts), theta_(theta), x_(x), x_int_(x_int), rel_tol_(rel_tol), abs_tol_(abs_tol), max_num_steps_(max_num_steps) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/reject_statement.hpp0000644000176200001440000000136013766554456025342 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_REJECT_STATEMENT_HPP #define STAN_LANG_AST_NODE_REJECT_STATEMENT_HPP #include #include #include namespace stan { namespace lang { /** * AST node for the reject statement. */ struct reject_statement { /** * Construct an empty reject statement. */ reject_statement(); /** * Construct a reject statement from the specified sequence of * printable objects. * * @param[in] printables sequence of items to print */ reject_statement(const std::vector& printables); // NOLINT /** * Sequence of objects to print in output message. */ std::vector printables_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/matrix_expr.hpp0000644000176200001440000000177113766554456024352 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_MATRIX_EXPR_HPP #define STAN_LANG_AST_NODE_MATRIX_EXPR_HPP #include #include #include #include namespace stan { namespace lang { struct expresssion; /** * Structure to hold a matrix expression. */ struct matrix_expr { /** * Sequence of expressions for matrix values. */ std::vector args_; /** * True if there is a variable within any of the expressions * that is a parameter, transformed parameter, or non-integer * local variable. */ bool has_var_; /** * Scope of this matrix expression. * */ scope matrix_expr_scope_; /** * Construct a default matrix expression. */ matrix_expr(); /** * Construct an matrix expression from the specified sequence of * expressions. * * @param args sequence of arguments */ explicit matrix_expr(const std::vector& args); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/assgn_def.hpp0000644000176200001440000000141713766554456023736 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ASSGN_DEF_HPP #define STAN_LANG_AST_NODE_ASSGN_DEF_HPP #include #include #include namespace stan { namespace lang { assgn::assgn() {} assgn::assgn(const variable& lhs_var, const std::vector& idxs, const std::string& op, const expression& rhs) : lhs_var_(lhs_var), idxs_(idxs), op_(op), rhs_(rhs) {} bool assgn::is_simple_assignment() const { return !op_.compare("="); } bool assgn::lhs_var_has_sliced_idx() const { for (const auto& idx : idxs_) if (is_multi_index(idx)) return true; return false; } bool assgn::lhs_var_occurs_on_rhs() const { var_occurs_vis vis(lhs_var_); return boost::apply_visitor(vis, rhs_.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/var_decl.hpp0000644000176200001440000000312413766554456023561 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_VAR_DECL_HPP #define STAN_LANG_AST_NODE_VAR_DECL_HPP #include #include #include namespace stan { namespace lang { /** * AST base class for shared structure of variable declarations. */ struct var_decl { /** * Variable name. */ std::string name_; /** * Variable bare type. */ bare_expr_type bare_type_; /** * Definition for variable (nil if undefined). */ expression def_; /** * Construct a default variable declaration. */ var_decl(); /** * Construct a variable declaration of the specified name. * */ var_decl(const std::string& name); // NOLINT /** * Construct a variable declaration with the specified * name and type. * * @param name name of variable * @param type bare type of variable */ var_decl(const std::string& name, const bare_expr_type& type); /** * Construct a variable declaration with the specified * name, type, and definition. * * @param name name of variable * @param type bare type of variable * @param def definition of expression */ var_decl(const std::string& name, const bare_expr_type& type, const expression& def); /** * Return var_decl type. * * @return var_type_ */ bare_expr_type bare_type() const; /** * Return var_decl definition. * * @return def_ */ expression def() const; /** * Return var_decl name. * * @return name_ */ std::string name() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/conditional_op.hpp0000644000176200001440000000256713766554456025015 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_CONDITIONAL_OP_HPP #define STAN_LANG_AST_NODE_CONDITIONAL_OP_HPP #include #include #include namespace stan { namespace lang { /** * Structure for the conditional operator */ struct conditional_op { /** * Condition (integer). */ expression cond_; /** * Return value if condition is true. */ expression true_val_; /** * Return value if condition is false. */ expression false_val_; /** * Type of result. */ bare_expr_type type_; /** * True if the conditional operator contains a variable that is * declared as a parameter, transformed parameter, or local * variable. */ bool has_var_; /** * Scope of this conditional operator expression. */ scope scope_; /** * Construct a default conditional operator expression. */ conditional_op(); /** * Construct a conditional operator expression from the * specified condition and values. * No type checking on expressions. * * @param cond condition expression * @param true_val value to return if true * @param false_val value to return if false */ conditional_op(const expression& cond, const expression& true_val, const expression& false_val); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/return_statement_def.hpp0000644000176200001440000000053513766554456026226 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_RETURN_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_RETURN_STATEMENT_DEF_HPP #include namespace stan { namespace lang { return_statement::return_statement() {} return_statement::return_statement(const expression& expr) : return_value_(expr) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/printable_def.hpp0000644000176200001440000000111013766554456024571 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_PRINTABLE_DEF_HPP #define STAN_LANG_AST_NODE_PRINTABLE_DEF_HPP #include #include namespace stan { namespace lang { printable::printable() : printable_(std::string()) {} printable::printable(const expression& expr) : printable_(expr) {} printable::printable(const std::string& msg) : printable_(msg) {} printable::printable(const printable_t& printable) : printable_(printable) {} printable::printable(const printable& printable) : printable_(printable.printable_) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/matrix_expr_def.hpp0000644000176200001440000000065613766554456025171 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_MATRIX_EXPR_DEF_HPP #define STAN_LANG_AST_NODE_MATRIX_EXPR_DEF_HPP #include #include namespace stan { namespace lang { matrix_expr::matrix_expr() : args_(), has_var_(false), matrix_expr_scope_() {} matrix_expr::matrix_expr(const std::vector& args) : args_(args), has_var_(false), matrix_expr_scope_() {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/binary_op.hpp0000644000176200001440000000176313766554456023773 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_BINARY_OP_HPP #define STAN_LANG_AST_NODE_BINARY_OP_HPP #include #include #include namespace stan { namespace lang { /** * Node for storing binary operations consisting of an operation * and left and right arguments. */ struct binary_op { /** * String representation of the operation. */ std::string op; /** * First argument. */ expression left; /** * Second argument. */ expression right; /** * Type of result. */ bare_expr_type type_; /** * Construct a default binary operation. */ binary_op(); /** * Construct a binary operation of the specified operator and * arguments. * * @param left first argument * @param op operator name * @param right second argument */ binary_op(const expression& left, const std::string& op, const expression& right); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/function_decl_def.hpp0000644000176200001440000000303213766554456025432 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FUNCTION_DECL_DEF_HPP #define STAN_LANG_AST_NODE_FUNCTION_DECL_DEF_HPP #include #include #include #include #include namespace stan { namespace lang { /** * AST node for a function declaration and definition including * return type name, arguments, and body. */ struct function_decl_def { /** * Construct an uninitialized function declaration and * definition. */ function_decl_def(); /** * Construct a function declaration and definition with the * specified return type, function name, argument declarations * and function body. * * @param[in] return_type type of return value of function * @param[in] name function name * @param[in] arg_decls sequence of argument declarations * @param[in] body function body * */ function_decl_def(const bare_expr_type& return_type, const std::string& name, const std::vector& arg_decls, const statement& body); /** * Type of value returned by function. */ bare_expr_type return_type_; /** * Name of the function. */ std::string name_; /** * Sequence of argument declarations. */ std::vector arg_decls_; /** * Body of the function. */ statement body_; /** * Return true if this function has only integer arguments. */ bool has_only_int_args() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/for_matrix_statement_def.hpp0000644000176200001440000000110213766554456027050 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FOR_MATRIX_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_FOR_MATRIX_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { for_matrix_statement::for_matrix_statement() {} for_matrix_statement::for_matrix_statement(const std::string& variable, const expression& expression, const statement& stmt) : variable_(variable), expression_(expression), statement_(stmt) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/increment_log_prob_statement.hpp0000644000176200001440000000163413766554456027741 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INCREMENT_LOG_PROB_STATEMENT_HPP #define STAN_LANG_AST_NODE_INCREMENT_LOG_PROB_STATEMENT_HPP #include namespace stan { namespace lang { /** * AST node for the increment log prob (deprecated) and target * increment statements. */ struct increment_log_prob_statement { /** * Construct an increment log prob statement with a nil return * expression. */ increment_log_prob_statement(); /** * Construct an increment log prob statement with the specified * expression for the quantity to increment. * * @param log_prob quantity with which to increment the target * log density */ increment_log_prob_statement(const expression& log_prob); // NOLINT /** * Expression for the quantity with which to increment the * target log density. */ expression log_prob_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/variable_dims.hpp0000644000176200001440000000141513766554456024604 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_VARIABLE_DIMS_HPP #define STAN_LANG_AST_NODE_VARIABLE_DIMS_HPP #include #include namespace stan { namespace lang { struct expression; /** * Structure for holding a variable with its dimension * declarations. */ struct variable_dims { /** * Name of the variable. */ std::string name_; /** * Sequence of expressions for dimensions. */ std::vector dims_; /** * Construct a default object. */ variable_dims(); /** * Construct with the specified name and dimensions. * * @param name name of variable * @param dims dimensions of variable */ variable_dims(const std::string& name, const std::vector& dims); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/fun.hpp0000644000176200001440000000217613766554456022600 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FUN_HPP #define STAN_LANG_AST_NODE_FUN_HPP #include #include #include namespace stan { namespace lang { struct expression; /** * Structure for function application. */ struct fun { /** * Name of function being applied. */ std::string name_; /** * Original name of function being applied (before name * transformation). */ std::string original_name_; /** * Sequence of argument expressions for function. */ std::vector args_; /** * Type of result of applying function to arguments. */ bare_expr_type type_; /** * Construct a default function object. */ fun(); /** * Construct a function object with the specified name and * arguments. * Note: value of member `type_` not set by constructor; * filled in after via lookup in `stan::lang::function_signatures` * * @param name name of function * @param args sequence of arguments to function */ fun(const std::string& name, const std::vector& args); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/index_op.hpp0000644000176200001440000000202013766554456023601 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INDEX_OP_HPP #define STAN_LANG_AST_NODE_INDEX_OP_HPP #include #include #include namespace stan { namespace lang { /** * Structure for an indexed expression. */ struct index_op { /** * Expression being indexed. */ expression expr_; /** * Sequence of sequences of indexes. */ std::vector > dimss_; /** * Type of indexed expression. */ bare_expr_type type_; /** * Construct a default indexed expression. */ index_op(); /** * Construct an indexed expression with the specified expression * and indices. * * @param expr expression being indexed * @param dimss sequence of sequences of expressions */ index_op(const expression& expr, const std::vector >& dimss); /** * Determine indexed expression type given indexes. */ void infer_type(); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/ub_idx_def.hpp0000644000176200001440000000041713766554456024074 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_UB_IDX_DEF_HPP #define STAN_LANG_AST_NODE_UB_IDX_DEF_HPP #include namespace stan { namespace lang { ub_idx::ub_idx() {} ub_idx::ub_idx(const expression& ub) : ub_(ub) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/omni_idx_def.hpp0000644000176200001440000000034413766554456024427 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_OMNI_IDX_DEF_HPP #define STAN_LANG_AST_NODE_OMNI_IDX_DEF_HPP #include namespace stan { namespace lang { omni_idx::omni_idx() {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/ub_idx.hpp0000644000176200001440000000110413766554456023250 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_UB_IDX_HPP #define STAN_LANG_AST_NODE_UB_IDX_HPP #include namespace stan { namespace lang { /** * AST structure for holding an upper-bound index. */ struct ub_idx { /** * Upper bound. */ expression ub_; /** * Construct a default (nil valued) upper-bound index. */ ub_idx(); /** * Construct an upper-bound index with specified bound. * * @param ub upper bound */ ub_idx(const expression& ub); // NOLINT(runtime/explicit) }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/while_statement_def.hpp0000644000176200001440000000064313766554456026017 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_WHILE_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_WHILE_STATEMENT_DEF_HPP #include namespace stan { namespace lang { while_statement::while_statement() {} while_statement::while_statement(const expression& condition, const statement& body) : condition_(condition), body_(body) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/local_var_decl.hpp0000644000176200001440000000410713766554456024735 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_LOCAL_VAR_DECL_HPP #define STAN_LANG_AST_NODE_LOCAL_VAR_DECL_HPP #include #include #include #include namespace stan { namespace lang { /** * Structure to hold a local variable declaration. * Local variables have specified sizes. */ struct local_var_decl : public var_decl { /** * The line in the source code where the declaration begins. */ std::size_t begin_line_; /** * The line in the source code where the declaration ends. */ std::size_t end_line_; /** * Type-specific sizes. */ local_var_type type_; /** * Construct a default variable declaration. */ local_var_decl(); /** * Construct a local variable declaration with the specified * name and type. * * @param name variable name * @param type variable type */ local_var_decl(const std::string& name, const local_var_type& type); /** * Construct a local variable declaration with the specified * name, type, and definition. * * @param name variable name * @param type variable type * @param def definition */ local_var_decl(const std::string& name, const local_var_type& type, const expression& def); /** * Return the variable declaration's bare expr type. * * @return the bare expr type */ bare_expr_type bare_type() const; /** * Return the variable declaration's definition. * * @return expression definition for this variable */ expression def() const; /** * Return true if variable declaration contains a definition. * * @return bool indicating has or doesn't have definition */ bool has_def() const; /** * Return the variable declaration's name. * * @return name of variable */ std::string name() const; /** * Return the variable declaration's local_var_type * which contains size specifications. * * @return local_var_type */ local_var_type type() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/assgn.hpp0000644000176200001440000000405213766554456023116 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ASSIGN_HPP #define STAN_LANG_AST_NODE_ASSIGN_HPP #include #include #include #include #include namespace stan { namespace lang { /** * AST node for assignment to variable with multi-indexing. */ struct assgn { /** * Construct an uninitialized assignment statement. */ assgn(); /** * Construct an assignment statement with the specified * variable, indexing, and right-hand side expression. * * @param[in] lhs_var variable being assigned * @param[in] idxs sequence of indexes indicating element being * assigned * @param[in] op assignment operator * @param[in] rhs value of assignment */ assgn(const variable& lhs_var, const std::vector& idxs, const std::string& op, const expression& rhs); /** * Return true if the statement is assignment only * i.e., operator isn't a compound operator-assigment * * @return true if the statement is assignment only */ bool is_simple_assignment() const; /** * Return true if any of the indexes on the lhs element * are sliced indexes * * @return true if lhs has sliced idx */ bool lhs_var_has_sliced_idx() const; /** * Return true if the variable being assigned is a subexpression * of the value expression. * * @return true if the assigned variable appears in the value * expression */ bool lhs_var_occurs_on_rhs() const; /** * The variable being assigned. */ variable lhs_var_; /** * Position(s) in variable being assigned. */ std::vector idxs_; /** * Assignment operator string */ std::string op_; /** * Stan math function name, (see `src/stan/lang/function_signatures.h`). * Left unset for simple assignment or when both operands are primitive. */ std::string op_name_; /** * Value being assigned to left hand side variable at indexing * position. */ expression rhs_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/local_var_decl_def.hpp0000644000176200001440000000216313766554456025553 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_LOCAL_VAR_DECL_DEF_HPP #define STAN_LANG_AST_NODE_LOCAL_VAR_DECL_DEF_HPP #include #include #include namespace stan { namespace lang { local_var_decl::local_var_decl() : var_decl("", ill_formed_type(), nil()), type_(ill_formed_type()) {} local_var_decl::local_var_decl(const std::string& name, const local_var_type& type) : var_decl(name, type.bare_type(), nil()), type_(type) {} local_var_decl::local_var_decl(const std::string& name, const local_var_type& type, const expression& def) : var_decl(name, type.bare_type(), def), type_(type) {} bare_expr_type local_var_decl::bare_type() const { return type_.bare_type(); } expression local_var_decl::def() const { return def_; } bool local_var_decl::has_def() const { return !is_nil(def_); } std::string local_var_decl::name() const { return name_; } local_var_type local_var_decl::type() const { return type_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/variable_dims_def.hpp0000644000176200001440000000066713766554456025432 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_VARIABLE_DIMS_DEF_HPP #define STAN_LANG_AST_NODE_VARIABLE_DIMS_DEF_HPP #include #include #include namespace stan { namespace lang { variable_dims::variable_dims() {} variable_dims::variable_dims(const std::string& name, const std::vector& dims) : name_(name), dims_(dims) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/program_def.hpp0000644000176200001440000000156313766554456024274 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_PROGRAM_DEF_HPP #define STAN_LANG_AST_NODE_PROGRAM_DEF_HPP #include namespace stan { namespace lang { program::program() {} program::program(const function_decls_t& functions, const block_var_decls_t& data, const var_decls_statements_t& transformed_data, const block_var_decls_t& parameters, const var_decls_statements_t& transformed_parameters, const statement& model, const var_decls_statements_t& generated_quantities) : function_decl_defs_(functions), data_decl_(data), derived_data_decl_(transformed_data), parameter_decl_(parameters), derived_decl_(transformed_parameters), statement_(model), generated_decl_(generated_quantities) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/break_continue_statement_def.hpp0000644000176200001440000000062613766554456027700 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_BREAK_CONTINUE_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_BREAK_CONTINUE_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { break_continue_statement::break_continue_statement() {} break_continue_statement::break_continue_statement(const std::string& s) : generate_(s) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/range.hpp0000644000176200001440000000202013766554456023070 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_RANGE_HPP #define STAN_LANG_AST_NODE_RANGE_HPP #include namespace stan { namespace lang { /** * AST structure for a range object with a low and high value. */ struct range { /** * Lower bound of range with nil value if only * upper bound. */ expression low_; /** * Upper bound of range with nil value if only * upper bound. */ expression high_; /** * Construct a default range object. */ range(); /** * Construct a range object with the specified bounds. * * @param low lower bound * @param high upper bound */ range(const expression& low, const expression& high); /** * Return true if the lower bound is non-nil. * * @return true if there is a lower bound */ bool has_low() const; /** * Return true if the upper bound is non-nil. * * @return true if there is an upper bound */ bool has_high() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/for_array_statement_def.hpp0000644000176200001440000000107013766554456026666 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FOR_ARRAY_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_FOR_ARRAY_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { for_array_statement::for_array_statement() {} for_array_statement::for_array_statement(const std::string& variable, const expression& expression, const statement& stmt) : variable_(variable), expression_(expression), statement_(stmt) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/multi_idx_def.hpp0000644000176200001440000000044713766554456024623 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_MULTI_IDX_DEF_HPP #define STAN_LANG_AST_NODE_MULTI_IDX_DEF_HPP #include namespace stan { namespace lang { multi_idx::multi_idx() {} multi_idx::multi_idx(const expression& idxs) : idxs_(idxs) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/index_op_sliced.hpp0000644000176200001440000000213113766554456025127 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INDEX_OP_SLICED_HPP #define STAN_LANG_AST_NODE_INDEX_OP_SLICED_HPP #include #include #include #include namespace stan { namespace lang { /** * AST structure for holding an expression with a sequence of * indexes. */ struct index_op_sliced { /** * Expression being indexed. */ expression expr_; /** * Sequence of indexes. */ std::vector idxs_; /** * Type of result. */ bare_expr_type type_; /** * Construct a default indexed expression (all nil). */ index_op_sliced(); /** * Construct an indexed expression from the specified expression * and indexes. * * @param expr expression being indexed * @param idxs indexes */ index_op_sliced(const expression& expr, const std::vector& idxs); /** * Infer the type of the result. Modifies the underlying * expression type and not well formed until this is run. */ void infer_type(); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/lb_idx.hpp0000644000176200001440000000111013766554456023234 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_LB_IDX_HPP #define STAN_LANG_AST_NODE_LB_IDX_HPP #include namespace stan { namespace lang { /** * AST structure for holding a lower-bound index. */ struct lb_idx { /** * Lower bound. */ expression lb_; /** * Construct a default lower-bound index (nil valued). */ lb_idx(); /** * Construct a lower-bound index with specified lower bound. * * @param lb lower bound */ lb_idx(const expression& lb); // NOLINT(runtime/explicit) }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/omni_idx.hpp0000644000176200001440000000046013766554456023610 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_OMNI_IDX_HPP #define STAN_LANG_AST_NODE_OMNI_IDX_HPP namespace stan { namespace lang { /** * AST structure for representing all legal indexes. */ struct omni_idx { /** * Construct an omni-index. */ omni_idx(); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/map_rect_def.hpp0000644000176200001440000000275213766554456024420 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_MAP_RECT_DEF_HPP #define STAN_LANG_AST_NODE_MAP_RECT_DEF_HPP #include #include namespace stan { namespace lang { int map_rect::CALL_ID_ = 0; stan::lang::map_rect::map_rect() : call_id_(-1) {} stan::lang::map_rect::map_rect(const std::string& fun_name, const expression& shared_params, const expression& job_params, const expression& job_data_r, const expression& job_data_i) : call_id_(-1), fun_name_(fun_name), shared_params_(shared_params), job_params_(job_params), job_data_r_(job_data_r), job_data_i_(job_data_i) {} // can't just construct with nullary and assign because of call ID stan::lang::map_rect::map_rect(const map_rect& mr) : call_id_(mr.call_id_), fun_name_(mr.fun_name_), shared_params_(mr.shared_params_), job_params_(mr.job_params_), job_data_r_(mr.job_data_r_), job_data_i_(mr.job_data_i_) {} map_rect& stan::lang::map_rect::operator=(const map_rect& mr) { call_id_ = mr.call_id_; fun_name_ = mr.fun_name_; shared_params_ = mr.shared_params_; job_params_ = mr.job_params_; job_data_r_ = mr.job_data_r_; job_data_i_ = mr.job_data_i_; return *this; } void stan::lang::map_rect::register_id() { call_id_ = ++CALL_ID_; registered_calls().emplace_back(call_id_, fun_name_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/map_rect.hpp0000644000176200001440000000613013766554456023574 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_MAP_RECT_HPP #define STAN_LANG_AST_NODE_MAP_RECT_HPP #include #include #include #include namespace stan { namespace lang { /** * Structure to hold the arguments to the map_rect function. */ struct map_rect { /** * Static identifier that gets incremented for each instance of this * class. */ static int CALL_ID_; /** * Return the singleton sequence of map_rect calls. * * @return the sequence of map_rect calls. */ static std::vector >& registered_calls() { static std::vector > REGISTERED_CALLS_; return REGISTERED_CALLS_; } /** * Unique index for this specific instance of map_rect. */ int call_id_; /** * Name of function being mapped. */ std::string fun_name_; /** * Vector of shared parameters. */ expression shared_params_; /** * Array of vectors of job-specific parameters. */ expression job_params_; /** * Two-dimensional real array of job-specific real data. */ expression job_data_r_; /** * Two-dimensional real array of job-specific integer data. */ expression job_data_i_; /** * Construct a default instance of this class with an empty function * name and ill-formed expressions for all of the parameters. */ map_rect(); /** * Copy constructor using the member variables of the specified * object to construct a copy. * * @param[in] mr rectangular map to copy */ map_rect(const map_rect& mr); /** * Assign the member variables of the specified rectangular map * object to this object's member variables. This operator and the * copy constructor are defined to avoid incrementing the call * identifier accidentally. * * @param[in] mr rectangular map to assign * @return a reference to this object */ map_rect& operator=(const map_rect& mr); /** * Construct an instance with the specified function name, shared * parameters, job-specific parameters, and job-specific data, with * an automatically generated call ID. The call IDs are assigned * and then incremented as the map_rect calls are encountered in the * program, starting from 1. * * @param[in] fun_name name of function being mapped * @param[in] shared_params expression for vector of parameters used in * every job * @param[in] job_params expression for array of vectors of job-specific * parameters * @param[in] job_data_r data-only expression for array of arrays of * job-specific real data * @param[in] job_data_i data-only expression for array of arrays of * job-specific integer data */ map_rect(const std::string& fun_name, const expression& shared_params, const expression& job_params, const expression& job_data_r, const expression& job_data_i); /** * Add this rectangular map to the sequence of registered * instances. These will have macros for MPI generated for them by * the generator. */ void register_id(); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/block_var_decl.hpp0000644000176200001440000000421413766554456024734 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_BLOCK_VAR_DECL_HPP #define STAN_LANG_AST_NODE_BLOCK_VAR_DECL_HPP #include #include #include #include namespace stan { namespace lang { /** * Structure to hold a block variable declaration. * Block variables have optional constraints and * specified sizes. */ struct block_var_decl : public var_decl { /** * The line in the source code where the declaration begins. */ std::size_t begin_line_; /** * The line in the source code where the declaration ends. */ std::size_t end_line_; /** * Type-specific bounds (constraints) and sizes. */ block_var_type type_; /** * Construct a default variable declaration. */ block_var_decl(); /** * Construct a block variable declaration with the specified * name and type. * * @param name variable name * @param type variable type */ block_var_decl(const std::string& name, const block_var_type& type); /** * Construct a block variable declaration with the specified * name, type, and definition. * * @param name variable name * @param type variable type * @param def definition */ block_var_decl(const std::string& name, const block_var_type& type, const expression& def); /** * Return the variable declaration's bare expr type. * * @return the bare expr type */ bare_expr_type bare_type() const; /** * Return the variable declaration's definition. * * @return expression definition for this variable */ expression def() const; /** * Return true if variable declaration contains a definition. * * @return bool indicating has or doesn't have definition */ bool has_def() const; /** * Return the variable declaration's name. * * @return name of variable */ std::string name() const; /** * Return the variable declaration's block_var_type * which contains constraints and size specifications. * * @return block_var_type */ block_var_type type() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/int_literal_def.hpp0000644000176200001440000000051113766554456025123 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INT_LITERAL_DEF_HPP #define STAN_LANG_AST_NODE_INT_LITERAL_DEF_HPP #include namespace stan { namespace lang { int_literal::int_literal() : type_(int_type()) {} int_literal::int_literal(int val) : val_(val), type_(int_type()) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/for_statement.hpp0000644000176200001440000000206413766554456024656 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FOR_STATEMENT_HPP #define STAN_LANG_AST_NODE_FOR_STATEMENT_HPP #include #include #include #include namespace stan { namespace lang { /** * AST node for representing a for statement. */ struct for_statement { /** * Construct an uninitialized for statement. */ for_statement(); /** * Construct a for statement that loops the specified variable * over the specified range to execute the specified statement. * * @param[in] variable loop variable * @param[in] range value range for loop variable * @param[in] stmt body of the for loop */ for_statement(const std::string& variable, const range& range, const statement& stmt); /** * The loop variable. */ std::string variable_; /** * The range of values for the loop variable. */ range range_; /** * The body of the for loop. */ statement statement_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/integrate_1d.hpp0000644000176200001440000000266713766554456024363 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INTEGRATE_1D_HPP #define STAN_LANG_AST_NODE_INTEGRATE_1D_HPP #include #include namespace stan { namespace lang { struct integrate_1d { /** * Name of the function being integrated. */ std::string function_name_; /** * Lower integration boundary. */ expression lb_; /** * Upper integration boundary. */ expression ub_; /** * Parameters. */ expression theta_; /** * Real-valued data. */ expression x_r_; /** * Integer-valued data. */ expression x_i_; /** * Relative tolerance of solution. */ expression rel_tol_; /** * Construct a 1D integrator AST node. */ integrate_1d(); /** * Construct a 1D integrator AST node with the specified function * name, lower and upper integration bounds, parameters, and real * and integer data. * * @param function_name name of function to integrate * @param lb lower bound of integration * @param ub upper bound of integration * @param theta parameters * @param x_r real data * @param x_i integer data * @param rel_tol relative tolerance */ integrate_1d(const std::string& function_name, const expression& lb, const expression& ub, const expression& theta, const expression& x_r, const expression& x_i, const expression& rel_tol); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/statement_def.hpp0000644000176200001440000000300713766554456024624 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_STATEMENT_DEF_HPP #include namespace stan { namespace lang { statement::statement() : statement_(nil()) {} statement::statement(const statement_t& st) : statement_(st) {} statement::statement(const nil& st) : statement_(st) {} statement::statement(const assgn& st) : statement_(st) {} statement::statement(const sample& st) : statement_(st) {} statement::statement(const increment_log_prob_statement& st) : statement_(st) {} statement::statement(const statements& st) : statement_(st) {} statement::statement(const expression& st) : statement_(st) {} statement::statement(const for_statement& st) : statement_(st) {} statement::statement(const for_array_statement& st) : statement_(st) {} statement::statement(const for_matrix_statement& st) : statement_(st) {} statement::statement(const while_statement& st) : statement_(st) {} statement::statement(const break_continue_statement& st) : statement_(st) {} statement::statement(const conditional_statement& st) : statement_(st) {} statement::statement(const print_statement& st) : statement_(st) {} statement::statement(const reject_statement& st) : statement_(st) {} statement::statement(const return_statement& st) : statement_(st) {} statement::statement(const no_op_statement& st) : statement_(st) {} bool statement::is_no_op_statement() const { is_no_op_statement_vis vis; return boost::apply_visitor(vis, statement_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/return_statement.hpp0000644000176200001440000000121613766554456025405 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_RETURN_STATEMENT_HPP #define STAN_LANG_AST_NODE_RETURN_STATEMENT_HPP #include namespace stan { namespace lang { /** * AST node for the return statement. */ struct return_statement { /** * Construct a return statement with a nil return value. */ return_statement(); /** * Construct a return statement with the specified return value. * * @param[in] expr return value */ return_statement(const expression& expr); // NOLINT(runtime/explicit) /** * The value returned. */ expression return_value_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/uni_idx.hpp0000644000176200001440000000106713766554456023445 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_UNI_IDX_HPP #define STAN_LANG_AST_NODE_UNI_IDX_HPP #include namespace stan { namespace lang { /** * AST structure to hold a single array or matrix/vector index. */ struct uni_idx { /** * Index. */ expression idx_; /** * Construct a default unary index. */ uni_idx(); /** * Construct a unary index with the specified value. * * @param idx index */ uni_idx(const expression& idx); // NOLINT(runtime/explicit) }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/int_literal.hpp0000644000176200001440000000111613766554456024307 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INT_LITERAL_HPP #define STAN_LANG_AST_NODE_INT_LITERAL_HPP #include #include namespace stan { namespace lang { struct int_literal { /** * Value of literal. */ int val_; /** * Expression type of literal. */ bare_expr_type type_; /** * Construct a default int literal. */ int_literal(); /** * Construct an int literal with the specified value. * * @param val value of literal */ explicit int_literal(int val); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/sample.hpp0000644000176200001440000000237613766554456023273 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_SAMPLE_HPP #define STAN_LANG_AST_NODE_SAMPLE_HPP #include #include #include #include #include namespace stan { namespace lang { /** * AST node for sampling statements. */ struct sample { /** * Construct an uninitialized sampling statement. */ sample(); /** * Construct a sampling statement with the specified variate and * distribution. * * @param e random variate * @param dist distribution for variate */ sample(expression& e, distribution& dist); /** * Return true if the sampling statement is not well formed. * * @return true if sampling statement is not well formed */ bool is_ill_formed() const; /** * Return true if the distribution is discrete. * * @return true if the distribution is discrete. */ bool is_discrete() const; /** * The random variable. */ expression expr_; /** * Distribution of the variable. */ distribution dist_; /** * The truncation range for the distribution. */ range truncation_; /** * Discreteness flag. */ bool is_discrete_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/printable.hpp0000644000176200001440000000267413766554456023773 0ustar liggesusers#ifndef STAN_LANG_AST_PRINTABLE_HPP #define STAN_LANG_AST_PRINTABLE_HPP #include #include namespace stan { namespace lang { struct expression; /** * A printable object is either an expression or a string. */ struct printable { /** * Variant type for member variable to store. */ typedef boost::variant, boost::recursive_wrapper > printable_t; /** * Construct a printable object with an empty string. */ printable(); /** * Construct a printable object with the specified expression. * * @param expr expression to store */ printable(const expression& expr); // NOLINT(runtime/explicit) /** * Construct a printable object with the specified string. * * @param msg message to store */ printable(const std::string& msg); // NOLINT(runtime/explicit) /** * Construct a printable object with an object of its variant * type. * * @param printable variant string or expression */ printable(const printable_t& printable); // NOLINT(runtime/explicit) /** * Copy constructor to construct printable from a printable. * * @param printable printable to copy */ printable(const printable& printable); // NOLINT(runtime/explicit) /** * The stored printable object. */ printable_t printable_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/double_literal_def.hpp0000644000176200001440000000065613766554456025615 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_DOUBLE_LITERAL_DEF_HPP #define STAN_LANG_AST_NODE_DOUBLE_LITERAL_DEF_HPP #include #include namespace stan { namespace lang { double_literal::double_literal() : string_(std::string()), type_(double_type()) {} double_literal::double_literal(double val) : val_(val), string_(std::string()), type_(double_type()) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/offset_multiplier_def.hpp0000644000176200001440000000114513766554456026355 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_OFFSET_MULTIPLIER_DEF_HPP #define STAN_LANG_AST_NODE_OFFSET_MULTIPLIER_DEF_HPP #include namespace stan { namespace lang { offset_multiplier::offset_multiplier() {} offset_multiplier::offset_multiplier(const expression &offset, const expression &multiplier) : offset_(offset), multiplier_(multiplier) {} bool offset_multiplier::has_offset() const { return !is_nil(offset_.expr_); } bool offset_multiplier::has_multiplier() const { return !is_nil(multiplier_.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/lub_idx_def.hpp0000644000176200001440000000047013766554456024247 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_LUB_IDX_DEF_HPP #define STAN_LANG_AST_NODE_LUB_IDX_DEF_HPP #include namespace stan { namespace lang { lub_idx::lub_idx() {} lub_idx::lub_idx(const expression& lb, const expression& ub) : lb_(lb), ub_(ub) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/integrate_1d_def.hpp0000644000176200001440000000127013766554456025166 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INTEGRATE_1D_DEF_HPP #define STAN_LANG_AST_NODE_INTEGRATE_1D_DEF_HPP #include #include namespace stan { namespace lang { integrate_1d::integrate_1d(const std::string& function_name, const expression& lb, const expression& ub, const expression& theta, const expression& x_r, const expression& x_i, const expression& rel_tol) : function_name_(function_name), lb_(lb), ub_(ub), theta_(theta), x_r_(x_r), x_i_(x_i), rel_tol_(rel_tol) {} integrate_1d::integrate_1d() {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/expression_def.hpp0000644000176200001440000000467113766554456025027 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_EXPRESSION_DEF_HPP #define STAN_LANG_AST_NODE_EXPRESSION_DEF_HPP #include #include #include namespace stan { namespace lang { expression::expression() : expr_(nil()) {} expression::expression(const expression& e) : expr_(e.expr_) {} expression::expression(const expression_t& expr) : expr_(expr) {} expression::expression(const nil& expr) : expr_(expr) {} expression::expression(const int_literal& expr) : expr_(expr) {} expression::expression(const double_literal& expr) : expr_(expr) {} expression::expression(const array_expr& expr) : expr_(expr) {} expression::expression(const matrix_expr& expr) : expr_(expr) {} expression::expression(const row_vector_expr& expr) : expr_(expr) {} expression::expression(const variable& expr) : expr_(expr) {} expression::expression(const integrate_1d& expr) : expr_(expr) {} expression::expression(const integrate_ode& expr) : expr_(expr) {} expression::expression(const integrate_ode_control& expr) : expr_(expr) {} expression::expression(const algebra_solver& expr) : expr_(expr) {} expression::expression(const algebra_solver_control& expr) : expr_(expr) {} expression::expression(const map_rect& expr) : expr_(expr) {} expression::expression(const fun& expr) : expr_(expr) {} expression::expression(const index_op& expr) : expr_(expr) {} expression::expression(const index_op_sliced& expr) : expr_(expr) {} expression::expression(const conditional_op& expr) : expr_(expr) {} expression::expression(const binary_op& expr) : expr_(expr) {} expression::expression(const unary_op& expr) : expr_(expr) {} expression& expression::operator+=(const expression& rhs) { expr_ = binary_op(expr_, "+", rhs); return *this; } expression& expression::operator-=(const expression& rhs) { expr_ = binary_op(expr_, "-", rhs); return *this; } expression& expression::operator*=(const expression& rhs) { expr_ = binary_op(expr_, "*", rhs); return *this; } expression& expression::operator/=(const expression& rhs) { expr_ = binary_op(expr_, "/", rhs); return *this; } bare_expr_type expression::bare_type() const { expression_bare_type_vis vis; return boost::apply_visitor(vis, expr_); } int expression::total_dims() const { return bare_type().num_dims(); } std::string expression::to_string() const { write_expression_vis vis; return boost::apply_visitor(vis, expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/reject_statement_def.hpp0000644000176200001440000000060513766554456026161 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_REJECT_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_REJECT_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { reject_statement::reject_statement() {} reject_statement::reject_statement(const std::vector& printables) : printables_(printables) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/unary_op_def.hpp0000644000176200001440000000055513766554456024461 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_UNARY_OP_DEF_HPP #define STAN_LANG_AST_NODE_UNARY_OP_DEF_HPP #include namespace stan { namespace lang { unary_op::unary_op() {} unary_op::unary_op(char op, const expression& subject) : op(op), subject(subject), type_(promote_primitive(subject.bare_type())) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/expression.hpp0000644000176200001440000000667013766554456024212 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_EXPRESSION_HPP #define STAN_LANG_AST_NODE_EXPRESSION_HPP #include #include #include #include #include namespace stan { namespace lang { struct bare_expr_type; struct nil; struct int_literal; struct double_literal; struct array_expr; struct matrix_expr; struct row_vector_expr; struct variable; struct fun; struct integrate_1d; struct integrate_ode; struct integrate_ode_control; struct algebra_solver; struct algebra_solver_control; struct map_rect; struct index_op; struct index_op_sliced; struct conditional_op; struct binary_op; struct unary_op; struct expression { typedef boost::variant< boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper > expression_t; expression(); expression(const expression& e); expression(const nil& expr); // NOLINT(runtime/explicit) expression(const int_literal& expr); // NOLINT(runtime/explicit) expression(const double_literal& expr); // NOLINT(runtime/explicit) expression(const array_expr& expr); // NOLINT(runtime/explicit) expression(const matrix_expr& expr); // NOLINT(runtime/explicit) expression(const row_vector_expr& expr); // NOLINT(runtime/explicit) expression(const variable& expr); // NOLINT(runtime/explicit) expression(const fun& expr); // NOLINT(runtime/explicit) expression(const integrate_1d& expr); // NOLINT(runtime/explicit) expression(const integrate_ode& expr); // NOLINT(runtime/explicit) expression(const integrate_ode_control& expr); // NOLINT expression(const algebra_solver& expr); // NOLINT(runtime/explicit) expression(const algebra_solver_control& expr); // NOLINT expression(const map_rect& expr); // NOLINT expression(const index_op& expr); // NOLINT(runtime/explicit) expression(const index_op_sliced& expr); // NOLINT(runtime/explicit) expression(const conditional_op& expr); // NOLINT(runtime/explicit) expression(const binary_op& expr); // NOLINT(runtime/explicit) expression(const unary_op& expr); // NOLINT(runtime/explicit) expression(const expression_t& expr_); // NOLINT(runtime/explicit) bare_expr_type bare_type() const; int total_dims() const; std::string to_string() const; expression& operator+=(const expression& rhs); expression& operator-=(const expression& rhs); expression& operator*=(const expression& rhs); expression& operator/=(const expression& rhs); expression_t expr_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/uni_idx_def.hpp0000644000176200001440000000043013766554456024254 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_UNI_IDX_DEF_HPP #define STAN_LANG_AST_NODE_UNI_IDX_DEF_HPP #include namespace stan { namespace lang { uni_idx::uni_idx() {} uni_idx::uni_idx(const expression& idx) : idx_(idx) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/integrate_ode.hpp0000644000176200001440000000305513766554456024616 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INTEGRATE_ODE_HPP #define STAN_LANG_AST_NODE_INTEGRATE_ODE_HPP #include #include namespace stan { namespace lang { /** * Structure for integrate diff eq statement. */ struct integrate_ode { /** * The name of the integrator. */ std::string integration_function_name_; /** * Name of the ODE system. */ std::string system_function_name_; /** * Initial state. */ expression y0_; /** * Initial time. */ expression t0_; /** * Solution times. */ expression ts_; /** * Parameters. */ expression theta_; // params /** * Real-valued data. */ expression x_; /** * Integer-valued data. */ expression x_int_; /** * Construct a default integrate ODE node. */ integrate_ode(); /** * Construct an integrate ODE node with the specified * components. * * @param integration_function_name name of integrator * @param system_function_name name of ODE system * @param y0 initial value * @param t0 initial time * @param ts solution times * @param theta parameters * @param x real-valued data * @param x_int integer-valued data */ integrate_ode(const std::string& integration_function_name, const std::string& system_function_name, const expression& y0, const expression& t0, const expression& ts, const expression& theta, const expression& x, const expression& x_int); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/increment_log_prob_statement_def.hpp0000644000176200001440000000065613766554456030562 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INCREMENT_LOG_PROB_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_INCREMENT_LOG_PROB_STATEMENT_DEF_HPP #include namespace stan { namespace lang { increment_log_prob_statement::increment_log_prob_statement() {} increment_log_prob_statement::increment_log_prob_statement( const expression& log_prob) : log_prob_(log_prob) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/distribution.hpp0000644000176200001440000000074313766554456024525 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_DISTRIBUTION_HPP #define STAN_LANG_AST_NODE_DISTRIBUTION_HPP #include #include namespace stan { namespace lang { struct expression; /** * Structure for a distribution with parameters. */ struct distribution { /** * The name of the distribution. */ std::string family_; /** * The sequence of parameters for the distribution. */ std::vector args_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/print_statement.hpp0000644000176200001440000000132713766554456025225 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_PRINT_STATEMENT_HPP #define STAN_LANG_AST_NODE_PRINT_STATEMENT_HPP #include #include #include namespace stan { namespace lang { /** * AST node for print statements. */ struct print_statement { /** * Construct an empty print statement. */ print_statement(); /** * Construct a print statement with the specified sequence of * printable objects. * * @param[in] printables sequence of printable objects */ print_statement(const std::vector& printables); // NOLINT /** * Sequence of printable objects. */ std::vector printables_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/binary_op_def.hpp0000644000176200001440000000075013766554456024604 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_BINARY_OP_DEF_HPP #define STAN_LANG_AST_NODE_BINARY_OP_DEF_HPP #include #include namespace stan { namespace lang { binary_op::binary_op() {} binary_op::binary_op(const expression& left, const std::string& op, const expression& right) : op(op), left(left), right(right), type_(promote_primitive(left.bare_type(), right.bare_type())) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/while_statement.hpp0000644000176200001440000000147513766554456025205 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_WHILE_STATEMENT_HPP #define STAN_LANG_AST_NODE_WHILE_STATEMENT_HPP #include #include namespace stan { namespace lang { /** * AST node for representing while statements. */ struct while_statement { /** * Construct an unitialized while statement with nil condition * and body. */ while_statement(); /** * Construct a while statement with the specified loop condition * and loop body. * * @param[in] condition loop condition * @param[in] body loop body */ while_statement(const expression& condition, const statement& body); /** * The loop condition. */ expression condition_; /** * The loop body. */ statement body_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/index_op_sliced_def.hpp0000644000176200001440000000103413766554456025746 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INDEX_OP_SLICED_DEF_HPP #define STAN_LANG_AST_NODE_INDEX_OP_SLICED_DEF_HPP #include #include namespace stan { namespace lang { index_op_sliced::index_op_sliced() {} index_op_sliced::index_op_sliced(const expression& expr, const std::vector& idxs) : expr_(expr), idxs_(idxs), type_(indexed_type(expr_, idxs_)) {} void index_op_sliced::infer_type() { type_ = indexed_type(expr_, idxs_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/idx.hpp0000644000176200001440000000371713766554456022576 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_IDX_HPP #define STAN_LANG_AST_NODE_IDX_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * AST variant structure for indexes, holding any of a unary, * multi, omni, lower-bound, upper-bound, or lower- and upper-bound * index. */ struct idx { /** * Variant type for the six index types. */ typedef boost::variant< boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper, boost::recursive_wrapper > idx_t; /** * Construct a default index. */ idx(); /** * Construct a unary index with specified index. * *@param i index */ idx(const uni_idx& i); // NOLINT(runtime/explicit) /** * Construct a multiple index with specified index. * *@param i index */ idx(const multi_idx& i); // NOLINT(runtime/explicit) /** * Construct a universal index with specified index. * *@param i index */ idx(const omni_idx& i); // NOLINT(runtime/explicit) /** * Construct a lower-bound index with specified index. * *@param i index */ idx(const lb_idx& i); // NOLINT(runtime/explicit) /** * Construct an upper-bound index with specified index. * *@param i index */ idx(const ub_idx& i); // NOLINT(runtime/explicit) /** * Construct a lower- and upper-bound index with specified index. * *@param i index */ idx(const lub_idx& i); // NOLINT(runtime/explicit) std::string to_string() const; /** * The index variant object. */ idx_t idx_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/double_literal.hpp0000644000176200001440000000134113766554456024767 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_DOUBLE_LITERAL_HPP #define STAN_LANG_AST_NODE_DOUBLE_LITERAL_HPP #include #include #include namespace stan { namespace lang { /** * Node for holding a double literal. */ struct double_literal { /** * Value of literal. */ double val_; /** * String representation. */ std::string string_; /** * Expression type. */ bare_expr_type type_; /** * Default constructor for double literal. */ double_literal(); /** * Construct a double literal with the specified value. * * @param val value of literal */ explicit double_literal(double val); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/array_expr_def.hpp0000644000176200001440000000047313766554456025000 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ARRAY_EXPR_DEF_HPP #define STAN_LANG_AST_NODE_ARRAY_EXPR_DEF_HPP #include #include namespace stan { namespace lang { array_expr::array_expr() : args_(), type_(), has_var_(false), array_expr_scope_() {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/sample_def.hpp0000644000176200001440000000127313766554456024104 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_SAMPLE_DEF_HPP #define STAN_LANG_AST_NODE_SAMPLE_DEF_HPP #include namespace stan { namespace lang { sample::sample() : is_discrete_(false) {} sample::sample(expression& e, distribution& dist) : expr_(e), dist_(dist), is_discrete_(false) {} bool sample::is_ill_formed() const { return expr_.bare_type().is_ill_formed_type() || (truncation_.has_low() && expr_.bare_type() != truncation_.low_.bare_type()) || (truncation_.has_high() && expr_.bare_type() != truncation_.high_.bare_type()); } bool sample::is_discrete() const { return is_discrete_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/algebra_solver_control.hpp0000644000176200001440000000355113766554456026535 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ALGEBRA_SOLVER_CONTROL_HPP #define STAN_LANG_AST_NODE_ALGEBRA_SOLVER_CONTROL_HPP #include #include namespace stan { namespace lang { struct expression; /** * Structure for an algebra solver statement with control * parameters for the solver. */ struct algebra_solver_control { /** * Name of the algebra system. */ std::string system_function_name_; /** * Initial guess (vector of real). */ expression y_; /** * Parameters (vector of real). */ expression theta_; /** * Real-valued data (array of real). */ expression x_r_; /** * Integer-valued data (array of int). */ expression x_i_; /** * Relative tolerance (real). */ expression rel_tol_; /** * Function tolerance (real). */ expression fun_tol_; /** * Maximum number of steps (integer). */ expression max_num_steps_; /** * Construct a default algebra solver object with control. */ algebra_solver_control(); /** * Construt an algebraic solver with control parameters with * the specified values. * * @param system_function_name name of algebraic solver * @param y initial guess for solution * @param theta parameters * @param x_r real-valued data * @param x_i integer-valued data * @param rel_tol relative tolerance of integrator * @param fun_tol function tolerance of integrator * @param max_num_steps max steps in integrator */ algebra_solver_control(const std::string& system_function_name, const expression& y, const expression& theta, const expression& x_r, const expression& x_i, const expression& rel_tol, const expression& fun_tol, const expression& max_num_steps); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/function_decl_defs_def.hpp0000644000176200001440000000063313766554456026437 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FUNCTION_DECL_DEFS_DEF_HPP #define STAN_LANG_AST_NODE_FUNCTION_DECL_DEFS_DEF_HPP #include #include namespace stan { namespace lang { function_decl_defs::function_decl_defs() {} function_decl_defs::function_decl_defs( const std::vector& decl_defs) : decl_defs_(decl_defs) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/fun_def.hpp0000644000176200001440000000056413766554456023415 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FUN_DEF_HPP #define STAN_LANG_AST_NODE_FUN_DEF_HPP #include #include #include namespace stan { namespace lang { fun::fun() {} fun::fun(const std::string& name, const std::vector& args) : name_(name), original_name_(name), args_(args) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/algebra_solver.hpp0000644000176200001440000000221013766554456024764 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ALGEBRA_SOLVER_HPP #define STAN_LANG_AST_NODE_ALGEBRA_SOLVER_HPP #include #include namespace stan { namespace lang { struct expression; /** * Structure for algebraic solver statement. */ struct algebra_solver { /** * Name of the algebra system. */ std::string system_function_name_; /** * Initial guess for solution. */ expression y_; /** * Parameters. */ expression theta_; /** * Real-valued data. */ expression x_r_; /** * Integer-valued data. */ expression x_i_; /** * Construct a default algebra solver node. */ algebra_solver(); /** * Construct an algebraic solver. * * @param system_function_name name of ODE system * @param y initial guess for solution * @param theta parameters * @param x_r real-valued data * @param x_i integer-valued data */ algebra_solver(const std::string& system_function_name, const expression& y, const expression& theta, const expression& x_r, const expression& x_i); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/index_op_def.hpp0000644000176200001440000000113113766554456024421 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INDEX_OP_DEF_HPP #define STAN_LANG_AST_NODE_INDEX_OP_DEF_HPP #include #include namespace stan { namespace lang { index_op::index_op() {} index_op::index_op(const expression& expr, const std::vector >& dimss) : expr_(expr), dimss_(dimss) { infer_type(); } void index_op::infer_type() { size_t total = 0U; for (size_t i = 0; i < dimss_.size(); ++i) total += dimss_[i].size(); type_ = infer_type_indexing(expr_.bare_type(), total); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/program.hpp0000644000176200001440000000461113766554456023453 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_PROGRAM_HPP #define STAN_LANG_AST_NODE_PROGRAM_HPP #include #include #include #include #include namespace stan { namespace lang { /** * AST node for a complete Stan program. */ struct program { /** * Type of a sequence of function declarations. */ typedef std::vector function_decls_t; /** * Type of a sequence of variable declarations. */ typedef std::vector block_var_decls_t; /** * Type of a sequence of statements. */ typedef std::vector statements_t; /** * Type of pair of variable declaration sequence and statement sequence. */ typedef std::pair var_decls_statements_t; /** * Construct an uninitialized program. */ program(); /** * Construct a program with the specified components. * * @param[in] functions functions block * @param[in] data data block * @param[in] transformed_data transformed data block * @param[in] parameters parameters block * @param[in] transformed_parameters transformed parameters block * @param[in] model model block * @param[in] generated_quantities generated quantities block */ program(const function_decls_t& functions, const block_var_decls_t& data, const var_decls_statements_t& transformed_data, const block_var_decls_t& parameters, const var_decls_statements_t& transformed_parameters, const statement& model, const var_decls_statements_t& generated_quantities); /** * Functions block. */ std::vector function_decl_defs_; /** * Data block. */ std::vector data_decl_; /** * Transformed data block. */ std::pair, std::vector > derived_data_decl_; /** * Parameters block. */ std::vector parameter_decl_; /** * Transformed parameters block. */ std::pair, std::vector > derived_decl_; /** * Model block. */ statement statement_; /** * Generated quantities block. */ std::pair, std::vector > generated_decl_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/array_expr.hpp0000644000176200001440000000162013766554456024155 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ARRAY_EXPR_HPP #define STAN_LANG_AST_NODE_ARRAY_EXPR_HPP #include #include #include #include #include namespace stan { namespace lang { struct expresssion; /** * Structure to hold an array expression. */ struct array_expr { /** * Sequence of expressions for array values. */ std::vector args_; /** * Type of array. */ bare_expr_type type_; /** * True if there is a variable within any of the expressions * that is a parameter, transformed parameter, or non-integer * local variable. */ bool has_var_; /** * Scope of this array expression. * */ scope array_expr_scope_; /** * Construct a default array expression. */ array_expr(); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/block_var_decl_def.hpp0000644000176200001440000000216413766554456025554 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_BLOCK_VAR_DECL_DEF_HPP #define STAN_LANG_AST_NODE_BLOCK_VAR_DECL_DEF_HPP #include #include #include namespace stan { namespace lang { block_var_decl::block_var_decl() : var_decl("", ill_formed_type(), nil()), type_(ill_formed_type()) {} block_var_decl::block_var_decl(const std::string& name, const block_var_type& type) : var_decl(name, type.bare_type(), nil()), type_(type) {} block_var_decl::block_var_decl(const std::string& name, const block_var_type& type, const expression& def) : var_decl(name, type.bare_type(), def), type_(type) {} bare_expr_type block_var_decl::bare_type() const { return type_.bare_type(); } expression block_var_decl::def() const { return def_; } bool block_var_decl::has_def() const { return !is_nil(def_); } std::string block_var_decl::name() const { return name_; } block_var_type block_var_decl::type() const { return type_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/lub_idx.hpp0000644000176200001440000000124413766554456023431 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_LUB_IDX_HPP #define STAN_LANG_AST_NODE_LUB_IDX_HPP #include namespace stan { namespace lang { /** * AST structure for lower and upper bounds. */ struct lub_idx { /** * Lower bound. */ expression lb_; /** * Upper bound. */ expression ub_; /** * Construct a default (nil valued) lower and upper bound index. */ lub_idx(); /** * Construt a lower and upper bound index with the specified * bounds. * * @param lb lower bound * @param ub upper bound */ lub_idx(const expression& lb, const expression& ub); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/for_matrix_statement.hpp0000644000176200001440000000220413766554456026236 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FOR_MATRIX_STATEMENT_HPP #define STAN_LANG_AST_NODE_FOR_MATRIX_STATEMENT_HPP #include #include #include namespace stan { namespace lang { /** * AST node for representing a foreach statement over a matrix. */ struct for_matrix_statement { /** * Construct an uninitialized foreach statement. */ for_matrix_statement(); /** * Construct a foreach statement that loops the specified variable * over the specified expression to execute the specified statement. * * @param[in] variable loop variable * @param[in] expression value expression foreach loop variable * @param[in] stmt body of the foreach loop */ for_matrix_statement(const std::string& variable, const expression& expression, const statement& stmt); /** * The loop variable. */ std::string variable_; /** * The expression of values for the loop variable. */ expression expression_; /** * The body of the foreach loop. */ statement statement_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/integrate_ode_control.hpp0000644000176200001440000000445213766554456026360 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INTEGRATE_ODE_CONTROL_HPP #define STAN_LANG_AST_NODE_INTEGRATE_ODE_CONTROL_HPP #include #include namespace stan { namespace lang { struct expression; /** * Structure for a diff eq integration statement with control * parameters for the integrator. */ struct integrate_ode_control { /** * The name of the integrator. */ std::string integration_function_name_; /** * Name of the ODE system. */ std::string system_function_name_; /** * Initial state (array of real). */ expression y0_; /** * Initial time (real). */ expression t0_; /** * Solution times (array of real). */ expression ts_; /** * Parameters (array of real). */ expression theta_; /** * Real-valued data (array of real). */ expression x_; /** * Integer-valued data (array of int). */ expression x_int_; // integer data /** * Relative tolerance (real). */ expression rel_tol_; /** * Absolute tolerance (real). */ expression abs_tol_; /** * Maximum number of steps (integer). */ expression max_num_steps_; /** * Construct a default ODE integrator object with control. */ integrate_ode_control(); /** * Construt an ODE integrator with control parameter with the * specified values. * * @param integration_function_name name of integrator * @param system_function_name name of ODE system * @param y0 initial value * @param t0 initial time * @param ts solution times * @param theta parameters * @param x real-valued data * @param x_int integer-valued data * @param rel_tol relative tolerance of integrator * @param abs_tol absolute tolerance of integrator * @param max_steps max steps in integrator */ integrate_ode_control(const std::string& integration_function_name, const std::string& system_function_name, const expression& y0, const expression& t0, const expression& ts, const expression& theta, const expression& x, const expression& x_int, const expression& rel_tol, const expression& abs_tol, const expression& max_steps); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/for_array_statement.hpp0000644000176200001440000000217613766554456026060 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FOR_ARRAY_STATEMENT_HPP #define STAN_LANG_AST_NODE_FOR_ARRAY_STATEMENT_HPP #include #include #include namespace stan { namespace lang { /** * AST node for representing a foreach statement over an array. */ struct for_array_statement { /** * Construct an uninitialized foreach statement. */ for_array_statement(); /** * Construct a foreach statement that loops the specified variable * over the specified expression to execute the specified statement. * * @param[in] variable loop variable * @param[in] expression value expression foreach loop variable * @param[in] stmt body of the foreach loop */ for_array_statement(const std::string& variable, const expression& expression, const statement& stmt); /** * The loop variable. */ std::string variable_; /** * The expression of values for the loop variable. */ expression expression_; /** * The body of the foreach loop. */ statement statement_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/algebra_solver_def.hpp0000644000176200001440000000115313766554456025607 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_ALGEBRA_SOLVER_DEF_HPP #define STAN_LANG_AST_NODE_ALGEBRA_SOLVER_DEF_HPP #include #include namespace stan { namespace lang { algebra_solver::algebra_solver() {} algebra_solver::algebra_solver(const std::string& system_function_name, const expression& y, const expression& theta, const expression& x_r, const expression& x_i) : system_function_name_(system_function_name), y_(y), theta_(theta), x_r_(x_r), x_i_(x_i) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/statements_def.hpp0000644000176200001440000000066613766554456025017 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_STATEMENTS_DEF_HPP #define STAN_LANG_AST_NODE_STATEMENTS_DEF_HPP #include #include namespace stan { namespace lang { statements::statements() {} statements::statements(const std::vector& local_decl, const std::vector& stmts) : local_decl_(local_decl), statements_(stmts) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/var_decl_def.hpp0000644000176200001440000000155213766554456024402 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_VAR_DECL_DEF_HPP #define STAN_LANG_AST_NODE_VAR_DECL_DEF_HPP #include #include namespace stan { namespace lang { var_decl::var_decl() : name_(""), bare_type_(ill_formed_type()), def_(nil()) {} var_decl::var_decl(const std::string& name) : name_(name), bare_type_(ill_formed_type()), def_(nil()) {} var_decl::var_decl(const std::string& name, const bare_expr_type& type) : name_(name), bare_type_(type), def_(nil()) {} var_decl::var_decl(const std::string& name, const bare_expr_type& type, const expression& def) : name_(name), bare_type_(type), def_(def) {} bare_expr_type var_decl::bare_type() const { return bare_type_; } expression var_decl::def() const { return def_; } std::string var_decl::name() const { return name_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/function_decl_defs.hpp0000644000176200001440000000140113766554456025613 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FUNCTION_DECL_DEFS_HPP #define STAN_LANG_AST_NODE_FUNCTION_DECL_DEFS_HPP #include #include namespace stan { namespace lang { /** * AST node for a sequence of function declarations and * definitions. */ struct function_decl_defs { /** * Construct an empty sequence of declarations and definitions. */ function_decl_defs(); /** * Construct a sequence of declarations and definitions from the * specified sequence. */ function_decl_defs( const std::vector& decl_defs); // NOLINT /** * Sequence of declarations and definitions. */ std::vector decl_defs_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/idx_def.hpp0000644000176200001440000000115213766554456023403 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_IDX_DEF_HPP #define STAN_LANG_AST_NODE_IDX_DEF_HPP #include #include #include namespace stan { namespace lang { idx::idx() {} idx::idx(const uni_idx& i) : idx_(i) {} idx::idx(const multi_idx& i) : idx_(i) {} idx::idx(const omni_idx& i) : idx_(i) {} idx::idx(const lb_idx& i) : idx_(i) {} idx::idx(const ub_idx& i) : idx_(i) {} idx::idx(const lub_idx& i) : idx_(i) {} std::string idx::to_string() const { write_idx_vis vis; return boost::apply_visitor(vis, idx_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/statements.hpp0000644000176200001440000000163113766554456024172 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_STATEMENTS_HPP #define STAN_LANG_AST_NODE_STATEMENTS_HPP #include namespace stan { namespace lang { struct local_var_decl; struct statement; /** * Holder for local variable declarations and a sequence of * statements. */ struct statements { /** * Sequence of variable declarations. */ std::vector local_decl_; /** * Sequence of statements. */ std::vector statements_; /** * Nullary constructor for statements. */ statements(); /** * Construct a statements object from a sequence of local * declarations and sequence of statements. * * @param local_decl sequence of local variable declarations * @param stmts sequence of statements */ statements(const std::vector& local_decl, const std::vector& stmts); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/variable_def.hpp0000644000176200001440000000060513766554456024406 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_VARIABLE_DEF_HPP #define STAN_LANG_AST_NODE_VARIABLE_DEF_HPP #include #include namespace stan { namespace lang { variable::variable() {} variable::variable(const std::string& name) : name_(name) {} void variable::set_type(const bare_expr_type& bare_type) { type_ = bare_type; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/function_decl_def_def.hpp0000644000176200001440000000156013766554456026254 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FUNCTION_DECL_DEF_DEF_HPP #define STAN_LANG_AST_NODE_FUNCTION_DECL_DEF_DEF_HPP #include #include #include namespace stan { namespace lang { function_decl_def::function_decl_def() {} function_decl_def::function_decl_def(const bare_expr_type& return_type, const std::string& name, const std::vector& arg_decls, const statement& body) : return_type_(return_type), name_(name), arg_decls_(arg_decls), body_(body) {} bool function_decl_def::has_only_int_args() const { for (size_t i = 0; i < arg_decls_.size(); ++i) if (!arg_decls_[i].bare_type().innermost_type().is_int_type()) return false; return true; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/offset_multiplier.hpp0000644000176200001440000000226713766554456025545 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_OFFSET_MULTIPLIER_HPP #define STAN_LANG_AST_NODE_OFFSET_MULTIPLIER_HPP #include namespace stan { namespace lang { /** * AST structure for a offset_multiplier object with a offset and multiplier * value. */ struct offset_multiplier { /** * Offset of offset-multiplier pair with nil value if only * multiplier. */ expression offset_; /** * Multiplier of offset-multiplier pair with nil value if only * offset. */ expression multiplier_; /** * Construct a default offset_multiplier object. */ offset_multiplier(); /** * Construct a offset_multiplier object with the specified offset and * multiplier. * * @param offset offset * @param multiplier multiplier */ offset_multiplier(const expression &offset, const expression &multiplier); /** * Return true if the offset is non-nil. * * @return true if there is a offset */ bool has_offset() const; /** * Return true if the multiplier is non-nil. * * @return true if there is a multiplier */ bool has_multiplier() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/conditional_statement.hpp0000644000176200001440000000237413766554456026377 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_CONDITIONAL_STATEMENT_HPP #define STAN_LANG_AST_NODE_CONDITIONAL_STATEMENT_HPP #include #include #include namespace stan { namespace lang { /** * AST node for conditional statements. */ struct conditional_statement { /** * Construct an empty conditional statement. */ conditional_statement(); /** * Construct a conditional statement with the parallel sequences * of conditions and statements. If there is a default case at * the end of the conditional statement without a condition, the * statement sequence will be one element longer than the * condition sequence. * * @param[in] conditions conditions for conditional * @param[in] statements bodies of conditionals */ conditional_statement(const std::vector& conditions, const std::vector& statements); /** * The sequence of conditions (parallel with bodies). */ std::vector conditions_; /** * The sequence of bodies to execute. This is the same size or * one longer than conditions_. */ std::vector bodies_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/integrate_ode_def.hpp0000644000176200001440000000152213766554456025431 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_INTEGRATE_ODE_DEF_HPP #define STAN_LANG_AST_NODE_INTEGRATE_ODE_DEF_HPP #include #include namespace stan { namespace lang { integrate_ode::integrate_ode() {} integrate_ode::integrate_ode(const std::string& integration_function_name, const std::string& system_function_name, const expression& y0, const expression& t0, const expression& ts, const expression& theta, const expression& x, const expression& x_int) : integration_function_name_(integration_function_name), system_function_name_(system_function_name), y0_(y0), t0_(t0), ts_(ts), theta_(theta), x_(x), x_int_(x_int) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/lb_idx_def.hpp0000644000176200001440000000041713766554456024063 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_LB_IDX_DEF_HPP #define STAN_LANG_AST_NODE_LB_IDX_DEF_HPP #include namespace stan { namespace lang { lb_idx::lb_idx() {} lb_idx::lb_idx(const expression& lb) : lb_(lb) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/print_statement_def.hpp0000644000176200001440000000057713766554456026051 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_PRINT_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_PRINT_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { print_statement::print_statement() {} print_statement::print_statement(const std::vector& printables) : printables_(printables) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/conditional_statement_def.hpp0000644000176200001440000000074513766554456027215 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_CONDITIONAL_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_CONDITIONAL_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { conditional_statement::conditional_statement() {} conditional_statement ::conditional_statement( const std::vector& conditions, const std::vector& bodies) : conditions_(conditions), bodies_(bodies) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/range_def.hpp0000644000176200001440000000066113766554456023717 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_RANGE_DEF_HPP #define STAN_LANG_AST_NODE_RANGE_DEF_HPP #include namespace stan { namespace lang { range::range() {} range::range(const expression& low, const expression& high) : low_(low), high_(high) {} bool range::has_low() const { return !is_nil(low_.expr_); } bool range::has_high() const { return !is_nil(high_.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/for_statement_def.hpp0000644000176200001440000000071313766554456025473 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_FOR_STATEMENT_DEF_HPP #define STAN_LANG_AST_NODE_FOR_STATEMENT_DEF_HPP #include #include namespace stan { namespace lang { for_statement::for_statement() {} for_statement::for_statement(const std::string& variable, const range& range, const statement& stmt) : variable_(variable), range_(range), statement_(stmt) {} } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/node/unary_op.hpp0000644000176200001440000000150313766554456023635 0ustar liggesusers#ifndef STAN_LANG_AST_NODE_UNARY_OP_HPP #define STAN_LANG_AST_NODE_UNARY_OP_HPP #include #include namespace stan { namespace lang { /** * AST structure for unary operations consisting of an operation * and argument. */ struct unary_op { /** * Character-level representation of operation. */ char op; /** * Argument. */ expression subject; /** * Type of result. */ bare_expr_type type_; /** * Construct a default unary operation. */ unary_op(); /** * Construct a unary operation of the specified operation and * argument. * * @param op operator representation * @param subject argument */ unary_op(char op, const expression& subject); }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/scope.hpp0000644000176200001440000000770413766554456022176 0ustar liggesusers#ifndef STAN_LANG_AST_SCOPE_HPP #define STAN_LANG_AST_SCOPE_HPP #include #include namespace stan { namespace lang { /** * Structure which tracks enclosing program block(s) encountered by parser. * Var_map records program block where variable declared. * Grammar rules check allowed constructs in (enclosing) block. */ class scope { /** * Outermost enclosing program block. */ origin_block program_block_; /** * True if in a nested (local) program block. */ bool is_local_; public: /** * No arg constructor, defaults: * - \p program_block_ : model_name_origin * - \p is_local_ : \c false */ scope(); /** * Construct an origin for variable in a specified block. * Default \c is_local is \c false, i.e., not in a local block. * * @param program_block enclosing program block */ scope(const origin_block& program_block); // NOLINT(runtime/explicit) /** * Construct scope for a variable in specified outer program block, * specify whether or not variable is declared in a local block. * * @param program_block enclosing program block * @param is_local true if declared in a local block */ scope(const origin_block& program_block, const bool& is_local); /** * Return value for outermost enclosing program block. * * @return program_block enclosing program block */ origin_block program_block() const; /** * Return true when declared in a nested (local) block, * enclosing block can be any \c origin_block value. * * @return true when scope is nested (local) block. */ bool is_local() const; /** * Flags local scopes which permit parameter variables. * Allows local blocks in functions, transfromed parameter, * and model blocks; disallows local blocks in transformed data * and generated quantities program blocks. * * @return true for local parameter origin block types */ bool local_allows_var() const; /** * Flags scopes where parameter variables are declared, * i.e., top-level of parameter or transformed parameter block. * * @return true for top-level parameter origin block types */ bool par_or_tpar() const; /** * Return true when declared in transformed parameter block. * * @return true for transformed parameter origin block */ bool tpar() const; /** * Return true when declared as function argument. * * @return true for function origin block types */ bool fun() const; /** * Return true when declared as argument to non-void function. * * @return true for non void function origin block types */ bool non_void_fun() const; /** * Return true when declared as argument to void function. * * @return true for void function origin block types */ bool void_fun() const; /** * Return true when program block allows assignment to variables * i.e., not data or parameter block * * @return true when program block allows access to LP */ bool allows_assignment() const; /** * Return true when program block allows access to LP function * * @return true when program block allows access to LP function */ bool allows_lp_fun() const; /** * Return true when program block allows access to RNG * i.e., transformed data block or rng function * * @return true when program block allows access to RNG */ bool allows_rng() const; /** * Return true when program block allows access to sampling statement * * @return true when program block allows access to sampling statement */ bool allows_sampling() const; /** * Returns true for origin blocks where size-denoting expression * declarations are allowed. Origin blocks not allowed: * - parameters * - transformed parameters * - generated quantities * * @return true if origin block allows size-denoting variable declaration. */ bool allows_size() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/variable_map.hpp0000644000176200001440000000502713766554456023503 0ustar liggesusers#ifndef STAN_LANG_AST_VARIABLE_MAP_HPP #define STAN_LANG_AST_VARIABLE_MAP_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * A map from variable names to their declarations and their scope. */ struct variable_map { /** * A variable type and the scope of its declaration. */ typedef std::pair range_t; /** * Return true if a variable has been declared with the * specified name. * * @param name variable name * @return true if the variable has been declared */ bool exists(const std::string& name) const; /** * Return the type for the variable with the specified name. * * @param name variable name * @return base declaration for variable with the specified name * @throw std::invalid_argument if the variable has not been * declared */ var_decl get(const std::string& name) const; /** * Return the type declared for the variable with the specified * name. * * @param name variable name * @return bare var type * @throw std::invalid_argument if the variable has not been * declared */ bare_expr_type get_bare_type(const std::string& name) const; /** * Return the scope in which the variable is declared for the * variable with the specified name. * * @param name variable name * @return scope of the variable * @throw std::invalid_argument if the variable has not been * declared */ scope get_scope(const std::string& name) const; /** * Add the specified declaration for a variable with the * specified name in the specified scope. * Destructively overwrites the declaration of an existing * variable if called with a new declaration and scope. * * @param name variable name * @param var_decl variable declaration * @param scope_decl declaration scope */ void add(const std::string& name, const var_decl& var_decl, const scope& scope_decl); /** * Remove the declaraiton for the variable with the specified * name. If the variable had not already been declared, it * the function exits silently. * * @param name name of variable to remove */ void remove(const std::string& name); /** * The stored map from function names to their declarations and * origins. */ std::map map_; size_t size() const; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/nil.hpp0000644000176200001440000000041413766554456021636 0ustar liggesusers#ifndef STAN_LANG_AST_NIL_HPP #define STAN_LANG_AST_NIL_HPP namespace stan { namespace lang { /** * The nil structure used as a placeholder for undefined or empty * values in several structures. */ struct nil {}; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/variable_map_def.hpp0000644000176200001440000000214013766554456024312 0ustar liggesusers#ifndef STAN_LANG_AST_VARIABLE_MAP_DEF_HPP #define STAN_LANG_AST_VARIABLE_MAP_DEF_HPP #include #include #include namespace stan { namespace lang { bool variable_map::exists(const std::string& name) const { return map_.find(name) != map_.end(); } var_decl variable_map::get(const std::string& name) const { if (!exists(name)) throw std::invalid_argument("variable does not exist"); return map_.find(name)->second.first; } bare_expr_type variable_map::get_bare_type(const std::string& name) const { return get(name).bare_type_; } scope variable_map::get_scope(const std::string& name) const { if (!exists(name)) throw std::invalid_argument("variable does not exist"); return map_.find(name)->second.second; } void variable_map::add(const std::string& name, const var_decl& decl, const scope& scope_decl) { map_[name] = range_t(decl, scope_decl); } void variable_map::remove(const std::string& name) { map_.erase(name); } size_t variable_map::size() const { return map_.size(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/sigs/0000755000176200001440000000000013766554456021311 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/ast/sigs/function_signatures_def.hpp0000644000176200001440000004247613766554456026746 0ustar liggesusers#ifndef STAN_LANG_AST_SIGS_FUNCTION_SIGNATURES_DEF_HPP #define STAN_LANG_AST_SIGS_FUNCTION_SIGNATURES_DEF_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { void function_signatures::reset_sigs() { if (sigs_ == 0) return; delete sigs_; sigs_ = 0; } function_signatures& function_signatures::instance() { // TODO(carpenter): for threaded autodiff, requires double-check lock if (!sigs_) sigs_ = new function_signatures; return *sigs_; } void function_signatures::set_user_defined( const std::pair& name_sig) { user_defined_set_.insert(name_sig); } bool function_signatures::is_user_defined( const std::pair& name_sig) { return user_defined_set_.find(name_sig) != user_defined_set_.end(); } bool function_signatures::is_defined(const std::string& name, const function_signature_t& sig) { if (sigs_map_.find(name) == sigs_map_.end()) return false; const std::vector sigs = sigs_map_[name]; // check return type for (size_t i = 0; i < sigs.size(); ++i) if (sig.first == sigs[i].first && sig.second == sigs[i].second) return true; return false; } bool function_signatures::discrete_first_arg(const std::string& fun) const { using std::map; using std::string; using std::vector; map >::const_iterator it = sigs_map_.find(fun); if (it == sigs_map_.end()) return false; const vector sigs = it->second; for (size_t i = 0; i < sigs.size(); ++i) { if (sigs[i].second.size() == 0 || !sigs[i].second[0].innermost_type().is_int_type()) return false; } return true; } function_signature_t function_signatures::get_definition( const std::string& name, const function_signature_t& sig) { const std::vector sigs = sigs_map_[name]; for (size_t i = 0; i < sigs.size(); ++i) if (sig.first == sigs[i].first && sig.second == sigs[i].second) { return sigs[i]; } bare_expr_type ill_formed; std::vector arg_types; return function_signature_t(ill_formed, arg_types); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type, const std::vector& arg_types) { function_signature_t sig_def(result_type, arg_types); sigs_map_[name].push_back(function_signature_t(result_type, arg_types)); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type) { std::vector arg_types; add(name, result_type, arg_types); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type) { std::vector arg_types; arg_types.push_back(arg_type); add(name, result_type, arg_types); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2) { std::vector arg_types; arg_types.push_back(arg_type1); arg_types.push_back(arg_type2); add(name, result_type, arg_types); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3) { std::vector arg_types; arg_types.push_back(arg_type1); arg_types.push_back(arg_type2); arg_types.push_back(arg_type3); add(name, result_type, arg_types); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4) { std::vector arg_types; arg_types.push_back(arg_type1); arg_types.push_back(arg_type2); arg_types.push_back(arg_type3); arg_types.push_back(arg_type4); add(name, result_type, arg_types); } void function_signatures::add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4, const bare_expr_type& arg_type5) { std::vector arg_types; arg_types.push_back(arg_type1); arg_types.push_back(arg_type2); arg_types.push_back(arg_type3); arg_types.push_back(arg_type4); arg_types.push_back(arg_type5); add(name, result_type, arg_types); } void function_signatures::add( const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4, const bare_expr_type& arg_type5, const bare_expr_type& arg_type6) { std::vector arg_types; arg_types.push_back(arg_type1); arg_types.push_back(arg_type2); arg_types.push_back(arg_type3); arg_types.push_back(arg_type4); arg_types.push_back(arg_type5); arg_types.push_back(arg_type6); add(name, result_type, arg_types); } void function_signatures::add( const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4, const bare_expr_type& arg_type5, const bare_expr_type& arg_type6, const bare_expr_type& arg_type7) { std::vector arg_types; arg_types.push_back(arg_type1); arg_types.push_back(arg_type2); arg_types.push_back(arg_type3); arg_types.push_back(arg_type4); arg_types.push_back(arg_type5); arg_types.push_back(arg_type6); arg_types.push_back(arg_type7); add(name, result_type, arg_types); } void function_signatures::add_nullary(const ::std::string& name) { add(name, bare_expr_type(double_type())); } void function_signatures::add_unary(const ::std::string& name) { double_type tDouble; bare_expr_type a1(tDouble); add(name, a1, a1); } void function_signatures::add_unary_vectorized(const ::std::string& name) { // note: vectorized functions always return elements of type real; // integer elements are promoted to real elements add(name, bare_expr_type(double_type()), bare_expr_type(int_type())); add(name, bare_expr_type(double_type()), bare_expr_type(double_type())); add(name, bare_expr_type(vector_type()), bare_expr_type(vector_type())); add(name, bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add(name, bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); int_type tInt; bare_array_type arInt(tInt); bare_expr_type arIntType(arInt); double_type tDouble; bare_array_type arDouble(tDouble); bare_expr_type arDoubleType(arDouble); matrix_type tMatrix; bare_array_type arMatrix(tMatrix); bare_expr_type arMatrixType(arMatrix); row_vector_type tRowVector; bare_array_type arRowVector(tRowVector); bare_expr_type arRowVectorType(arRowVector); vector_type tVector; bare_array_type arVector(tVector); bare_expr_type arVectorType(arVector); for (size_t i = 0; i < 8; ++i) { add(name, arDoubleType, arIntType); add(name, arDoubleType, arDoubleType); add(name, arMatrixType, arMatrixType); add(name, arRowVectorType, arRowVectorType); add(name, arVectorType, arVectorType); arIntType = bare_expr_type(bare_array_type(arIntType)); arDoubleType = bare_expr_type(bare_array_type(arDoubleType)); arMatrixType = bare_expr_type(bare_array_type(arMatrixType)); arRowVectorType = bare_expr_type(bare_array_type(arRowVectorType)); arVectorType = bare_expr_type(bare_array_type(arVectorType)); } } void function_signatures::add_binary(const ::std::string& name) { add(name, bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); } void function_signatures::add_ternary(const ::std::string& name) { add(name, bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); } void function_signatures::add_quaternary(const ::std::string& name) { add(name, bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); } template bare_expr_type function_signatures::rng_return_type(const bare_expr_type& t) { T return_type; return t.is_primitive() ? bare_expr_type(return_type) : bare_expr_type(bare_array_type(return_type, 1)); } template bare_expr_type function_signatures::rng_return_type(const bare_expr_type& t, const bare_expr_type& u) { T return_type; return t.is_primitive() && u.is_primitive() ? bare_expr_type(return_type) : bare_expr_type(bare_array_type(return_type, 1)); } template bare_expr_type function_signatures::rng_return_type(const bare_expr_type& t, const bare_expr_type& u, const bare_expr_type& v) { return rng_return_type(rng_return_type(t, u), v); } int function_signatures::num_promotions( const std::vector& call_args, const std::vector& sig_args) { if (call_args.size() != sig_args.size()) { return -1; // failure } int num_promotions = 0; for (size_t i = 0; i < call_args.size(); ++i) { if (call_args[i] == sig_args[i]) { continue; } else if (call_args[i].is_primitive() && sig_args[i].is_double_type()) { ++num_promotions; } else { return -1; // failed match } } return num_promotions; } int function_signatures::get_signature_matches( const std::string& name, const std::vector& args, function_signature_t& signature) { if (!has_key(name)) return 0; std::vector signatures = sigs_map_[name]; size_t min_promotions = std::numeric_limits::max(); size_t num_matches = 0; for (size_t i = 0; i < signatures.size(); ++i) { signature = signatures[i]; int promotions = num_promotions(args, signature.second); if (promotions < 0) continue; // no match size_t promotions_ui = static_cast(promotions); if (promotions_ui < min_promotions) { min_promotions = promotions_ui; num_matches = 1; } else if (promotions_ui == min_promotions) { ++num_matches; } } return num_matches; } bool is_binary_operator(const std::string& name) { return name == "add" || name == "subtract" || name == "multiply" || name == "divide" || name == "modulus" || name == "mdivide_left" || name == "mdivide_right" || name == "elt_multiply" || name == "elt_divide"; } bool is_unary_operator(const std::string& name) { return name == "minus" || name == "logical_negation"; } bool is_unary_postfix_operator(const std::string& name) { return name == "transpose"; } bool is_operator(const std::string& name) { return is_binary_operator(name) || is_unary_operator(name) || is_unary_postfix_operator(name); } std::string fun_name_to_operator(const std::string& name) { // binary infix (pow handled by parser) if (name == "add") return "+"; if (name == "subtract") return "-"; if (name == "multiply") return "*"; if (name == "divide") return "/"; if (name == "modulus") return "%"; if (name == "mdivide_left") return "\\"; if (name == "mdivide_right") return "/"; if (name == "elt_multiply") return ".*"; if (name == "elt_divide") return "./"; // unary prefix (+ handled by parser) if (name == "minus") return "-"; if (name == "logical_negation") return "!"; // unary suffix if (name == "transpose") return "'"; // none of the above return "ERROR"; } void print_signature(const std::string& name, const std::vector& arg_types, bool sampling_error_style, std::ostream& msgs) { static size_t OP_SIZE = std::string("operator").size(); msgs << " "; if (name.size() > OP_SIZE && name.substr(0, OP_SIZE) == "operator") { std::string operator_name = name.substr(OP_SIZE); if (arg_types.size() == 2) { msgs << arg_types[0] << " " << operator_name << " " << arg_types[1] << std::endl; return; } else if (arg_types.size() == 1) { if (operator_name == "'") // exception for postfix msgs << arg_types[0] << operator_name << std::endl; else msgs << operator_name << arg_types[0] << std::endl; return; } else { // should not be reachable due to operator grammar // continue on purpose to get more info to user if this happens msgs << "Operators must have 1 or 2 arguments." << std::endl; } } if (sampling_error_style && arg_types.size() > 0) msgs << arg_types[0] << " ~ "; msgs << name << "("; size_t start = sampling_error_style ? 1 : 0; for (size_t j = start; j < arg_types.size(); ++j) { if (j > start) msgs << ", "; msgs << arg_types[j]; } msgs << ")" << std::endl; } bare_expr_type function_signatures::get_result_type( const std::string& name, const std::vector& args, std::ostream& error_msgs, bool sampling_error_style) { std::vector signatures = sigs_map_[name]; size_t match_index = 0; size_t min_promotions = std::numeric_limits::max(); size_t num_matches = 0; std::string display_name; if (is_operator(name)) { display_name = "operator" + fun_name_to_operator(name); } else if (sampling_error_style && ends_with("_log", name)) { display_name = name.substr(0, name.size() - 4); } else if (sampling_error_style && (ends_with("_lpdf", name) || ends_with("_lcdf", name))) { display_name = name.substr(0, name.size() - 5); } else { display_name = name; } for (size_t i = 0; i < signatures.size(); ++i) { int promotions = num_promotions(args, signatures[i].second); if (promotions < 0) continue; // no match size_t promotions_ui = static_cast(promotions); if (promotions_ui < min_promotions) { min_promotions = promotions_ui; match_index = i; num_matches = 1; } else if (promotions_ui == min_promotions) { ++num_matches; } } if (num_matches == 1) return signatures[match_index].first; // all returns after here are for ill-typed input if (num_matches == 0) { error_msgs << "No matches for: " << std::endl << std::endl; } else { error_msgs << "Ambiguous: " << num_matches << " matches with " << min_promotions << " integer promotions for: " << std::endl; } print_signature(display_name, args, sampling_error_style, error_msgs); if (signatures.size() == 0) { error_msgs << std::endl << (sampling_error_style ? "Distribution " : "Function ") << display_name << " not found."; if (sampling_error_style) error_msgs << " Require function with _lpdf or _lpmf or _log suffix"; error_msgs << std::endl; } else { error_msgs << std::endl << "Available argument signatures for " << display_name << ":" << std::endl << std::endl; for (size_t i = 0; i < signatures.size(); ++i) { print_signature(display_name, signatures[i].second, sampling_error_style, error_msgs); } error_msgs << std::endl; } return bare_expr_type(); // ill-formed dummy } function_signatures::function_signatures() { #include // NOLINT } bool function_signatures::has_user_defined_key(const std::string& key) const { using std::pair; using std::set; using std::string; for (set >::const_iterator it = user_defined_set_.begin(); it != user_defined_set_.end(); ++it) { if (it->first == key) return true; } return false; } std::set function_signatures::key_set() const { using std::map; using std::set; using std::string; using std::vector; set result; for (map >::const_iterator it = sigs_map_.begin(); it != sigs_map_.end(); ++it) result.insert(it->first); return result; } bool function_signatures::has_key(const std::string& key) const { return sigs_map_.find(key) != sigs_map_.end(); } /** * Global variable holding singleton; initialized to NULL. * Retrieve through the static class function * function_signatures::instance(). */ function_signatures* function_signatures::sigs_ = 0; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/sigs/function_signature_t.hpp0000644000176200001440000000075213766554456026257 0ustar liggesusers#ifndef STAN_LANG_AST_SIGS_FUNCTION_SIGNATURE_T_HPP #define STAN_LANG_AST_SIGS_FUNCTION_SIGNATURE_T_HPP #include #include #include namespace stan { namespace lang { /** * The type of a function signature, mapping a vector of * argument expression types to a result expression type. */ typedef std::pair > function_signature_t; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/ast/sigs/function_signatures.hpp0000644000176200001440000003261013766554456026115 0ustar liggesusers#ifndef STAN_LANG_AST_SIGS_FUNCTION_SIGNATURES_HPP #define STAN_LANG_AST_SIGS_FUNCTION_SIGNATURES_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * This class is a singleton used to store the available functions * in the Stan object language and their signatures. Use * instance() to retrieve the single instance. */ class function_signatures { public: /** * Return the instance of this singleton. * * @return singleton function signatures object */ static function_signatures& instance(); /** * Reset the signature singleton to contain no instances. */ static void reset_sigs(); /** * Set the specified name and signature to be a user-defined * function. * * @param name_sig name and signature of user-defined function */ void set_user_defined( const std::pair& name_sig); /** * Return true if the specified name and signature have been * added as user-defined functions. * * @param name_sig name and signature of function */ bool is_user_defined( const std::pair& name_sig); /** * Return the function definition given the function name and argument * expression types. Used to check argument qualifiers, which are * only available from function definition. * * @param name function name * @param sig functionand sig */ function_signature_t get_definition(const std::string& name, const function_signature_t& sig); /** * Add a built-in function with the specified name, result, type * and arguments. * * @param name function name * @param result_type function return type * @param arg_types sequence of argument types */ void add(const std::string& name, const bare_expr_type& result_type, const std::vector& arg_types); /** * Add a built-in function with the specifed name and result * type, with no arguments. * * @param name function name * @param result_type function return type */ void add(const std::string& name, const bare_expr_type& result_type); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument * @param arg_type2 type of second argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument * @param arg_type2 type of second argument * @param arg_type3 type of third argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument * @param arg_type2 type of second argument * @param arg_type3 type of third argument * @param arg_type4 type of fourth argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument * @param arg_type2 type of second argument * @param arg_type3 type of third argument * @param arg_type4 type of fourth argument * @param arg_type5 type of fifth argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4, const bare_expr_type& arg_type5); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument * @param arg_type2 type of second argument * @param arg_type3 type of third argument * @param arg_type4 type of fourth argument * @param arg_type5 type of fifth argument * @param arg_type6 type of sixth argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4, const bare_expr_type& arg_type5, const bare_expr_type& arg_type6); /** * Add a built-in function with the specifed name, result type, * and argument types. * * @param name function name * @param result_type function return type * @param arg_type1 type of first argument * @param arg_type2 type of second argument * @param arg_type3 type of third argument * @param arg_type4 type of fourth argument * @param arg_type5 type of fifth argument * @param arg_type6 type of sixth argument * @param arg_type7 type of seventh argument */ void add(const std::string& name, const bare_expr_type& result_type, const bare_expr_type& arg_type1, const bare_expr_type& arg_type2, const bare_expr_type& arg_type3, const bare_expr_type& arg_type4, const bare_expr_type& arg_type5, const bare_expr_type& arg_type6, const bare_expr_type& arg_type7); /** * Add a built-in function with the specified name, a real * return type, and no arguments. * * @param name function name */ void add_nullary(const ::std::string& name); /** * Add a built-in function with the specified name, a real * return type, and a single real argument. * * @param name function name */ void add_unary(const ::std::string& name); /** * Add built-in functions for all the vectorized form of a unary * function with the speicifed name and a single real argument. * * @param name function name */ void add_unary_vectorized(const ::std::string& name); /** * Add a built-in function with the specified name, a real * return type, and two real arguments. * * @param name function name */ void add_binary(const ::std::string& name); /** * Add a built-in function with the specified name, a real * return type, and three real arguments. * * @param name function name */ void add_ternary(const ::std::string& name); /** * Add a built-in function with the specified name, a real * return type, and four real arguments. * * @param name function name */ void add_quaternary(const ::std::string& name); /** * Determine the return type of distributions' RNG function * based on the primitiveness of the arguments. If both * arguments are scalar, the return type is int or real * depending on the distribtuion. Otherwise, the return type is * int[] for discrete distributions and real[] for continuous * ones. * * @param t type of first argument * @return expression type resulting from primitiveness of * arguments and distribution's support */ template bare_expr_type rng_return_type(const bare_expr_type& t); /** * Determine the return type of distributions' RNG function * based on the primitiveness of the arguments. If both * arguments are scalar, the return type is int or real * depending on the distribtuion. Otherwise, the return type is * int[] for discrete distributions and real[] for continuous * ones. * * @param t type of first argument * @param u type of second argument * @return expression type resulting from primitiveness of * arguments and distribution's support */ template bare_expr_type rng_return_type(const bare_expr_type& t, const bare_expr_type& u); /** * Determine the return type of distributions' RNG function * based on the primitiveness of the arguments. If both * arguments are scalar, the return type is int or real * depending on the distribtuion. Otherwise, the return type is * int[] for discrete distributions and real[] for continuous * ones. * * @param t type of first argument * @param u type of second argument * @param v type of third argument * @return expression type resulting from primitiveness of * arguments and distribution's support */ template bare_expr_type rng_return_type(const bare_expr_type& t, const bare_expr_type& u, const bare_expr_type& v); /** * Return the number of integer to real promotions required to * convert the specified call arguments to the specified * signature arguments. * * @param call_args argument types in function call * @param sig_args argument types in function signature * @return number of promotions required to cast call arguments * to the signature arguments */ int num_promotions(const std::vector& call_args, const std::vector& sig_args); /** * Return the result expression type resulting from applying a * function of the speicified name and argument types, with * errors going to the specified error message string and a flag * to control error output. * * @param name function name * @param args sequence of argument types it is called with * @param error_msgs stream to which error messages are written * @param sampling_error_style type of error message, with true * value indicating that it was called in a sampling statement * @return expression type resulting from applying function with * specified names to arguments of specified type */ bare_expr_type get_result_type(const std::string& name, const std::vector& args, std::ostream& error_msgs, bool sampling_error_style = false); /** * Return the number of declared function signatures match for * the specified name, argument types, and signature. * * @param name function name * @param args argument types with which function is called * @param signature signature to match * @return number of matches */ int get_signature_matches(const std::string& name, const std::vector& args, function_signature_t& signature); /** * Return true if the specified function name is defined for the * specified signature. * * @param name function name * @param sig signature * @return true if function name is defined for signature */ bool is_defined(const std::string& name, const function_signature_t& sig); /** * Return true if the specified name is the name of a * user-defined function. * * @param name function name * @return true if function name has been declared as a * user-defined function */ bool has_user_defined_key(const std::string& name) const; /** * Return the set of function names defined. * * @return set of function names */ std::set key_set() const; /** * Return true if specified key is the name of a declared * function. * * @param key function name * @return true if specified function name has been declared */ bool has_key(const std::string& key) const; /** * Return true if all of the function signatures for functions * with the specified name have integer base types. * * @param name function name * @return true if all first arguments to function with * specified name are integers */ bool discrete_first_arg(const std::string& name) const; private: /** * Construction is private to enforce singleton pattern. */ function_signatures(); /** * Copy constructor also private to enforce singleton pattern. * * @param fs function signatures */ function_signatures(const function_signatures& fs); /** * The mapping from function names to their signatures. */ std::map > sigs_map_; /** * The set of user-defined function name and signature pairs. */ std::set > user_defined_set_; /** * Pointer to store singleton instance; initialized out of class. */ static function_signatures* sigs_; // init below outside of class }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/parser.hpp0000644000176200001440000000752013766554456021566 0ustar liggesusers#ifndef STAN_LANG_PARSER_HPP #define STAN_LANG_PARSER_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Parse the program from the specified input stream, writing * warning messages to the specified output stream, with the * specified model, setting the specified program to the result, * with a flag indicating whether undefined function declarations * are allowed. * * @param out stream to which error messages and warnings are * written * @param in stream from which the program is read * @param name name of program * @param reader program reader with include structure * @param prog program into which result is written * @param allow_undefined true if functions may be declared but * not defined in the functions block * @return true if parse succeeds */ bool parse(std::ostream* out, std::istream& in, const std::string& name, const io::program_reader& reader, program& prog, const bool allow_undefined = false) { using boost::spirit::qi::expectation_failure; using boost::spirit::qi::phrase_parse; stan::lang::function_signatures::reset_sigs(); std::ostringstream buf; buf << in.rdbuf(); std::string stan_string = buf.str() + "\n"; if (!is_nonempty(stan_string)) *out << std::endl << "WARNING: empty program" << std::endl; typedef std::string::const_iterator input_iterator; typedef boost::spirit::line_pos_iterator lp_iterator; lp_iterator fwd_begin = lp_iterator(stan_string.begin()); lp_iterator fwd_end = lp_iterator(stan_string.end()); program_grammar prog_grammar(name, reader, allow_undefined); whitespace_grammar whitesp_grammar(prog_grammar.error_msgs_); bool parse_succeeded = false; try { parse_succeeded = phrase_parse(fwd_begin, fwd_end, prog_grammar, whitesp_grammar, prog); std::string diagnostics = prog_grammar.error_msgs_.str(); if (out && is_nonempty(diagnostics)) *out << "DIAGNOSTIC(S) FROM PARSER:" << std::endl << diagnostics << std::endl; } catch (const expectation_failure& e) { std::stringstream msg; std::string diagnostics = prog_grammar.error_msgs_.str(); if (out && is_nonempty(diagnostics)) msg << "SYNTAX ERROR, MESSAGE(S) FROM PARSER:" << std::endl << diagnostics; if (out) { std::stringstream ss; ss << e.what_; std::string e_what = ss.str(); std::string angle_eps(""); if (e_what != angle_eps) msg << "PARSER EXPECTED: " << e.what_ << std::endl; } throw std::invalid_argument(msg.str()); } catch (const std::exception& e) { std::stringstream msg; msg << "PROGRAM ERROR, MESSAGE(S) FROM PARSER:" << std::endl << prog_grammar.error_msgs_.str() << std::endl; throw std::invalid_argument(msg.str()); } bool consumed_all_input = (fwd_begin == fwd_end); bool success = parse_succeeded && consumed_all_input; if (!success) { std::stringstream msg; if (!parse_succeeded) msg << "PARSE FAILED." << std::endl; if (!consumed_all_input) { std::basic_stringstream unparsed_non_ws; unparsed_non_ws << boost::make_iterator_range(fwd_begin, fwd_end); msg << "PARSER FAILED TO PARSE INPUT COMPLETELY" << std::endl << "STOPPED AT LINE " << get_line(fwd_begin) << ": " << std::endl << unparsed_non_ws.str() << std::endl; } msg << std::endl << prog_grammar.error_msgs_.str() << std::endl; throw std::invalid_argument(msg.str()); } return true; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/compile_functions.hpp0000644000176200001440000000361613766554456024014 0ustar liggesusers#ifndef STAN_LANG_COMPILE_FUNCTIONS_HPP #define STAN_LANG_COMPILE_FUNCTIONS_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Read a Stan file with only the functions block from the * specified input, parse it, and write the C++ code for it * to the specified output. * * @param[in] msgs Output stream for warning messages * @param[in] stan_funcs_in Stan model specification * @param[in] cpp_out C++ code output stream * @param[in] namespaces Vector of namespace to generate the functions in * @param[in] allow_undefined Permit undefined functions? * @param filename name of file or other source from which input * stream was derived * @param include_paths array of paths to search for included files * @return false if code could not be generated * due to syntax error in the functions file; * true otherwise. */ bool compile_functions(std::ostream* msgs, std::istream& stan_funcs_in, std::ostream& cpp_out, const std::vector& namespaces, const bool allow_undefined = false, const std::string& filename = "unknown file name", const std::vector& include_paths = std::vector()) { io::program_reader reader(stan_funcs_in, filename, include_paths); std::string s = reader.program(); std::stringstream ss(s); program prog; std::string name("functions_only_model"); bool parsed_ok = parse(msgs, ss, name, reader, prog, allow_undefined); if (!parsed_ok) return false; // syntax error in program generate_standalone_functions(prog, namespaces, reader.history(), cpp_out); return true; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/0000755000176200001440000000000013766604372021534 5ustar liggesusersStanHeaders/inst/include/src/stan/lang/generator/generate_idx.hpp0000644000176200001440000000111313766554456024706 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_IDX_HPP #define STAN_LANG_GENERATOR_GENERATE_IDX_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the specified multiple index on the specified stream. * * @param[in] i multiple index to generate * @param[in,out] o stream for generating */ void generate_idx(const idx& i, std::ostream& o) { idx_visgen vis(o); boost::apply_visitor(vis, i.idx_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_constraints_fn.hpp0000644000176200001440000000545313766554456026527 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_CONSTRAINTS_FN_HPP #define STAN_LANG_GENERATOR_WRITE_CONSTRAINTS_FN_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the name of the constrain function together * with expressions for the bounds parameters, if any. * Constrain and unconstrain functions both take bounds * constrain function also needs row, column size args. * * NOTE: expecting that parser disallows integer params. * * @param[in] btype block var type * @param[in] fn_name either "constrain" or "unconstrain" */ std::string write_constraints_fn(const block_var_type &btype, std::string fn_name) { std::stringstream ss; if (btype.bare_type().is_double_type()) ss << "scalar"; else ss << btype.name(); if (btype.has_def_bounds()) { if (btype.bounds().has_low() && btype.bounds().has_high()) { ss << "_lub_" << fn_name << "("; generate_expression(btype.bounds().low_.expr_, NOT_USER_FACING, ss); ss << ", "; generate_expression(btype.bounds().high_.expr_, NOT_USER_FACING, ss); } else if (btype.bounds().has_low()) { ss << "_lb_" << fn_name << "("; generate_expression(btype.bounds().low_.expr_, NOT_USER_FACING, ss); } else { ss << "_ub_" << fn_name << "("; generate_expression(btype.bounds().high_.expr_, NOT_USER_FACING, ss); } } else if (btype.has_def_offset_multiplier()) { if (btype.ls().has_offset() && btype.ls().has_multiplier()) { ss << "_offset_multiplier_" << fn_name << "("; generate_expression(btype.ls().offset_.expr_, NOT_USER_FACING, ss); ss << ", "; generate_expression(btype.ls().multiplier_.expr_, NOT_USER_FACING, ss); } else if (btype.ls().has_offset()) { ss << "_offset_multiplier_" << fn_name << "("; generate_expression(btype.ls().offset_.expr_, NOT_USER_FACING, ss); ss << ", 1"; } else { ss << "_offset_multiplier_" << fn_name << "(0"; ss << ", "; generate_expression(btype.ls().multiplier_.expr_, NOT_USER_FACING, ss); } } else { ss << "_" << fn_name << "("; } if ((fn_name.compare("unconstrain") == 0)) { if (btype.has_def_bounds() || btype.has_def_offset_multiplier()) ss << ", "; return ss.str(); } if (!is_nil(btype.arg1())) { if (btype.has_def_bounds() || btype.has_def_offset_multiplier()) ss << ", "; generate_expression(btype.arg1(), NOT_USER_FACING, ss); } if (btype.name() == "matrix" || btype.name() == "cholesky_factor_cov") { ss << ", "; generate_expression(btype.arg2(), NOT_USER_FACING, ss); } return ss.str(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_try.hpp0000644000176200001440000000116013766554456024742 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_TRY_HPP #define STAN_LANG_GENERATOR_GENERATE_TRY_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the opening for a try statement at the specified * indentation level on the specified stream. * * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_try(int indent, std::ostream& o) { generate_indent(indent, o); o << "try {" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_begin_all_dims_row_maj_loop.hpp0000644000176200001440000000534013766554456031167 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_BEGIN_ALL_DIMS_ROW_MAJ_LOOP_HPP #define STAN_LANG_GENERATOR_WRITE_BEGIN_ALL_DIMS_ROW_MAJ_LOOP_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the openings of a sequence of zero or more for loops * corresponding to all dimensions of a variable, with the * specified indentation level writing to the specified stream. * If specified, declare named size_t variable for each dimension * which avoids re-evaluation of size expression on each iteration. * * Indexing order is row major: array dims 1...N then row, col * * @param[in] var_decl variable declaration * @param[in] declare_size_vars if true, generate size_t var decls * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_begin_all_dims_row_maj_loop(const block_var_decl& var_decl, bool declare_size_vars, int indent, std::ostream& o) { std::string name(var_decl.name()); expression arg1(var_decl.type().innermost_type().arg1()); expression arg2(var_decl.type().innermost_type().arg2()); std::vector ar_var_dims = var_decl.type().array_lens(); for (size_t i = 0; i < ar_var_dims.size(); ++i) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_k_" << i << "_max__ = "; generate_expression(ar_var_dims[i], NOT_USER_FACING, o); o << ";" << EOL; } if (!is_nil(arg1)) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_j_1_max__ = "; generate_expression(arg1, NOT_USER_FACING, o); o << ";" << EOL; } if (!is_nil(arg2)) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_j_2_max__ = "; generate_expression(arg2, NOT_USER_FACING, o); o << ";" << EOL; } // nested for stmts open for (size_t i = 0; i < ar_var_dims.size(); ++i) { generate_indent(indent++, o); o << "for (size_t k_" << i << "__ = 0;" << " k_" << i << "__ < " << name << "_k_" << i << "_max__;" << " ++k_" << i << "__) {" << EOL; } if (!is_nil(arg1)) { generate_indent(indent++, o); o << "for (size_t j_1__ = 0; " << "j_1__ < " << name << "_j_1_max__;" << " ++j_1__) {" << EOL; } if (!is_nil(arg2)) { generate_indent(indent++, o); o << "for (size_t j_2__ = 0; " << "j_2__ < " << name << "_j_2_max__;" << " ++j_2__) {" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_void_statement.hpp0000644000176200001440000000144613766554456027160 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VOID_STATEMENT_HPP #define STAN_LANG_GENERATOR_GENERATE_VOID_STATEMENT_HPP #include #include #include namespace stan { namespace lang { /** * Generate a dummy void-cast statement for a variable of the * specified name at the specified indentation level to the * specified output stream. * * @param[in] name variable name * @param[in] indent indentation level * @param[in,out] o stream for genering */ void generate_void_statement(const std::string& name, const size_t indent, std::ostream& o) { generate_indent(indent, o); o << "(void) " << name << ";" << " // dummy to suppress unused var warning" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_validate_tparam_inits.hpp0000644000176200001440000000444013766554456030473 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VALIDATE_TPARAM_INITS_HPP #define STAN_LANG_GENERATOR_GENERATE_VALIDATE_TPARAM_INITS_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate code to validate the specified variable declaration * using the specified indentation level and stream. * Checks any defined bounds or constraints on specialized types. * NOTE: bounded / specialized types are mutually exclusive * * @param[in] decl variable declaration * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_validate_tparam_inits(const block_var_decl decl, int indent, std::ostream& o) { write_begin_all_dims_row_maj_loop(decl, true, indent, o); // innermost loop stmt: do check, throw exception generate_indent(indent + decl.bare_type().num_dims(), o); o << "if (stan::math::is_uninitialized(" << decl.name(); write_var_idx_all_dims( decl.bare_type().array_dims(), decl.bare_type().num_dims() - decl.bare_type().array_dims(), o); o << ")) {" << EOL; generate_indent(indent + decl.bare_type().num_dims() + 1, o); o << "std::stringstream msg__;" << EOL; generate_indent(indent + decl.bare_type().num_dims() + 1, o); o << "msg__ << \"Undefined transformed parameter: " << decl.name() << "\""; write_var_idx_all_dims_msg( decl.bare_type().array_dims(), decl.bare_type().num_dims() - decl.bare_type().array_dims(), o); o << ";" << EOL; generate_indent(indent + decl.bare_type().num_dims() + 1, o); o << "stan::lang::rethrow_located(" << "std::runtime_error(std::string(\"Error initializing variable " << decl.name() << ": \") + msg__.str()), current_statement_begin__, prog_reader__());" << EOL; generate_indent(indent + decl.bare_type().num_dims(), o); o << "}" << EOL; write_end_loop(decl.bare_type().num_dims(), indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_block_var.hpp0000644000176200001440000000431013766554456026066 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_BLOCK_VAR_HPP #define STAN_LANG_GENERATOR_GENERATE_BLOCK_VAR_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate variable declaration, fill statements for block-level variables * other than member variables and parameters. * * @param[in] var_decl block variable * @param[in] type_str scalar real type string * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_block_var(const block_var_decl& var_decl, const std::string& type_str, int indent, std::ostream& o) { std::string var_name(var_decl.name()); if (var_decl.type().num_dims() > 0) generate_validate_var_dims(var_decl, indent, o); generate_indent(indent, o); generate_bare_type(var_decl.type().bare_type(), type_str, o); o << " " << var_name; if (var_decl.bare_type().num_dims() == 0) { o << ";" << EOL; generate_void_statement(var_name, indent, o); } else { generate_initializer(var_decl.type(), type_str, o); o << ";" << EOL; } if (!var_decl.type().innermost_type().bare_type().is_int_type()) { generate_indent(indent, o); o << "stan::math::initialize(" << var_decl.name() << ", DUMMY_VAR__);" << EOL; } generate_indent(indent, o); o << "stan::math::fill(" << var_decl.name() << ", " << (var_decl.type().innermost_type().bare_type().is_int_type() ? "std::numeric_limits::min()" : "DUMMY_VAR__") << ");" << EOL; if (var_decl.has_def()) { generate_indent(indent, o); o << "stan::math::assign(" << var_decl.name() << ","; generate_expression(var_decl.def(), NOT_USER_FACING, o); o << ");" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_expression.hpp0000644000176200001440000000150113766554456026322 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_EXPRESSION_HPP #define STAN_LANG_GENERATOR_GENERATE_EXPRESSION_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the specified expression to the specified stream with * user-facing/C++ format and parameter/data format controlled by * the flags. * * @param[in] e expression to generate * @param[in] user_facing true if expression might be reported to user * @param[in,out] o stream for generating */ void generate_expression(const expression& e, bool user_facing, std::ostream& o) { expression_visgen vis(o, user_facing); boost::apply_visitor(vis, e.expr_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_read_transform_params.hpp0000644000176200001440000000454613766554456030510 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_READ_TRANSFORM_PARAMS_HPP #define STAN_LANG_GENERATOR_GENERATE_READ_TRANSFORM_PARAMS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate declarations for parameters on the constrained scale. * * @param[in] vs variable declarations * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_read_transform_params(const std::vector& vs, int indent, std::ostream& o) { for (size_t i = 0; i < vs.size(); ++i) { std::string var_name(vs[i].name()); block_var_type vtype = vs[i].type(); block_var_type el_type = vtype.innermost_type(); // declare generate_indent(indent, o); generate_bare_type(vtype.bare_type(), "double", o); o << " " << var_name; if (vtype.array_dims() == 0) { // read/transform o << " = in__." << write_constraints_fn(vtype, "constrain") << ");" << EOL; } else { o << ";" << EOL; write_nested_resize_loop_begin(var_name, vtype.array_lens(), indent, o); generate_indent(indent + vtype.array_dims(), o); o << var_name; write_resize_var_idx(vtype.array_dims(), o); o << ".push_back(in__." << write_constraints_fn(el_type, "constrain") << "));" << EOL; write_end_loop(vtype.array_dims(), indent, o); } // write to vars__ in col-major write_begin_all_dims_col_maj_loop(vs[i], true, indent, o); generate_indent(indent + vtype.num_dims(), o); o << "vars__.push_back(" << var_name; write_var_idx_all_dims(vtype.array_dims(), vtype.num_dims() - vtype.array_dims(), o); o << ");" << EOL; write_end_loop(vtype.num_dims(), indent, o); o << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_comment.hpp0000644000176200001440000000117513766554456025574 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_COMMENT_HPP #define STAN_LANG_GENERATOR_GENERATE_COMMENT_HPP #include #include #include namespace stan { namespace lang { /** * Generate the specified message as a comment with the specified * indentation and an end-of-line. * * @param[in] msg text of comment * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_comment(const std::string& msg, int indent, std::ostream& o) { generate_indent(indent, o); o << "// " << msg << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/fun_scalar_type.hpp0000644000176200001440000000334513766554456025437 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_FUN_SCALAR_TYPE_HPP #define STAN_LANG_GENERATOR_FUN_SCALAR_TYPE_HPP #include #include #include #include namespace stan { namespace lang { /** * Return the string representing the scalar type to use in the * body of the specified function declaration, with a flag * indicating if the function is a log probability function. * * @param[in] fun function declaration * @param[in] is_lp true if the function is a log probability * function * @return string representing scalar type to use within the * function body */ std::string fun_scalar_type(const function_decl_def& fun, bool is_lp) { size_t num_args = fun.arg_decls_.size(); // nullary, non-lp if (fun.has_only_int_args() && !is_lp) return "double"; // need template metaprogram to construct return std::stringstream ss; ss << "typename boost::math::tools::promote_args<"; int num_open_brackets = 1; int num_generated_params = 0; for (size_t i = 0; i < num_args; ++i) { if (!fun.arg_decls_[i].bare_type().innermost_type().is_int_type()) { if (num_generated_params > 0) ss << ", "; // break into blocks of 4 and apply promotion recursively // setting at 4 leaves room for an extra parameter at the end if (num_generated_params == 4) { ss << "typename boost::math::tools::promote_args<"; num_generated_params = 0; ++num_open_brackets; } ss << "T" << i << "__"; ++num_generated_params; } } if (is_lp) { if (num_generated_params > 0) ss << ", "; ss << "T_lp__"; } for (int i = 0; i < num_open_brackets; ++i) ss << ">::type"; return ss.str(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function.hpp0000644000176200001440000000375413766554456025764 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the specified function and optionally its default for * propto=false for functions ending in _log. * * Exact behavior differs for unmarked functions, and functions * ending in one of "_rng", "_lp", or "_log". * * @param[in] fun function AST object * @param[in, out] out output stream to which function definition * is written */ void generate_function(const function_decl_def& fun, std::ostream& out) { bool is_rng = ends_with("_rng", fun.name_); bool is_lp = ends_with("_lp", fun.name_); bool is_pf = ends_with("_log", fun.name_) || ends_with("_lpdf", fun.name_) || ends_with("_lpmf", fun.name_); std::string scalar_t_name = fun_scalar_type(fun, is_lp); generate_function_template_parameters(fun, is_rng, is_lp, is_pf, out); generate_function_inline_return_type(fun, scalar_t_name, 0, out); generate_function_name(fun, out); generate_function_arguments(fun, is_rng, is_lp, is_pf, out); generate_function_body(fun, scalar_t_name, out); // need a second function def for default propto=false for _log // funs; but don't want duplicate def, so don't do it for // forward decl when body is no-op if (is_pf && !fun.body_.is_no_op_statement()) generate_propto_default_function(fun, scalar_t_name, out); out << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_var_fill_define.hpp0000644000176200001440000000246213766554456027242 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VAR_FILL_DEFINE_HPP #define STAN_LANG_GENERATOR_GENERATE_VAR_FILL_DEFINE_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate stmts to fill variable, followed by assignment statement * for definition, if any. * * @param[in] var_decl variable declarations * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_var_fill_define(const block_var_decl& var_decl, int indent, std::ostream& o) { block_var_type btype = var_decl.type().innermost_type(); // fill generate_indent(indent, o); if (btype.bare_type().is_int_type()) { o << "stan::math::fill(" << var_decl.name() << ", std::numeric_limits::min());" << EOL; } else { o << "stan::math::fill(" << var_decl.name() << ", DUMMY_VAR__);" << EOL; } // define if (var_decl.has_def()) { generate_indent(indent, o); o << "stan::math::assign(" << var_decl.name() << ","; generate_expression(var_decl.def(), NOT_USER_FACING, o); o << ");" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_begin_array_dims_loop.hpp0000644000176200001440000000335313766554456030021 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_BEGIN_ARRAY_DIMS_LOOP_HPP #define STAN_LANG_GENERATOR_WRITE_BEGIN_ARRAY_DIMS_LOOP_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the openings of a sequence of zero or more for loops * corresponding to array dimensions of a variable, with the * specified indentation level writing to the specified stream. * If specified, declare named size_t variable for each dimension * which avoids re-evaluation of size expression on each iteration. * * @param[in] var_decl variable declaration * @param[in] declare_size_vars if true, generate size_t var decls * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_begin_array_dims_loop(const block_var_decl& var_decl, bool declare_size_vars, int indent, std::ostream& o) { std::string name(var_decl.name()); std::vector ar_var_dims = var_decl.type().array_lens(); for (size_t i = 0; i < ar_var_dims.size(); ++i) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_i_" << i << "_max__ = "; generate_expression(ar_var_dims[i], NOT_USER_FACING, o); o << ";" << EOL; } for (size_t i = 0; i < ar_var_dims.size(); ++i) { generate_indent(indent + i, o); o << "for (size_t i_" << i << "__ = 0;" << " i_" << i << "__ < " << name << "_i_" << i << "_max__;" << " ++i_" << i << "__) {" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_bare_type.hpp0000644000176200001440000000333313766554456026102 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_BARE_TYPE_HPP #define STAN_LANG_GENERATOR_GENERATE_BARE_TYPE_HPP #include #include #include namespace stan { namespace lang { /** * Generate the basic type for the specified expression type * using the specified scalar type string and writing to * the specified stream. * * Scalar type string is `local_scalar_t__` in log_prob method, * `double` elsewhere. * * @param[in] t expression type * @param[in] scalar_t_name name of scalar type for double values * @param[in] o stream for generating */ void generate_bare_type(const bare_expr_type& t, const std::string& scalar_t_name, std::ostream& o) { for (int i = 0; i < t.array_dims(); ++i) o << "std::vector<"; bool is_template_type = false; if (t.innermost_type().is_int_type()) { o << "int"; is_template_type = false; } else if (t.innermost_type().is_double_type()) { o << scalar_t_name; is_template_type = false; } else if (t.innermost_type().is_vector_type()) { o << "Eigen::Matrix<" << scalar_t_name << ", Eigen::Dynamic, 1>"; is_template_type = true; } else if (t.innermost_type().is_row_vector_type()) { o << "Eigen::Matrix<" << scalar_t_name << ", 1, Eigen::Dynamic>"; is_template_type = true; } else if (t.innermost_type().is_matrix_type()) { o << "Eigen::Matrix<" << scalar_t_name << ", Eigen::Dynamic, Eigen::Dynamic>"; is_template_type = true; } else if (t.innermost_type().is_void_type()) { o << "void"; } else { o << "UNKNOWN TYPE"; } for (int i = 0; i < t.array_dims(); ++i) { if (i > 0 || is_template_type) o << ' '; o << '>'; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_quoted_expression.hpp0000644000176200001440000000113613766554456027707 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_QUOTED_EXPRESSION_HPP #define STAN_LANG_GENERATOR_GENERATE_QUOTED_EXPRESSION_HPP #include #include #include #include #include namespace stan { namespace lang { /** * */ void generate_quoted_expression(const expression& e, std::ostream& o) { std::stringstream ss; generate_expression(e, NOT_USER_FACING, ss); generate_quoted_string(ss.str(), o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_member_var_decls.hpp0000644000176200001440000000275013766554456027423 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_MEMBER_VAR_DECLS_HPP #define STAN_LANG_GENERATOR_GENERATE_MEMBER_VAR_DECLS_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate model class member variable declarations for * variables declared in data and transformed data blocks * at the specified indentation level to the specified stream. * * NOTE: variable decls typedefs defined in stan::math. * * @param[in] vs variable declarations * @param[in] indent indentation level * @param[in] o stream for writing */ void generate_member_var_decls(const std::vector& vs, int indent, std::ostream& o) { for (size_t i = 0; i < vs.size(); ++i) { generate_indent(indent, o); std::string var_name(vs[i].name()); block_var_type btype = vs[i].type().innermost_type(); std::string typedef_var_type = get_typedef_var_type(btype.bare_type()); int ar_dims = vs[i].type().array_dims(); for (int i = 0; i < indent; ++i) o << INDENT; for (int i = 0; i < ar_dims; ++i) o << "std::vector<"; o << typedef_var_type; if (ar_dims > 0) o << ">"; for (int i = 1; i < ar_dims; ++i) o << " >"; o << " " << var_name << ";" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_usings.hpp0000644000176200001440000000154513766554456025443 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_USINGS_HPP #define STAN_LANG_GENERATOR_GENERATE_USINGS_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate the using statements for a Stan model. * * @param[in,out] o stream for generating */ void generate_usings(std::ostream& o) { generate_using("std::istream", o); generate_using("std::string", o); generate_using("std::stringstream", o); generate_using("std::vector", o); generate_using("stan::io::dump", o); generate_using("stan::math::lgamma", o); generate_using("stan::model::prob_grad", o); generate_using_namespace("stan::math", o); o << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_program_reader_fun.hpp0000644000176200001440000000245713766554456027777 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PROGRAM_READER_FUN_HPP #define STAN_LANG_GENERATOR_GENERATE_PROGRAM_READER_FUN_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate a top-level function that returns the program reader * for the specified history. * *

Implementation note: Because this is only called when there * is an error to report, reconstructing on each call has * acceptable performance. * * @param[in] history record of I/O path for lines in compound program * @param[in, out] o stream to which generated code is written */ void generate_program_reader_fun(const std::vector& history, std::ostream& o) { o << "stan::io::program_reader prog_reader__() {" << std::endl; o << INDENT << "stan::io::program_reader reader;" << std::endl; for (size_t i = 0; i < history.size(); ++i) o << INDENT << "reader.add_event(" << history[i].concat_line_num_ << ", " << history[i].line_num_ << ", \"" << history[i].action_ << "\"" << ", \"" << history[i].path_ << "\");" << std::endl; o << INDENT << "return reader;" << std::endl; o << "}" << std::endl << std::endl; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_unconstrained_param_names_array.hpp0000644000176200001440000000377513766554456032557 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_UNCONSTRAINED_PARAM_NAMES_ARRAY_HPP #define STAN_LANG_GENERATOR_GENERATE_UNCONSTRAINED_PARAM_NAMES_ARRAY_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the sequence of names for all elements of a parameter variable. * * @param[in] indent level of indentation * @param[in,out] o stream for generating * @param[in] var_decl block variable declaraton ast node */ void generate_unconstrained_param_names_array(size_t indent, std::ostream& o, const block_var_decl& var_decl) { std::string var_name(var_decl.name()); block_var_type vtype = var_decl.type(); size_t num_array_dims = vtype.array_dims(); size_t num_vector_dims = vtype.num_dims() - vtype.array_dims(); if (var_decl.type().innermost_type().is_specialized()) { num_vector_dims = 1; } size_t num_loops = vtype.array_dims() + num_vector_dims; write_begin_param_elements_loop(var_decl, true, indent, o); generate_indent(indent + num_loops, o); o << "param_name_stream__.str(std::string());" << EOL; generate_indent(indent + num_loops, o); o << "param_name_stream__ << " << '"' << var_name << '"'; for (size_t i = 0; i < num_array_dims; ++i) o << " << '.' << k_" << i << "__ + 1"; if (num_vector_dims == 1) o << " << '.' << j_1__ + 1"; else if (num_vector_dims == 2) o << " << '.' << j_1__ + 1 << '.' << j_2__ + 1"; o << ';' << EOL; generate_indent(indent + num_loops, o); o << "param_names__.push_back(param_name_stream__.str());" << EOL; write_end_loop(num_loops, indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/get_block_var_dims.hpp0000644000176200001440000000216113766554456026071 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GET_BLOCK_VAR_DIMS_HPP #define STAN_LANG_GENERATOR_GET_BLOCK_VAR_DIMS_HPP #include #include #include #include namespace stan { namespace lang { /** * Return vector of size expressions for all dimensions * of a block_var_decl in the following order: * matrix cols (if matrix type), * matrix row / row_vector / vector length (if matrix/vec type), * array dim N through array dim 1 * * @param[in] decl block_var_decl */ std::vector get_block_var_dims(const block_var_decl decl) { std::vector dims; block_var_type bt = decl.type().innermost_type(); if (bt.bare_type().is_matrix_type()) { dims.push_back(bt.arg2()); dims.push_back(bt.arg1()); } else if (bt.bare_type().is_row_vector_type() || bt.bare_type().is_vector_type()) { dims.push_back(bt.arg1()); } std::vector ar_lens = decl.type().array_lens(); for (size_t i = ar_lens.size(); i-- > 0;) { dims.push_back(ar_lens[i]); } return dims; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_unconstrained_param_names_method.hpp0000644000176200001440000000356313766554456032714 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_UNCONSTRAINED_PARAM_NAMES_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_UNCONSTRAINED_PARAM_NAMES_METHOD_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the method unconstrained_param_names for * the specified program on the specified stream. * * @param[in] prog progam from which to generate * @param[in,out] o stream for generating */ void generate_unconstrained_param_names_method(const program& prog, std::ostream& o) { o << EOL << INDENT << "void unconstrained_param_names(" << "std::vector& param_names__," << EOL << INDENT << " bool include_tparams__ = true," << EOL << INDENT << " bool include_gqs__ = true) const {" << EOL << INDENT2 << "std::stringstream param_name_stream__;" << EOL; for (size_t i = 0; i < prog.parameter_decl_.size(); ++i) generate_unconstrained_param_names_array(2, o, prog.parameter_decl_[i]); o << EOL << INDENT2 << "if (!include_gqs__ && !include_tparams__) return;" << EOL; o << EOL << INDENT2 << "if (include_tparams__) {" << EOL; for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) generate_unconstrained_param_names_array(3, o, prog.derived_decl_.first[i]); o << INDENT2 << "}" << EOL; o << EOL << INDENT2 << "if (!include_gqs__) return;" << EOL; for (size_t i = 0; i < prog.generated_decl_.first.size(); ++i) generate_unconstrained_param_names_array(2, o, prog.generated_decl_.first[i]); o << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_statement.hpp0000644000176200001440000000232713766554456026136 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_STATEMENT_HPP #define STAN_LANG_GENERATOR_GENERATE_STATEMENT_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the specified statement with the specified indentation * level on the specified output stream. * Generated statement is preceeded by stmt updating global variable * `current_statement_begin__` to src file line number where stmt begins. * * @param[in] s statement to generate * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_statement(const statement& s, int indent, std::ostream& o) { is_numbered_statement_vis vis_is_numbered; if (boost::apply_visitor(vis_is_numbered, s.statement_)) { generate_indent(indent, o); o << "current_statement_begin__ = " << s.begin_line_ << ";" << EOL; } statement_visgen vis(indent, o); boost::apply_visitor(vis, s.statement_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_line_number.hpp0000644000176200001440000000201013766554456026416 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_LINE_NUMBER_HPP #define STAN_LANG_GENERATOR_GENERATE_LINE_NUMBER_HPP #include #include #include #include namespace stan { namespace lang { /* * Generate statement to update current line number in program. * * @param[in] line program node * @param[in] indent indentation level * @param[in,out] o stream for generating */ template void generate_line_number(const T& line, int indent, std::ostream& o) { o << "current_statement_begin__ = " << line.begin_line_ << ";" << EOL; } template void generate_line_number(const block_var_decl&, int indent, std::ostream& o); template void generate_line_number(const local_var_decl&, int indent, std::ostream& o); template void generate_line_number(const statement&, int indent, std::ostream& o); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/idx_visgen.hpp0000644000176200001440000000265113766554456024417 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_IDX_VISGEN_HPP #define STAN_LANG_GENERATOR_IDX_VISGEN_HPP #include #include #include #include namespace stan { namespace lang { struct idx_visgen : public visgen { /** * Construct a visitor for generating multiple indexes. * * @param o stream for generating */ explicit idx_visgen(std::ostream& o) : visgen(o) {} void operator()(const uni_idx& i) const { o_ << "stan::model::index_uni("; generate_expression(i.idx_, NOT_USER_FACING, o_); o_ << ")"; } void operator()(const multi_idx& i) const { o_ << "stan::model::index_multi("; generate_expression(i.idxs_, NOT_USER_FACING, o_); o_ << ")"; } void operator()(const omni_idx& i) const { o_ << "stan::model::index_omni()"; } void operator()(const lb_idx& i) const { o_ << "stan::model::index_min("; generate_expression(i.lb_, NOT_USER_FACING, o_); o_ << ")"; } void operator()(const ub_idx& i) const { o_ << "stan::model::index_max("; generate_expression(i.ub_, NOT_USER_FACING, o_); o_ << ")"; } void operator()(const lub_idx& i) const { o_ << "stan::model::index_min_max("; generate_expression(i.lb_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(i.ub_, NOT_USER_FACING, o_); o_ << ")"; } }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_initializer.hpp0000644000176200001440000000333013766554456026450 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_INITIALIZER_HPP #define STAN_LANG_GENERATOR_GENERATE_INITIALIZER_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate an initializer for a variable of the specified type * * @param[in] var_type variable type * @param[in] scalar_t_name name of scalar type for double values * @param[in,out] o stream for generating */ template void generate_initializer(const T& var_type, const std::string& scalar_t_name, std::ostream& o) { std::vector ar_dim_sizes = var_type.array_lens(); bare_expr_type bare_type = var_type.array_element_type().bare_type(); expression arg1 = var_type.arg1(); expression arg2 = var_type.arg2(); if (var_type.is_array_type()) { arg1 = var_type.array_contains().arg1(); arg2 = var_type.array_contains().arg2(); } // size of each array dimension (adds open paren) for (size_t i = 0; i < ar_dim_sizes.size(); ++i) { o << "("; generate_expression(ar_dim_sizes[i].expr_, NOT_USER_FACING, o); o << ", "; generate_bare_type(bare_type, scalar_t_name, o); bare_type = bare_type.array_element_type(); } // initialize (array) element o << "("; if (!is_nil(arg1)) { generate_expression(arg1.expr_, NOT_USER_FACING, o); if (!is_nil(arg2)) { o << ", "; generate_expression(arg2.expr_, NOT_USER_FACING, o); } } else { o << "0"; } o << ")"; // close array parens for (size_t i = 0; i < ar_dim_sizes.size(); ++i) o << ")"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_namespace_end.hpp0000644000176200001440000000071013766554456026706 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_NAMESPACE_END_HPP #define STAN_LANG_GENERATOR_GENERATE_NAMESPACE_END_HPP #include #include namespace stan { namespace lang { /** * Generate the end of a namespace to the specified stream. * * @param[in, out] o stream for generating */ void generate_namespace_end(std::ostream& o) { o << "} // namespace" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_array_builder_adds.hpp0000644000176200001440000000164613766554456027754 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_ARRAY_BUILDER_ADDS_HPP #define STAN_LANG_GENERATOR_GENERATE_ARRAY_BUILDER_ADDS_HPP #include #include #include namespace stan { namespace lang { /** * Recursive helper function for array, matrix, and row_vector expressions * which generates chain of calls to math lib array_builder add function * for each of the contained elements. * * @param[in] elements vector of expression elements to generate * @param[in] user_facing true if expression might be reported to user * @param[in,out] o stream for generating */ void generate_array_builder_adds(const std::vector& elements, bool user_facing, std::ostream& o) { for (size_t i = 0; i < elements.size(); ++i) { o << ".add("; generate_expression(elements[i], user_facing, o); o << ")"; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_constrained_param_names_method.hpp0000644000176200001440000000335513766554456032350 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_CONSTRAINED_PARAM_NAMES_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_CONSTRAINED_PARAM_NAMES_METHOD_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate the constrained_param_names method for * the specified program on the specified stream. * * @param[in] prog program from which to generate * @param[in,out] o stream for generating */ void generate_constrained_param_names_method(const program& prog, std::ostream& o) { o << EOL << INDENT << "void constrained_param_names(" << "std::vector& param_names__," << EOL << INDENT << " bool include_tparams__ = true," << EOL << INDENT << " bool include_gqs__ = true) const {" << EOL << INDENT2 << "std::stringstream param_name_stream__;" << EOL; for (size_t i = 0; i < prog.parameter_decl_.size(); ++i) generate_param_names_array(2, o, prog.parameter_decl_[i]); o << EOL << INDENT2 << "if (!include_gqs__ && !include_tparams__) return;" << EOL; o << EOL << INDENT2 << "if (include_tparams__) {" << EOL; for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) generate_param_names_array(3, o, prog.derived_decl_.first[i]); o << INDENT2 << "}" << EOL; o << EOL << INDENT2 << "if (!include_gqs__) return;" << EOL; for (size_t i = 0; i < prog.generated_decl_.first.size(); ++i) generate_param_names_array(2, o, prog.generated_decl_.first[i]); o << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_instantiation_name.hpp0000644000176200001440000000123213766554456031715 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_NAME_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_NAME_HPP #include #include #include namespace stan { namespace lang { /** * Generate a name for a non-variable (double only) instantiation of * specified function * @param[in] fun function AST object * @param[in, out] out output stream to which function definition * is written */ void generate_function_instantiation_name(const function_decl_def& fun, std::ostream& out) { out << fun.name_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_member_var_decls_all.hpp0000644000176200001440000000137613766554456030256 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_MEMBER_VAR_DECLS_ALL_HPP #define STAN_LANG_GENERATOR_GENERATE_MEMBER_VAR_DECLS_ALL_HPP #include #include #include namespace stan { namespace lang { /** * Generate member variable declarations for the data and * transformed data blocks for the specified program, writing to * the specified stream. * * @param[in] prog program from which to generate * @param[in,out] o stream for generating */ void generate_member_var_decls_all(const program& prog, std::ostream& o) { generate_member_var_decls(prog.data_decl_, 1, o); generate_member_var_decls(prog.derived_data_decl_.first, 1, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_validate_block_var.hpp0000644000176200001440000000162213766554456027742 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VALIDATE_BLOCK_VAR_HPP #define STAN_LANG_GENERATOR_GENERATE_VALIDATE_BLOCK_VAR_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate validation statements for bounded or specialized block variables. * * @param[in] var_decl block variable * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_validate_block_var(const block_var_decl& var_decl, int indent, std::ostream& o) { block_var_type vtype = var_decl.type().innermost_type(); if (vtype.is_constrained()) { generate_validate_var_decl(var_decl, indent, o); o << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_idxs_user.hpp0000644000176200001440000000140113766554456026127 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_IDXS_USER_HPP #define STAN_LANG_GENERATOR_GENERATE_IDXS_USER_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate the specified multiple indexes for users to the * specified stream. * * @param[in] idxs multiple indexes * @param[in,out] o stream for writing */ void generate_idxs_user(const std::vector& idxs, std::ostream& o) { if (idxs.size() == 0) return; o << "["; for (size_t i = 0; i < idxs.size(); ++i) { if (i > 0) o << ", "; generate_idx_user(idxs[i], o); } o << "]"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_include.hpp0000644000176200001440000000110413766554456025545 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_INCLUDE_HPP #define STAN_LANG_GENERATOR_GENERATE_INCLUDE_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate an include statement for the specified library path. * * @param lib_name path to library * @param o stream for generating */ void generate_include(const std::string& lib_name, std::ostream& o) { o << "#include" << " " << "<" << lib_name << ">" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_class_decl.hpp0000644000176200001440000000123413766554456026222 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_CLASS_DECL_HPP #define STAN_LANG_GENERATOR_GENERATE_CLASS_DECL_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the specified name for the model class to the * specified stream. * * @param[in] model_name name of class * @param[in,out] o stream for generating */ void generate_class_decl(const std::string& model_name, std::ostream& o) { o << "class " << model_name << EOL << " : public stan::model::model_base_crtp<" << model_name << "> {" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_idx_user.hpp0000644000176200001440000000113413766554456025747 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_IDX_USER_HPP #define STAN_LANG_GENERATOR_GENERATE_IDX_USER_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate specified multiple index for user on specified * stream. * * @param[in] i multiple index * @param[in,out] o stream for generating */ void generate_idx_user(const idx& i, std::ostream& o) { idx_user_visgen vis(o); boost::apply_visitor(vis, i.idx_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_destructor.hpp0000644000176200001440000000122713766554456026326 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_DESTRUCTOR_HPP #define STAN_LANG_GENERATOR_GENERATE_DESTRUCTOR_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the destructor for the class with name specified by * the model name to the specified stream. * * @param[in] model_name name of model to use as class name * @param[in,out] o stream for generating. */ void generate_destructor(const std::string& model_name, std::ostream& o) { o << EOL << INDENT << "~" << model_name << "() { }" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_cpp.hpp0000644000176200001440000000651213766554456024714 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_CPP_HPP #define STAN_LANG_GENERATOR_GENERATE_CPP_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generae the C++ code for the specified program, generating it * in a class and namespace derived from the specified model name, * writing to the specified stream. * * @param[in] prog program from which to generate * @param[in] model_name name of model for generating namespace * and class name * @param[in] history I/O include history for text underlying * program * @param[in,out] o stream for generating */ void generate_cpp(const program& prog, const std::string& model_name, const std::vector& history, std::ostream& o) { generate_version_comment(o); generate_includes(o); generate_namespace_start(model_name, o); generate_usings(o); generate_globals(o); generate_program_reader_fun(history, o); generate_functions(prog.function_decl_defs_, o); generate_class_decl(model_name, o); generate_private_decl(o); generate_member_var_decls_all(prog, o); generate_public_decl(o); generate_constructor(prog, model_name, o); generate_destructor(model_name, o); generate_transform_inits_method(prog.parameter_decl_, o); generate_log_prob(prog, o); generate_param_names_method(prog, o); generate_dims_method(prog, o); generate_write_array_method(prog, model_name, o); generate_model_name_method(model_name, o); generate_constrained_param_names_method(prog, o); generate_unconstrained_param_names_method(prog, o); generate_class_decl_end(o); generate_namespace_end(o); generate_model_typedef(model_name, o); generate_register_mpi(model_name, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_var_decl_type.hpp0000644000176200001440000000273713766554456026317 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_VAR_DECL_TYPE_HPP #define STAN_LANG_GENERATOR_WRITE_VAR_DECL_TYPE_HPP #include #include #include #include namespace stan { namespace lang { /** * Write the variable type declaration to the specified stream * using the specified cpp type string, which varies according * where in the generated model class this decl occurs. * Currently, member var decls and ctor use typdefs, * other methods have explicit types with typedef on * scalar double types. * * Note: this is called after array type has been unfolded, * so bare_type shouldn't be bare_array_type (or ill_formed_type). * * @param[in] bare_type variable type * @param[in] cpp_type_str generated cpp type * @param[in] ar_dims of array dimensions * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_var_decl_type(const bare_expr_type& bare_type, const std::string& cpp_type_str, int ar_dims, int indent, std::ostream& o) { bool ends_with_angle = cpp_type_str.at(cpp_type_str.length() - 1) == '>'; for (int i = 0; i < indent; ++i) o << INDENT; for (int i = 0; i < ar_dims; ++i) o << "std::vector<"; o << cpp_type_str; for (int i = 0; i < ar_dims; ++i) { if (ar_dims > 0 || ends_with_angle) o << " "; // maybe not needed for c++11 o << " >"; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_log_prob.hpp0000644000176200001440000001075213766554456025736 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_LOG_PROB_HPP #define STAN_LANG_GENERATOR_GENERATE_LOG_PROB_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the log_prob method for the model class for the * specified program on the specified stream. * * @param prog program node of ast * @param o stream for generating */ void generate_log_prob(const program& prog, std::ostream& o) { o << EOL; o << INDENT << "template " << EOL; o << INDENT << "T__ log_prob(std::vector& params_r__," << EOL; o << INDENT << " std::vector& params_i__," << EOL; o << INDENT << " std::ostream* pstream__ = 0) const {" << EOL2; o << INDENT2 << "typedef T__ local_scalar_t__;" << EOL2; // use this dummy for inits o << INDENT2 << "local_scalar_t__ DUMMY_VAR__" << "(std::numeric_limits::quiet_NaN());" << EOL; generate_void_statement("DUMMY_VAR__", 2, o); o << EOL; o << INDENT2 << "T__ lp__(0.0);" << EOL; o << INDENT2 << "stan::math::accumulator lp_accum__;" << EOL; bool gen_local_vars = true; generate_try(2, o); generate_indent(3, o); o << "stan::io::reader in__(params_r__, params_i__);" << EOL2; generate_comment("model parameters", 3, o); for (size_t i = 0; i < prog.parameter_decl_.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.parameter_decl_[i].begin_line_ << ";" << EOL; generate_param_var(prog.parameter_decl_[i], gen_local_vars, 3, o); o << EOL; } if (prog.derived_decl_.first.size() > 0) { generate_comment("transformed parameters", 3, o); for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.derived_decl_.first[i].begin_line_ << ";" << EOL; generate_block_var(prog.derived_decl_.first[i], "local_scalar_t__", 3, o); o << EOL; } } if (prog.derived_decl_.second.size() > 0) { generate_comment("transformed parameters block statements", 3, o); generate_statements(prog.derived_decl_.second, 3, o); o << EOL; } if (prog.derived_decl_.first.size() > 0) { generate_comment("validate transformed parameters", 3, o); o << INDENT3 << "const char* function__ = \"validate transformed params\";" << EOL; generate_void_statement("function__", 3, o); o << EOL; for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) { block_var_decl bvd = prog.derived_decl_.first[i]; generate_indent(3, o); o << "current_statement_begin__ = " << bvd.begin_line_ << ";" << EOL; generate_validate_tparam_inits(bvd, 3, o); if (bvd.type().innermost_type().is_constrained()) { generate_validate_var_decl(bvd, 3, o); o << EOL; } } o << EOL; } generate_comment("model body", 3, o); generate_statement(prog.statement_, 3, o); o << EOL; generate_catch_throw_located(2, o); o << EOL; o << INDENT2 << "lp_accum__.add(lp__);" << EOL; o << INDENT2 << "return lp_accum__.sum();" << EOL2; o << INDENT << "} // log_prob()" << EOL2; o << INDENT << "template " << EOL; o << INDENT << "T_ log_prob(Eigen::Matrix& params_r," << EOL; o << INDENT << " std::ostream* pstream = 0) const {" << EOL; o << INDENT << " std::vector vec_params_r;" << EOL; o << INDENT << " vec_params_r.reserve(params_r.size());" << EOL; o << INDENT << " for (int i = 0; i < params_r.size(); ++i)" << EOL; o << INDENT << " vec_params_r.push_back(params_r(i));" << EOL; o << INDENT << " std::vector vec_params_i;" << EOL; o << INDENT << " return log_prob(vec_params_r, " << "vec_params_i, pstream);" << EOL; o << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_param_names_method.hpp0000644000176200001440000000243213766554456027752 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PARAM_NAMES_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_PARAM_NAMES_METHOD_HPP #include #include #include namespace stan { namespace lang { /** * Generate the method to get_param_names, which * retrieves the parameter names for the specified program on the * specified stream. * * @param[in] prog program from which to generate * @param[in,out] o stream for generating */ void generate_param_names_method(const program& prog, std::ostream& o) { o << EOL << INDENT << "void get_param_names(std::vector& names__) const {" << EOL; o << INDENT2 << "names__.resize(0);" << EOL; for (size_t i = 0; i < prog.parameter_decl_.size(); ++i) o << INDENT2 << "names__.push_back(\"" << prog.parameter_decl_[i].name() << "\");" << EOL; for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) o << INDENT2 << "names__.push_back(\"" << prog.derived_decl_.first[i].name() << "\");" << EOL; for (size_t i = 0; i < prog.generated_decl_.first.size(); ++i) o << INDENT2 << "names__.push_back(\"" << prog.generated_decl_.first[i].name() << "\");" << EOL; o << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/expression_visgen.hpp0000644000176200001440000002443213766554456026033 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_EXPRESSION_VISGEN_HPP #define STAN_LANG_GENERATOR_EXPRESSION_VISGEN_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { // forward declare recursive helper functions void generate_array_builder_adds(const std::vector& elements, bool user_facing, std::ostream& o); void generate_idxs(const std::vector& idxs, std::ostream& o); void generate_idxs_user(const std::vector& idxs, std::ostream& o); struct expression_visgen : public visgen { /** true when generated expression might be reported to user */ const bool user_facing_; explicit expression_visgen(std::ostream& o, bool user_facing) : visgen(o), user_facing_(user_facing) {} void operator()(const nil& /*x*/) const { o_ << "nil"; } void operator()(const int_literal& n) const { std::string num_str = boost::lexical_cast(n.val_); o_ << num_str; } void operator()(const double_literal& x) const { o_ << x.string_; if (x.string_.find_first_of("eE.") == std::string::npos) o_ << ".0"; // trailing 0 to ensure C++ makes it a double } void operator()(const array_expr& x) const { std::stringstream ssRealType; generate_real_var_type(x.array_expr_scope_, x.has_var_, ssRealType); std::stringstream ssArrayType; generate_bare_type(x.type_, ssRealType.str(), ssArrayType); std::stringstream ssArrayElType; generate_bare_type(x.type_.array_element_type(), ssRealType.str(), ssArrayElType); o_ << "static_cast<" << ssArrayType.str() << " >(stan::math::array_builder<" << ssArrayElType.str() << " >()"; generate_array_builder_adds(x.args_, user_facing_, o_); o_ << ".array())"; } void operator()(const matrix_expr& x) const { std::stringstream ssRealType; generate_real_var_type(x.matrix_expr_scope_, x.has_var_, ssRealType); // to_matrix arg is std::vector of row vectors (Eigen::Matrix) o_ << "stan::math::to_matrix(stan::math::array_builder >()"; generate_array_builder_adds(x.args_, user_facing_, o_); o_ << ".array())"; } void operator()(const row_vector_expr& x) const { std::stringstream ssRealType; generate_real_var_type(x.row_vector_expr_scope_, x.has_var_, ssRealType); // to_row_vector arg is std::vector of type T o_ << "stan::math::to_row_vector(stan::math::array_builder<" << ssRealType.str() << " >()"; generate_array_builder_adds(x.args_, user_facing_, o_); o_ << ".array())"; } void operator()(const variable& v) const { o_ << v.name_; } void operator()(int n) const { // NOLINT o_ << static_cast(n); // NOLINT } void operator()(double x) const { o_ << x; } void operator()(const std::string& x) const { o_ << x; } // identifiers void operator()(const index_op& x) const { std::stringstream expr_o; generate_expression(x.expr_, user_facing_, expr_o); std::string expr_string = expr_o.str(); std::vector indexes; for (size_t i = 0; i < x.dimss_.size(); ++i) for (size_t j = 0; j < x.dimss_[i].size(); ++j) indexes.push_back(x.dimss_[i][j]); // wasteful copy, could use refs generate_indexed_expr(expr_string, indexes, x.expr_.bare_type(), user_facing_, o_); } void operator()(const index_op_sliced& x) const { if (x.idxs_.size() == 0) { generate_expression(x.expr_, user_facing_, o_); return; } if (user_facing_) { generate_expression(x.expr_, user_facing_, o_); generate_idxs_user(x.idxs_, o_); return; } o_ << "stan::model::rvalue("; generate_expression(x.expr_, user_facing_, o_); o_ << ", "; generate_idxs(x.idxs_, o_); o_ << ", "; o_ << '"'; generate_expression(x.expr_, USER_FACING, o_); o_ << '"'; o_ << ")"; } void operator()(const integrate_ode& fx) const { o_ << (fx.integration_function_name_ == "integrate_ode" ? "integrate_ode_rk45" : fx.integration_function_name_) << "(" << fx.system_function_name_ << "_functor__(), "; generate_expression(fx.y0_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.t0_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.ts_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.theta_, user_facing_, o_); o_ << ", "; generate_expression(fx.x_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.x_int_, NOT_USER_FACING, o_); o_ << ", pstream__)"; } void operator()(const integrate_ode_control& fx) const { o_ << fx.integration_function_name_ << "(" << fx.system_function_name_ << "_functor__(), "; generate_expression(fx.y0_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.t0_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.ts_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.theta_, user_facing_, o_); o_ << ", "; generate_expression(fx.x_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.x_int_, NOT_USER_FACING, o_); o_ << ", pstream__, "; generate_expression(fx.rel_tol_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.abs_tol_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.max_num_steps_, NOT_USER_FACING, o_); o_ << ")"; } void operator()(const algebra_solver& fx) const { o_ << "algebra_solver" << "(" << fx.system_function_name_ << "_functor__(), "; generate_expression(fx.y_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.theta_, user_facing_, o_); o_ << ", "; generate_expression(fx.x_r_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.x_i_, NOT_USER_FACING, o_); o_ << ", pstream__)"; } void operator()(const algebra_solver_control& fx) const { o_ << "algebra_solver" << "(" << fx.system_function_name_ << "_functor__(), "; generate_expression(fx.y_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.theta_, user_facing_, o_); o_ << ", "; generate_expression(fx.x_r_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.x_i_, NOT_USER_FACING, o_); o_ << ", pstream__, "; generate_expression(fx.rel_tol_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.fun_tol_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.max_num_steps_, NOT_USER_FACING, o_); o_ << ")"; } void operator()(const map_rect& fx) const { o_ << "map_rect"; o_ << "<" << fx.call_id_ << ", " << fx.fun_name_ << "_functor__>"; o_ << "("; generate_expression(fx.shared_params_, user_facing_, o_); o_ << ", "; generate_expression(fx.job_params_, user_facing_, o_); o_ << ", "; generate_expression(fx.job_data_r_, NOT_USER_FACING, o_); o_ << ", "; generate_expression(fx.job_data_i_, NOT_USER_FACING, o_); o_ << ", pstream__)"; } void operator()(const integrate_1d& fx) const { o_ << "integrate_1d(" << fx.function_name_ << "_functor__(), "; generate_expression(fx.lb_, user_facing_, o_); o_ << ", "; generate_expression(fx.ub_, user_facing_, o_); o_ << ", "; generate_expression(fx.theta_, user_facing_, o_); o_ << ", "; generate_expression(fx.x_r_, user_facing_, o_); o_ << ", "; generate_expression(fx.x_i_, user_facing_, o_); o_ << ", *pstream__, "; generate_expression(fx.rel_tol_, user_facing_, o_); o_ << ")"; } void operator()(const fun& fx) const { // first test if short-circuit op (binary && and || applied to // primitives; overloads are eager, not short-circuiting) if (fx.name_ == "logical_or" || fx.name_ == "logical_and") { o_ << "(primitive_value("; boost::apply_visitor(*this, fx.args_[0].expr_); o_ << ") " << ((fx.name_ == "logical_or") ? "||" : "&&") << " primitive_value("; boost::apply_visitor(*this, fx.args_[1].expr_); o_ << "))"; return; } o_ << fx.name_ << "("; for (size_t i = 0; i < fx.args_.size(); ++i) { if (i > 0) o_ << ", "; boost::apply_visitor(*this, fx.args_[i].expr_); } if (fx.args_.size() > 0 && (has_rng_suffix(fx.name_) || has_lp_suffix(fx.name_))) o_ << ", "; if (has_rng_suffix(fx.name_)) o_ << "base_rng__"; if (has_lp_suffix(fx.name_)) o_ << "lp__, lp_accum__"; if (is_user_defined(fx)) { if (fx.args_.size() > 0 || has_rng_suffix(fx.name_) || has_lp_suffix(fx.name_)) o_ << ", "; o_ << "pstream__"; } o_ << ")"; } void operator()(const conditional_op& expr) const { bool types_prim_match = (expr.type_.is_primitive() && expr.type_.is_int_type()) || (!expr.has_var_ && expr.type_.is_primitive() && (expr.true_val_.bare_type() == expr.false_val_.bare_type())); std::stringstream ss; generate_real_var_type(expr.scope_, expr.has_var_, ss); o_ << "("; boost::apply_visitor(*this, expr.cond_.expr_); o_ << " ? "; if (types_prim_match) { boost::apply_visitor(*this, expr.true_val_.expr_); } else { o_ << "stan::math::promote_scalar<" << ss.str() << ">("; boost::apply_visitor(*this, expr.true_val_.expr_); o_ << ")"; } o_ << " : "; if (types_prim_match) { boost::apply_visitor(*this, expr.false_val_.expr_); } else { o_ << "stan::math::promote_scalar<" << ss.str() << ">("; boost::apply_visitor(*this, expr.false_val_.expr_); o_ << ")"; } o_ << " )"; } void operator()(const binary_op& expr) const { o_ << "("; boost::apply_visitor(*this, expr.left.expr_); o_ << " " << expr.op << " "; boost::apply_visitor(*this, expr.right.expr_); o_ << ")"; } void operator()(const unary_op& expr) const { o_ << expr.op << "("; boost::apply_visitor(*this, expr.subject.expr_); o_ << ")"; } }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_public_decl.hpp0000644000176200001440000000075213766554456026377 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PUBLIC_DECL_HPP #define STAN_LANG_GENERATOR_GENERATE_PUBLIC_DECL_HPP #include #include #include namespace stan { namespace lang { /** * Generate the public declaration scope for a class to the * specified stream. * * @param[in,out] o stream for generating */ void generate_public_decl(std::ostream& o) { o << "public:" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_idxs.hpp0000644000176200001440000000223513766554456025077 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_IDXS_HPP #define STAN_LANG_GENERATOR_GENERATE_IDXS_HPP #include #include #include #include namespace stan { namespace lang { /** * Recursive helper function tracking position to generate * specified multiple indexes on the specified stream in order to * terminate with a nil index properly. * * @param[in] pos position in list to generate next * @param[in] idxs multiple indexes to generate * @param[in,out] o stream for generating */ void generate_idxs(size_t pos, const std::vector& idxs, std::ostream& o) { if (pos == idxs.size()) { o << "stan::model::nil_index_list()"; } else { o << "stan::model::cons_list("; generate_idx(idxs[pos], o); o << ", "; generate_idxs(pos + 1, idxs, o); o << ")"; } } /** * Generate the specified multiple indexes on the specified stream. * * @param[in] idxs multiple indexes to generate * @param[in,out] o stream for generating */ void generate_idxs(const std::vector& idxs, std::ostream& o) { generate_idxs(0, idxs, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_typedefs.hpp0000644000176200001440000000140713766554456025753 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_TYPEDEFS_HPP #define STAN_LANG_GENERATOR_GENERATE_TYPEDEFS_HPP #include #include #include namespace stan { namespace lang { /** * Generate the typedefs required for the Stan model class to the * specified stream. * * @param[in,out] o stream for generating */ void generate_typedefs(std::ostream& o) { generate_typedef("Eigen::Matrix", "vector_d", o); generate_typedef("Eigen::Matrix", "row_vector_d", o); generate_typedef("Eigen::Matrix", "matrix_d", o); o << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_var_idx_all_dims_msg.hpp0000644000176200001440000000210113766554456027626 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_VAR_IDX_ALL_DIMS_MSG_HPP #define STAN_LANG_GENERATOR_WRITE_VAR_IDX_ALL_DIMS_MSG_HPP #include namespace stan { namespace lang { /** * Generate the loop indexes for the specified variable * which has the specified number of array dimensions and * row/column arguments, writing to the specified stream. * * Regardless of indexing order, indexes on variable are always in-order. * e.g., 3-d array of matrices is indexed: [d1][d2][d3](row,col) * * @param[in] num_ar_dims number of array dimensions of variable * @param[in] num_args ternary indicator for matrix/vector/scalar types * @param[in,out] o stream for generating */ void write_var_idx_all_dims_msg(size_t num_ar_dims, size_t num_args, std::ostream& o) { for (size_t i = 0; i < num_ar_dims; ++i) o << " << \"[\" << k_" << i << "__ << \"]\""; if (num_args == 1) o << " << \"(\" << j_1__ << \")\""; else if (num_args == 2) o << " << \"(\" << j_1__ << \", \" << j_2__ << \")\""; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_data_var_ctor.hpp0000644000176200001440000000246213766554456026742 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_DATA_VAR_CTOR_HPP #define STAN_LANG_GENERATOR_GENERATE_DATA_VAR_CTOR_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate code to to the specified stream to instantiate * a member variable declared in data block by calling the appropriate * constructor. Doesn't check variable dimensions - should have already been * done as part of checks on var_context. * * @param[in] var_decl block variable declaration * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_data_var_ctor(const block_var_decl& var_decl, int indent, std::ostream& o) { std::string var_name(var_decl.name()); block_var_type btype = var_decl.type().innermost_type(); generate_indent(indent, o); o << var_name << " = "; if (var_decl.bare_type().is_int_type()) { o << "int(0)"; } else if (var_decl.bare_type().is_double_type()) { o << "double(0)"; } else { generate_var_constructor(var_decl, "double", o); } o << ";" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/idx_user_visgen.hpp0000644000176200001440000000242313766554456025452 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_IDX_USER_VISGEN_HPP #define STAN_LANG_GENERATOR_IDX_USER_VISGEN_HPP #include #include #include #include namespace stan { namespace lang { /** * Visitor for generating user-facing multiple index. */ struct idx_user_visgen : public visgen { /** * Construct a visitor for generating user-facing multiple * indexex writing to the specified stream. * * @param[in,out] o stream for generating */ explicit idx_user_visgen(std::ostream& o) : visgen(o) {} void operator()(const uni_idx& i) const { generate_expression(i.idx_, USER_FACING, o_); } void operator()(const multi_idx& i) const { generate_expression(i.idxs_, USER_FACING, o_); } void operator()(const omni_idx& i) const { o_ << " "; } void operator()(const lb_idx& i) const { generate_expression(i.lb_, USER_FACING, o_); o_ << ": "; } void operator()(const ub_idx& i) const { o_ << " :"; generate_expression(i.ub_, USER_FACING, o_); } void operator()(const lub_idx& i) const { generate_expression(i.lb_, USER_FACING, o_); o_ << ":"; generate_expression(i.ub_, USER_FACING, o_); } }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_dims_method.hpp0000644000176200001440000000410513766554456026422 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_DIMS_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_DIMS_METHOD_HPP #include #include #include #include namespace stan { namespace lang { void generate_var_dims(const block_var_decl& decl, std::ostream& o) { o << INDENT2 << "dims__.resize(0);" << EOL; std::vector ar_lens = decl.type().array_lens(); for (size_t i = 0; i < ar_lens.size(); ++i) { o << INDENT2 << "dims__.push_back("; generate_expression(ar_lens[i], NOT_USER_FACING, o); o << ");" << EOL; } if (!is_nil(decl.type().innermost_type().arg1())) { o << INDENT2 << "dims__.push_back("; generate_expression(decl.type().innermost_type().arg1(), NOT_USER_FACING, o); o << ");" << EOL; } if (!is_nil(decl.type().innermost_type().arg2())) { o << INDENT2 << "dims__.push_back("; generate_expression(decl.type().innermost_type().arg2(), NOT_USER_FACING, o); o << ");" << EOL; } o << INDENT2 << "dimss__.push_back(dims__);" << EOL; } /** * Generate the get_dims method for the parameters, * transformed parameters, and generated quantities, using the * specified program and generating to the specified stream. * * @param[in] prog program from which to generate * @param[in,out] o stream for generating */ void generate_dims_method(const program& prog, std::ostream& o) { o << EOL << INDENT << "void get_dims(std::vector >& dimss__) const {" << EOL; o << INDENT2 << "dimss__.resize(0);" << EOL; o << INDENT2 << "std::vector dims__;" << EOL; for (size_t i = 0; i < prog.parameter_decl_.size(); ++i) generate_var_dims(prog.parameter_decl_[i], o); for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) generate_var_dims(prog.derived_decl_.first[i], o); for (size_t i = 0; i < prog.generated_decl_.first.size(); ++i) generate_var_dims(prog.generated_decl_.first[i], o); o << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_using.hpp0000644000176200001440000000112113766554456025246 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_USING_HPP #define STAN_LANG_GENERATOR_GENERATE_USING_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate a using statement for the specified type to the * specified stream. * * @param[in] type type for which using statement is geneated * @param[in,out] o stream for generation */ void generate_using(const std::string& type, std::ostream& o) { o << "using " << type << ";" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_model_name_method.hpp0000644000176200001440000000137713766554456027576 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_MODEL_NAME_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_MODEL_NAME_METHOD_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the model_name method for the specified * name on the specified stream. * * @param[in] model_name name of model * @param[in,out] o stream for generating */ void generate_model_name_method(const std::string& model_name, std::ostream& o) { o << INDENT << "std::string model_name() const {" << EOL << INDENT2 << "return \"" << model_name << "\";" << EOL << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/get_typedef_var_type.hpp0000644000176200001440000000153013766554456026463 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GET_TYPEDEF_VAR_TYPE_HPP #define STAN_LANG_GENERATOR_GET_TYPEDEF_VAR_TYPE_HPP #include #include namespace stan { namespace lang { /** * Return cpp type name or stan_math typedef used for bare_expr_type. * * @param[in] bare_type bare_type */ std::string get_typedef_var_type(const bare_expr_type& bare_type) { if (bare_type.innermost_type().is_matrix_type()) { return "matrix_d"; } else if (bare_type.innermost_type().is_row_vector_type()) { return "row_vector_d"; } else if (bare_type.innermost_type().is_vector_type()) { return "vector_d"; } else if (bare_type.innermost_type().is_double_type()) { return "double"; } else if (bare_type.innermost_type().is_int_type()) { return "int"; } return "ill_formed"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_var_idx_all_dims.hpp0000644000176200001440000000175213766554456026773 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_VAR_IDX_ALL_DIMS_HPP #define STAN_LANG_GENERATOR_WRITE_VAR_IDX_ALL_DIMS_HPP #include namespace stan { namespace lang { /** * Generate the loop indexes for the specified variable * which has the specified number of array dimensions and * row/column arguments, writing to the specified stream. * * Regardless of indexing order, indexes on variable are always in-order. * e.g., 3-d array of matrices is indexed: [d1][d2][d3](row,col) * * @param[in] num_ar_dims number of array dimensions of variable * @param[in] num_args ternary indicator for matrix/vector/scalar types * @param[in,out] o stream for generating */ void write_var_idx_all_dims(size_t num_ar_dims, size_t num_args, std::ostream& o) { for (size_t i = 0; i < num_ar_dims; ++i) o << "[k_" << i << "__]"; if (num_args == 1) o << "(j_1__)"; else if (num_args == 2) o << "(j_1__, j_2__)"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_nested_resize_loop_begin.hpp0000644000176200001440000000446413766554456030536 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_NESTED_RESIZE_LOOP_BEGIN_HPP #define STAN_LANG_GENERATOR_WRITE_NESTED_RESIZE_LOOP_BEGIN_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the openings of a sequence of zero or more nested for loops * corresponding to the specified dimension sizes with the * specified indentation level writing to the specified stream. * Declare named size_t variable for each dimension size in order to avoid * re-evaluation of dimension size expression on each iteration. * * Dynamic initialization of parameter variables. * * @param[in] name var name * @param[in] dims dimension sizes * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_nested_resize_loop_begin(const std::string& name, const std::vector& dims, int indent, std::ostream& o) { if (dims.size() == 0) { generate_void_statement(name, indent, o); return; } // declare size_t var d__max__ for (size_t i = 0; i < dims.size(); ++i) { generate_indent(indent, o); o << "size_t " << name << "_d_" << i << "_max__ = "; generate_expression(dims[i], NOT_USER_FACING, o); o << ";" << EOL; } for (size_t i = 0; i < dims.size(); ++i) { if (i < dims.size() - 1) { // dynamic allocation stmt generate_indent(indent + i, o); o << name; for (size_t j = 0; j < i; ++j) o << "[d_" << j << "__]"; o << ".resize(" << name << "_d_" << i << "_max__);" << EOL; } else { // innermost dimension, reserve generate_indent(indent + i, o); o << name; for (size_t j = 0; j < i; ++j) o << "[d_" << j << "__]"; o << ".reserve(" << name << "_d_" << i << "_max__);" << EOL; } // open for loop generate_indent(indent + i, o); o << "for (size_t d_" << i << "__ = 0;" << " d_" << i << "__ < " << name << "_d_" << i << "_max__;" << " ++d_" << i << "__) {" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_name.hpp0000644000176200001440000000101313766554456026746 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_NAME_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_NAME_HPP #include #include namespace stan { namespace lang { /** * Generate the function name from the specified declaration on * the specified stream. * * @param[in] fun function declaration * @param[in,out] o stream for generating */ void generate_function_name(const function_decl_def& fun, std::ostream& o) { o << fun.name_; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_set_param_ranges.hpp0000644000176200001440000000421413766554456027441 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_SET_PARAM_RANGES_HPP #define STAN_LANG_GENERATOR_GENERATE_SET_PARAM_RANGES_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /* * Generate statements in constructor body which cumulatively * determine the size required for the vector of param ranges and * the range for each parameter in the model by iterating over the * list of parameter variable declarations. * Generated code is preceeded by stmt updating global variable * `current_statement_begin__` to src file line number where * parameter variable is declared. * * @param[in] var_decls sequence of variable declarations * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_set_param_ranges(const std::vector& var_decls, int indent, std::ostream& o) { generate_indent(indent, o); o << "num_params_r__ = 0U;" << EOL; generate_indent(indent, o); o << "param_ranges_i__.clear();" << EOL; for (size_t i = 0; i < var_decls.size(); ++i) { generate_indent(indent, o); o << "current_statement_begin__ = " << var_decls[i].begin_line_ << ";" << EOL; std::string var_name(var_decls[i].name()); block_var_type eltype = var_decls[i].type().innermost_type(); if (!is_nil(eltype.arg1())) generate_validate_nonnegative(var_name, eltype.arg1(), indent, o); if (!is_nil(eltype.arg2())) generate_validate_nonnegative(var_name, eltype.arg2(), indent, o); std::vector ar_lens(var_decls[i].type().array_lens()); for (size_t i = 0; i < ar_lens.size(); ++i) generate_validate_nonnegative(var_name, ar_lens[i], indent, o); generate_indent(indent, o); o << "num_params_r__ += "; generate_expression(var_decls[i].type().params_total(), NOT_USER_FACING, o); o << ";" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_instantiation.hpp0000644000176200001440000000432413766554456030722 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate a non-variable (double only) instantiation of specified * function and optionally its default for propto=false * for functions ending in _log. * * Exact behavior differs for unmarked functions, and functions * ending in one of "_rng", "_lp", or "_log". * * @param[in] fun function AST object * @param[in] namespaces vector of strings used to generate the * namespaces generated code is nested in. * @param[in, out] out output stream to which function definition * is written */ void generate_function_instantiation(const function_decl_def& fun, const std::vector& namespaces, std::ostream& out) { // Do not generate anything for forward decalrations if (fun.body_.is_no_op_statement()) { return; } bool is_rng = ends_with("_rng", fun.name_); bool is_lp = ends_with("_lp", fun.name_); bool is_pf = ends_with("_log", fun.name_) || ends_with("_lpdf", fun.name_) || ends_with("_lpmf", fun.name_); // scalar type is always double for instantiations std::string scalar_t_name = "double"; std::string rng_class = "boost::ecuyer1988"; out << "// [[stan::function]]" << EOL; generate_function_inline_return_type(fun, scalar_t_name, 0, out); generate_function_instantiation_name(fun, out); generate_function_arguments(fun, is_rng, is_lp, is_pf, out, true /*no templates*/, rng_class, true /*parameter_defaults*/); generate_function_instantiation_body(fun, namespaces, is_rng, is_lp, is_pf, rng_class, out); out << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_namespace_start.hpp0000644000176200001440000000111213766554456027272 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_NAMESPACE_START_HPP #define STAN_LANG_GENERATOR_GENERATE_NAMESPACE_START_HPP #include #include #include namespace stan { namespace lang { /** * Generate the opening name and brace for a namespace, with two * end of lines. * * @param[in] name name of namespace * @param[in,out] o stream for generating */ void generate_namespace_start(const std::string& name, std::ostream& o) { o << "namespace " << name << "_namespace {" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_var_decl_arg.hpp0000644000176200001440000000534513766554456026105 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_VAR_DECL_ARG_HPP #define STAN_LANG_GENERATOR_WRITE_VAR_DECL_ARG_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Write the initial value passed as an argument to the * variable declaration constructor. * For int type, initial value is 0. * For double type, initial value is DUMMY_VAR * For container types, generate proper set of nested types. * * Note: this is called after array type has been unfolded, * so bare_type shouldn't be bare_array_type (or ill_formed_type). * * @param[in] bare_type * @param[in] cpp_type_str generated cpp type * @param[in] ar_lens vector of sizes for each array dimension * @param[in] arg1 expression for size of first dim of vec/matrix (or nil) * @param[in] arg2 expression for size of second dim of matrix (or nil) * @param[in,out] o stream for generating */ void write_var_decl_arg(const bare_expr_type& bare_type, const std::string& cpp_type_str, const std::vector& ar_lens, const expression& arg1, const expression& arg2, std::ostream& o) { bool ends_with_angle = cpp_type_str[cpp_type_str.length() - 1] == '>'; // innermost element initialization std::stringstream base_init; if (bare_type.is_int_type()) { base_init << "(0)"; } else if (bare_type.is_double_type()) { base_init << "(DUMMY_VAR__)"; } else if (bare_type.is_vector_type() || bare_type.is_row_vector_type()) { base_init << "("; generate_expression(arg1, NOT_USER_FACING, base_init); base_init << ")"; } else if (bare_type.is_matrix_type()) { base_init << "("; generate_expression(arg1, NOT_USER_FACING, base_init); base_init << ", "; generate_expression(arg2, NOT_USER_FACING, base_init); base_init << ")"; } else { // shouldn't get here base_init << "()"; } // for array dimensions, init for each dimension is: // , (n-1) nested vectors of cpp_decl_type int ct = ar_lens.size() - 1; // tracks nesting for (size_t i = 0; i < ar_lens.size(); ++i, --ct) { o << "("; generate_expression(ar_lens[i], NOT_USER_FACING, o); o << ", "; for (int j = 0; j < ct; ++j) o << "std::vector<"; o << cpp_type_str; for (int j = 0; j < ct; ++j) { if (j > 0 || ends_with_angle) o << " "; // maybe not needed for c++11 o << ">"; } } o << base_init.str(); for (size_t i = 0; i < ar_lens.size(); ++i) o << ")"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/get_verbose_var_type.hpp0000644000176200001440000000172113766554456026472 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GET_VERBOSE_VAR_TYPE_HPP #define STAN_LANG_GENERATOR_GET_VERBOSE_VAR_TYPE_HPP #include #include namespace stan { namespace lang { /** * Return type string for variable type. * * @param[in] bare_type expression type */ std::string get_verbose_var_type(const bare_expr_type bare_type) { if (bare_type.innermost_type().is_matrix_type()) { return "Eigen::Matrix"; } else if (bare_type.innermost_type().is_row_vector_type()) { return "Eigen::Matrix"; } else if (bare_type.innermost_type().is_vector_type()) { return "Eigen::Matrix"; } else if (bare_type.innermost_type().is_double_type()) { return "local_scalar_t__"; } else if (bare_type.innermost_type().is_int_type()) { return "int"; } return "ill_formed"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_register_mpi.hpp0000644000176200001440000000116213766554456026617 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_REGISTER_MPI_HPP #define STAN_LANG_GENERATOR_GENERATE_REGISTER_MPI_HPP #include #include // REMOVE ME AFTER TESTING!!!! #include namespace stan { namespace lang { void generate_register_mpi(const std::string& model_name, std::ostream& o) { for (auto a : map_rect::registered_calls()) { int id = a.first; std::string fun_name = a.second; o << "STAN_REGISTER_MAP_RECT(" << id << ", " << model_name << "_namespace::" << fun_name << "_functor__" << ")" << std::endl; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/statement_visgen.hpp0000644000176200001440000003130313766554456025633 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_STATEMENT_VISGEN_HPP #define STAN_LANG_GENERATOR_STATEMENT_VISGEN_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { void generate_idxs(const std::vector& idxs, std::ostream& o); void generate_statement(const statement& s, int indent, std::ostream& o); void generate_statement(const std::vector& ss, int indent, std::ostream& o); /** * Visitor for generating statements. */ struct statement_visgen : public visgen { /** * Indentation level. */ size_t indent_; /** * Construct a visitor for generating statements at the * specified indent level to the specified stream. * * @param[in] indent indentation level * @param[in,out] o stream for generating */ statement_visgen(size_t indent, std::ostream& o) : visgen(o), indent_(indent) {} /** * Generate the target log density increments for truncating a * given density or mass function. * * @param[in] x sampling statement * @param[in] is_user_defined true if user-defined probability * function * @param[in] prob_fun name of probability function */ void generate_truncation(const sample& x, bool is_user_defined, const std::string& prob_fun) const { std::stringstream sso_lp; generate_indent(indent_, o_); if (x.truncation_.has_low() && x.truncation_.has_high()) { // T[L,U]: -log_diff_exp(Dist_cdf_log(U|params), // Dist_cdf_log(L|Params)) sso_lp << "log_diff_exp("; sso_lp << get_cdf(x.dist_.family_) << "("; generate_expression(x.truncation_.high_.expr_, NOT_USER_FACING, sso_lp); for (size_t i = 0; i < x.dist_.args_.size(); ++i) { sso_lp << ", "; generate_expression(x.dist_.args_[i], NOT_USER_FACING, sso_lp); } if (is_user_defined) sso_lp << ", pstream__"; sso_lp << "), " << get_cdf(x.dist_.family_) << "("; generate_expression(x.truncation_.low_.expr_, NOT_USER_FACING, sso_lp); for (size_t i = 0; i < x.dist_.args_.size(); ++i) { sso_lp << ", "; generate_expression(x.dist_.args_[i], NOT_USER_FACING, sso_lp); } if (is_user_defined) sso_lp << ", pstream__"; sso_lp << "))"; } else if (!x.truncation_.has_low() && x.truncation_.has_high()) { // T[,U]; -Dist_cdf_log(U) sso_lp << get_cdf(x.dist_.family_) << "("; generate_expression(x.truncation_.high_.expr_, NOT_USER_FACING, sso_lp); for (size_t i = 0; i < x.dist_.args_.size(); ++i) { sso_lp << ", "; generate_expression(x.dist_.args_[i], NOT_USER_FACING, sso_lp); } if (is_user_defined) sso_lp << ", pstream__"; sso_lp << ")"; } else if (x.truncation_.has_low() && !x.truncation_.has_high()) { // T[L,]: -Dist_ccdf_log(L) sso_lp << get_ccdf(x.dist_.family_) << "("; generate_expression(x.truncation_.low_.expr_, NOT_USER_FACING, sso_lp); for (size_t i = 0; i < x.dist_.args_.size(); ++i) { sso_lp << ", "; generate_expression(x.dist_.args_[i], NOT_USER_FACING, sso_lp); } if (is_user_defined) sso_lp << ", pstream__"; sso_lp << ")"; } o_ << "else lp_accum__.add(-"; if (x.is_discrete() && x.truncation_.has_low()) { o_ << "log_sum_exp(" << sso_lp.str() << ", "; // generate adjustment for lower-bound off by 1 due to log CCDF o_ << prob_fun << "("; generate_expression(x.truncation_.low_.expr_, NOT_USER_FACING, o_); for (size_t i = 0; i < x.dist_.args_.size(); ++i) { o_ << ", "; generate_expression(x.dist_.args_[i], NOT_USER_FACING, o_); } if (is_user_defined) o_ << ", pstream__"; o_ << "))"; } else { o_ << sso_lp.str(); } o_ << ");" << std::endl; } void operator()(const nil& /*x*/) const {} void operator()(const assgn& y) const { bool lhs_simple = y.idxs_.size() == 0; bool assign_simple = y.is_simple_assignment(); // need expr for y for compound operator-assign index_op_sliced lhs_expr(y.lhs_var_, y.idxs_); lhs_expr.infer_type(); generate_indent(indent_, o_); // use stan::math::assign when no idxs (lhs_simple) // use stan::model::assign when indexed (!lhs_simple) // generate method, arg(s) for lhs if (lhs_simple) { o_ << "stan::math::assign("; generate_expression(y.lhs_var_, NOT_USER_FACING, o_); o_ << ", "; } else { o_ << "stan::model::assign("; generate_expression(y.lhs_var_, NOT_USER_FACING, o_); o_ << ", " << EOL; generate_indent(indent_ + 3, o_); generate_idxs(y.idxs_, o_); o_ << ", " << EOL; generate_indent(indent_ + 3, o_); } // generate arg for rhs if (y.lhs_var_has_sliced_idx() && y.lhs_var_occurs_on_rhs()) { o_ << "stan::model::deep_copy("; } if (assign_simple) { generate_expression(y.rhs_, NOT_USER_FACING, o_); } else { if (y.op_name_.size() == 0) { o_ << "("; generate_expression(lhs_expr, NOT_USER_FACING, o_); o_ << " " << y.op_ << " "; generate_expression(y.rhs_, NOT_USER_FACING, o_); o_ << ")"; } else { o_ << y.op_name_ << "("; generate_expression(lhs_expr, NOT_USER_FACING, o_); o_ << ", "; generate_expression(y.rhs_, NOT_USER_FACING, o_); o_ << ")"; } } if (y.lhs_var_has_sliced_idx() && y.lhs_var_occurs_on_rhs()) { o_ << ")"; } // close method if (lhs_simple) { o_ << ");" << EOL; } else { o_ << ", " << EOL; generate_indent(indent_ + 3, o_); o_ << '"' << "assigning variable " << y.lhs_var_.name_ << '"'; o_ << ");" << EOL; } } void operator()(const expression& x) const { generate_indent(indent_, o_); generate_expression(x, NOT_USER_FACING, o_); o_ << ";" << EOL; } void operator()(const sample& x) const { std::string prob_fun = get_prob_fun(x.dist_.family_); generate_indent(indent_, o_); o_ << "lp_accum__.add(" << prob_fun << "("; generate_expression(x.expr_, NOT_USER_FACING, o_); for (size_t i = 0; i < x.dist_.args_.size(); ++i) { o_ << ", "; generate_expression(x.dist_.args_[i], NOT_USER_FACING, o_); } bool is_user_defined = is_user_defined_prob_function(prob_fun, x.expr_, x.dist_.args_); if (is_user_defined) o_ << ", pstream__"; o_ << "));" << EOL; // rest of impl is for truncation // test variable is within truncation interval if (x.truncation_.has_low()) { generate_indent(indent_, o_); o_ << "if ("; generate_expression(x.expr_, NOT_USER_FACING, o_); o_ << " < "; generate_expression(x.truncation_.low_.expr_, NOT_USER_FACING, o_); o_ << ") lp_accum__.add(-std::numeric_limits::infinity());" << EOL; } if (x.truncation_.has_high()) { generate_indent(indent_, o_); if (x.truncation_.has_low()) o_ << "else "; o_ << "if ("; generate_expression(x.expr_, NOT_USER_FACING, o_); o_ << " > "; generate_expression(x.truncation_.high_.expr_, NOT_USER_FACING, o_); o_ << ") lp_accum__.add(-std::numeric_limits::infinity());" << EOL; } // generate log denominator for case where bounds test pass if (x.truncation_.has_low() || x.truncation_.has_high()) generate_truncation(x, is_user_defined, prob_fun); } void operator()(const increment_log_prob_statement& x) const { generate_indent(indent_, o_); o_ << "lp_accum__.add("; generate_expression(x.log_prob_, NOT_USER_FACING, o_); o_ << ");" << EOL; } void operator()(const statements& x) const { bool has_local_vars = x.local_decl_.size() > 0; if (has_local_vars) { generate_indent(indent_, o_); o_ << "{" << EOL; generate_local_var_decl_inits(x.local_decl_, indent_, o_); } o_ << EOL; for (size_t i = 0; i < x.statements_.size(); ++i) { generate_statement(x.statements_[i], indent_, o_); } if (has_local_vars) { generate_indent(indent_, o_); o_ << "}" << EOL; } } void operator()(const print_statement& ps) const { generate_indent(indent_, o_); o_ << "if (pstream__) {" << EOL; for (size_t i = 0; i < ps.printables_.size(); ++i) { generate_indent(indent_ + 1, o_); o_ << "stan_print(pstream__,"; generate_printable(ps.printables_[i], o_); o_ << ");" << EOL; } generate_indent(indent_ + 1, o_); o_ << "*pstream__ << std::endl;" << EOL; generate_indent(indent_, o_); o_ << '}' << EOL; } void operator()(const reject_statement& ps) const { generate_indent(indent_, o_); o_ << "std::stringstream errmsg_stream__;" << EOL; for (size_t i = 0; i < ps.printables_.size(); ++i) { generate_indent(indent_, o_); o_ << "errmsg_stream__ << "; generate_printable(ps.printables_[i], o_); o_ << ";" << EOL; } generate_indent(indent_, o_); o_ << "throw std::domain_error(errmsg_stream__.str());" << EOL; } void operator()(const return_statement& rs) const { generate_indent(indent_, o_); o_ << "return "; if (!rs.return_value_.bare_type().is_ill_formed_type() && !rs.return_value_.bare_type().is_void_type()) { o_ << "stan::math::promote_scalar("; generate_expression(rs.return_value_, NOT_USER_FACING, o_); o_ << ")"; } o_ << ";" << EOL; } void operator()(const for_statement& x) const { generate_indent(indent_, o_); o_ << "for (int " << x.variable_ << " = "; generate_expression(x.range_.low_, NOT_USER_FACING, o_); o_ << "; " << x.variable_ << " <= "; generate_expression(x.range_.high_, NOT_USER_FACING, o_); o_ << "; ++" << x.variable_ << ") {" << EOL; generate_statement(x.statement_, indent_ + 1, o_); generate_indent(indent_, o_); o_ << "}" << EOL; } void operator()(const for_array_statement& x) const { generate_indent(indent_, o_); o_ << "for (auto& " << x.variable_ << " : "; generate_expression(x.expression_, NOT_USER_FACING, o_); o_ << ") {" << EOL; generate_void_statement(x.variable_, indent_ + 1, o_); generate_statement(x.statement_, indent_ + 1, o_); generate_indent(indent_, o_); o_ << "}" << EOL; } void operator()(const for_matrix_statement& x) const { generate_indent(indent_, o_); o_ << "for (auto " << x.variable_ << "__loopid = "; generate_expression(x.expression_, NOT_USER_FACING, o_); o_ << ".data(); " << x.variable_ << "__loopid < "; generate_expression(x.expression_, NOT_USER_FACING, o_); o_ << ".data() + "; generate_expression(x.expression_, NOT_USER_FACING, o_); o_ << ".size(); ++" << x.variable_ << "__loopid) {" << EOL; generate_indent(indent_ + 1, o_); o_ << "auto& " << x.variable_ << " = *("; o_ << x.variable_ << "__loopid);" << EOL; generate_void_statement(x.variable_, indent_ + 1, o_); generate_statement(x.statement_, indent_ + 1, o_); generate_indent(indent_, o_); o_ << "}" << EOL; } void operator()(const while_statement& x) const { generate_indent(indent_, o_); o_ << "while (as_bool("; generate_expression(x.condition_, NOT_USER_FACING, o_); o_ << ")) {" << EOL; generate_statement(x.body_, indent_ + 1, o_); generate_indent(indent_, o_); o_ << "}" << EOL; } void operator()(const break_continue_statement& st) const { generate_indent(indent_, o_); o_ << st.generate_ << ";" << EOL; } void operator()(const conditional_statement& x) const { for (size_t i = 0; i < x.conditions_.size(); ++i) { if (i == 0) generate_indent(indent_, o_); else o_ << " else "; o_ << "if (as_bool("; generate_expression(x.conditions_[i], NOT_USER_FACING, o_); o_ << ")) {" << EOL; generate_statement(x.bodies_[i], indent_ + 1, o_); generate_indent(indent_, o_); o_ << '}'; } if (x.bodies_.size() > x.conditions_.size()) { o_ << " else {" << EOL; generate_statement(x.bodies_[x.bodies_.size() - 1], indent_ + 1, o_); generate_indent(indent_, o_); o_ << '}'; } o_ << EOL; } void operator()(const no_op_statement& /*x*/) const {} }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_write_block_var.hpp0000644000176200001440000000232113766554456027300 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_WRITE_BLOCK_VAR_HPP #define STAN_LANG_GENERATOR_GENERATE_WRITE_BLOCK_VAR_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate validation statements for bounded or specialized block variables. * * @param[in] var_decl block variable * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_write_block_var(const block_var_decl& var_decl, int indent, std::ostream& o) { write_begin_all_dims_col_maj_loop(var_decl, true, indent, o); generate_indent(indent + var_decl.type().num_dims(), o); o << "vars__.push_back(" << var_decl.name(); write_var_idx_all_dims( var_decl.type().array_dims(), var_decl.type().num_dims() - var_decl.type().array_dims(), o); o << ");" << EOL; write_end_loop(var_decl.type().num_dims(), indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_var_constructor.hpp0000644000176200001440000000226613766554456027371 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VAR_CONSTRUCTOR_HPP #define STAN_LANG_GENERATOR_GENERATE_VAR_CONSTRUCTOR_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate the variable constructor using the specified name, * type, and sizes of dimensions, rows, and columns, writing to * the specified stream. * * Scalar type string is `local_scalar_t__` in log_prob method, * `double` elsewhere. * * @param[in] var_decl variable declaration * @param[in] scalar_t_name name of scalar type for double values * @param[in,out] o stream for generating */ template void generate_var_constructor(const T& var_decl, const std::string& scalar_t_name, std::ostream& o) { // no constructors for scalar types - shouldn't get called if (var_decl.bare_type().is_primitive()) return; generate_bare_type(var_decl.bare_type(), scalar_t_name, o); generate_initializer(var_decl.type(), scalar_t_name, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_var_idx_array_dims.hpp0000644000176200001440000000116513766554456027337 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_VAR_IDX_ARRAY_DIMS_HPP #define STAN_LANG_GENERATOR_WRITE_VAR_IDX_ARRAY_DIMS_HPP #include namespace stan { namespace lang { /** * Generate the loop indexes for the specified variable * which has the specified number of array dimensions, * writing to the specified stream. * * @param[in] num_ar_dims number of array dimensions of variable * @param[in,out] o stream for generating */ void write_var_idx_array_dims(size_t num_ar_dims, std::ostream& o) { for (size_t i = 0; i < num_ar_dims; ++i) o << "[i_" << i << "__]"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_begin_all_dims_col_maj_loop.hpp0000644000176200001440000000560413766554456031140 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_BEGIN_ALL_DIMS_COL_MAJ_LOOP_HPP #define STAN_LANG_GENERATOR_WRITE_BEGIN_ALL_DIMS_COL_MAJ_LOOP_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the openings of a sequence of zero or more for loops * corresponding to all dimensions of a variable, with the * specified indentation level writing to the specified stream. * If specified, declare named size_t variable for each dimension * which avoids re-evaluation of size expression on each iteration. * * Indexing order is column major, nesting is innermost to outermost * e.g., 3-d array of matrices indexing order: col, row, d3, d2, d1 * * @param[in] var_decl variable declaration * @param[in] declare_size_vars if true, generate size_t var decls * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_begin_all_dims_col_maj_loop(const block_var_decl& var_decl, bool declare_size_vars, int indent, std::ostream& o) { std::string name(var_decl.name()); expression arg1(var_decl.type().innermost_type().arg1()); expression arg2(var_decl.type().innermost_type().arg2()); std::vector ar_var_dims = var_decl.type().array_lens(); if (!is_nil(arg2)) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_j_2_max__ = "; generate_expression(arg2, NOT_USER_FACING, o); o << ";" << EOL; } if (!is_nil(arg1)) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_j_1_max__ = "; generate_expression(arg1, NOT_USER_FACING, o); o << ";" << EOL; } for (size_t i = 0; i < ar_var_dims.size(); ++i) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_k_" << i << "_max__ = "; generate_expression(ar_var_dims[i], NOT_USER_FACING, o); o << ";" << EOL; } // nested for stmts open, row, col indexes if (!is_nil(arg2)) { generate_indent(indent++, o); o << "for (size_t j_2__ = 0; " << "j_2__ < " << name << "_j_2_max__;" << " ++j_2__) {" << EOL; } if (!is_nil(arg1)) { generate_indent(indent++, o); o << "for (size_t j_1__ = 0; " << "j_1__ < " << name << "_j_1_max__;" << " ++j_1__) {" << EOL; } for (size_t i = ar_var_dims.size(); i > 0; --i) { int idx = i - 1; // size == N, indexes run from 0 .. N - 1 generate_indent(indent++, o); o << "for (size_t k_" << idx << "__ = 0;" << " k_" << idx << "__ < " << name << "_k_" << idx << "_max__;" << " ++k_" << idx << "__) {" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_class_decl_end.hpp0000644000176200001440000000056213766554456027053 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_CLASS_DECL_END_HPP #define STAN_LANG_GENERATOR_GENERATE_CLASS_DECL_END_HPP #include #include #include namespace stan { namespace lang { void generate_class_decl_end(std::ostream& o) { o << "}; // model" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_transform_inits_method.hpp0000644000176200001440000001465113766554456030716 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_TRANSFORM_INITS_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_TRANSFORM_INITS_METHOD_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the transform_inits method declaration * and variable decls. * * @param[in,out] o stream for generating */ void generate_method_begin(std::ostream& o) { o << EOL; o << INDENT << "void transform_inits(const stan::io::var_context& context__," << EOL; o << INDENT << " std::vector& params_i__," << EOL; o << INDENT << " std::vector& params_r__," << EOL; o << INDENT << " std::ostream* pstream__) const {" << EOL; o << INDENT2 << "typedef double local_scalar_t__;" << EOL; o << INDENT2 << "stan::io::writer " << "writer__(params_r__, params_i__);" << EOL; o << INDENT2 << "size_t pos__;" << EOL; o << INDENT2 << "(void) pos__; // dummy call to supress warning" << EOL; o << INDENT2 << "std::vector vals_r__;" << EOL; o << INDENT2 << "std::vector vals_i__;" << EOL; } /** * Generate the transform_inits method declaration final statements * and close. * * @param[in,out] o stream for generating */ void generate_method_end(std::ostream& o) { o << INDENT2 << "params_r__ = writer__.data_r();" << EOL; o << INDENT2 << "params_i__ = writer__.data_i();" << EOL; o << INDENT << "}" << EOL2; o << INDENT << "void transform_inits(const stan::io::var_context& context," << EOL; o << INDENT << " " << "Eigen::Matrix& params_r," << EOL; o << INDENT << " std::ostream* pstream__) const {" << EOL; o << INDENT << " std::vector params_r_vec;" << EOL; o << INDENT << " std::vector params_i_vec;" << EOL; o << INDENT << " transform_inits(context, params_i_vec, params_r_vec, pstream__);" << EOL; o << INDENT << " params_r.resize(params_r_vec.size());" << EOL; o << INDENT << " for (int i = 0; i < params_r.size(); ++i)" << EOL; o << INDENT << " params_r(i) = params_r_vec[i];" << EOL; o << INDENT << "}" << EOL2; } /** * Generate the transform_inits method for the * specified parameter variable declarations to the specified stream. * * @param[in] vs variable declarations * @param[in,out] o stream for generating */ void generate_transform_inits_method(const std::vector& vs, std::ostream& o) { int indent = 2; generate_method_begin(o); o << EOL; for (size_t i = 0; i < vs.size(); ++i) { std::string var_name(vs[i].name()); block_var_type vtype = vs[i].type(); block_var_type el_type = vs[i].type().innermost_type(); // parser prevents this from happening - double check to // avoid generating code that won't compile - flag/ignore int params if (vs[i].bare_type().is_int_type()) { std::stringstream ss; ss << "Found int-valued param: " << var_name << "; illegal - params must be real-valued" << EOL; generate_comment(ss.str(), indent, o); continue; } generate_indent(indent, o); o << "current_statement_begin__ = " << vs[i].begin_line_ << ";" << EOL; // check context generate_indent(indent, o); o << "if (!(context__.contains_r(\"" << var_name << "\")))" << EOL; generate_indent(indent + 1, o); o << "stan::lang::rethrow_located(" << "std::runtime_error(std::string(\"Variable " << var_name << " missing\")), current_statement_begin__, prog_reader__());" << EOL; // init context position generate_indent(indent, o); o << "vals_r__ = context__.vals_r(\"" << var_name << "\");" << EOL; generate_indent(indent, o); o << "pos__ = 0U;" << EOL; // validate dims, match against input sizes generate_validate_var_dims(vs[i], indent, o); generate_validate_context_size(vs[i], "parameter initialization", indent, o); // instantiate generate_indent(indent, o); generate_bare_type(vtype.bare_type(), "double", o); o << " " << var_name; if (vtype.num_dims() == 0) { o << "(0);" << EOL; } else { generate_initializer(vs[i].type(), "double", o); o << ";" << EOL; } // fill vals_r__ loop write_begin_all_dims_col_maj_loop(vs[i], true, indent, o); generate_indent(indent + vtype.num_dims(), o); o << var_name; write_var_idx_all_dims(vtype.array_dims(), vtype.num_dims() - vtype.array_dims(), o); o << " = vals_r__[pos__++];" << EOL; write_end_loop(vtype.num_dims(), indent, o); // unconstrain var contents write_begin_array_dims_loop(vs[i], true, indent, o); generate_indent(indent + vtype.array_dims(), o); o << "try {" << EOL; generate_indent(indent + vtype.array_dims() + 1, o); o << "writer__." << write_constraints_fn(el_type, "unconstrain"); o << var_name; write_var_idx_array_dims(vtype.array_dims(), o); o << ");" << EOL; generate_indent(indent + vtype.array_dims(), o); o << "} catch (const std::exception& e) {" << EOL; generate_indent(indent + vtype.array_dims() + 1, o); o << "stan::lang::rethrow_located(" << "std::runtime_error(std::string(\"Error transforming variable " << var_name << ": \") + e.what()), current_statement_begin__, prog_reader__());" << EOL; generate_indent(indent + vtype.array_dims(), o); o << "}" << EOL; write_end_loop(vtype.array_dims(), indent, o); // all done, add blank line for readibility o << EOL; } generate_method_end(o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/is_numbered_statement_vis.hpp0000644000176200001440000000351413766554456027520 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_IS_NUMBERED_STATEMENT_VIS_HPP #define STAN_LANG_GENERATOR_IS_NUMBERED_STATEMENT_VIS_HPP #include #include #include namespace stan { namespace lang { /** * Visitor to return true if the statement is numbered for error * reporting. All statements are numbered except for: * the nil and no-op statements because there is nothing to number; * sequences of statements because each statement within the sequence * is numbered. */ struct is_numbered_statement_vis : public boost::static_visitor { /** * Construct a numbered statement visitor. */ is_numbered_statement_vis() {} bool operator()(const nil& st) const { return false; } bool operator()(const assgn& st) const { return true; } bool operator()(const sample& st) const { return true; } bool operator()(const increment_log_prob_statement& t) const { return true; } bool operator()(const expression& st) const { return true; } bool operator()(const statements& st) const { return false; } bool operator()(const for_statement& st) const { return true; } bool operator()(const for_array_statement& st) const { return true; } bool operator()(const for_matrix_statement& st) const { return true; } bool operator()(const conditional_statement& st) const { return true; } bool operator()(const while_statement& st) const { return true; } bool operator()(const break_continue_statement& st) const { return true; } bool operator()(const print_statement& st) const { return true; } bool operator()(const reject_statement& st) const { return true; } bool operator()(const no_op_statement& st) const { return false; } bool operator()(const return_statement& st) const { return true; } }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_propto_default_function.hpp0000644000176200001440000000263613766554456031071 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PROPTO_DEFAULT_FUNCTION_HPP #define STAN_LANG_GENERATOR_GENERATE_PROPTO_DEFAULT_FUNCTION_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate a version of the specified function with propto set to * false, with the specified local scalar type, writing to the * specified stream. * * @param[in] fun function declaration * @param[in] scalar_t_name string representation of scalar type * for local scalar variables * @param[in,out] o stream for generating */ void generate_propto_default_function(const function_decl_def& fun, const std::string& scalar_t_name, std::ostream& o) { generate_function_template_parameters(fun, false, false, false, o); generate_function_inline_return_type(fun, scalar_t_name, 0, o); generate_function_name(fun, o); generate_function_arguments(fun, false, false, false, o); generate_propto_default_function_body(fun, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_indent.hpp0000644000176200001440000000105113766554456025404 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_INDENT_HPP #define STAN_LANG_GENERATOR_GENERATE_INDENT_HPP #include #include namespace stan { namespace lang { /** * Write the specified number of indentations to the specified * output stream. * * @param indent number of indentations * @param[in, out] o stream to which indentations are written */ void generate_indent(size_t indent, std::ostream& o) { for (size_t k = 0; k < indent; ++k) o << INDENT; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_write_array_method.hpp0000644000176200001440000001544313766554456030025 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_WRITE_ARRAY_METHOD_HPP #define STAN_LANG_GENERATOR_GENERATE_WRITE_ARRAY_METHOD_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the write_array method for the specified * program, with specified model name to the specified stream. * * @param[in] prog program from which to generate * @param[in] model_name name of model * @param[in,out] o stream for generating */ void generate_write_array_method(const program& prog, const std::string& model_name, std::ostream& o) { o << INDENT << "template " << EOL; o << INDENT << "void write_array(RNG& base_rng__," << EOL; o << INDENT << " std::vector& params_r__," << EOL; o << INDENT << " std::vector& params_i__," << EOL; o << INDENT << " std::vector& vars__," << EOL; o << INDENT << " bool include_tparams__ = true," << EOL; o << INDENT << " bool include_gqs__ = true," << EOL; o << INDENT << " std::ostream* pstream__ = 0) const {" << EOL; o << INDENT2 << "typedef double local_scalar_t__;" << EOL2; o << INDENT2 << "vars__.resize(0);" << EOL; o << INDENT2 << "stan::io::reader in__(params_r__, params_i__);" << EOL; o << INDENT2 << "static const char* function__ = \"" << model_name << "_namespace::write_array\";" << EOL; generate_void_statement("function__", 2, o); o << EOL; generate_comment("read-transform, write parameters", 2, o); generate_read_transform_params(prog.parameter_decl_, 2, o); o << INDENT2 << "double lp__ = 0.0;" << EOL; generate_void_statement("lp__", 2, o); o << INDENT2 << "stan::math::accumulator lp_accum__;" << EOL2; o << INDENT2 << "local_scalar_t__ DUMMY_VAR__" << "(std::numeric_limits::quiet_NaN());" << EOL; o << INDENT2 << "(void) DUMMY_VAR__; // suppress unused var warning" << EOL2; o << INDENT2 << "if (!include_tparams__ && !include_gqs__) return;" << EOL2; generate_try(2, o); if (prog.derived_decl_.first.size() > 0) { generate_comment("declare and define transformed parameters", 3, o); for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.derived_decl_.first[i].begin_line_ << ";" << EOL; generate_block_var(prog.derived_decl_.first[i], "double", 3, o); o << EOL; } } if (prog.derived_decl_.second.size() > 0) { generate_comment("do transformed parameters statements", 3, o); generate_statements(prog.derived_decl_.second, 3, o); o << EOL; } o << INDENT3 << "if (!include_gqs__ && !include_tparams__) return;" << EOL; if (prog.derived_decl_.first.size() > 0) { generate_comment("validate transformed parameters", 3, o); o << INDENT3 << "const char* function__ = \"validate transformed params\";" << EOL; o << INDENT3 << "(void) function__; // dummy to suppress unused var warning" << EOL; o << EOL; for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) { block_var_decl bvd = prog.derived_decl_.first[i]; if (bvd.type().innermost_type().is_constrained()) { generate_indent(3, o); o << "current_statement_begin__ = " << bvd.begin_line_ << ";" << EOL; generate_validate_block_var(bvd, 3, o); } } generate_comment("write transformed parameters", 3, o); o << INDENT3 << "if (include_tparams__) {" << EOL; for (size_t i = 0; i < prog.derived_decl_.first.size(); ++i) { generate_write_block_var(prog.derived_decl_.first[i], 4, o); } o << INDENT3 << "}" << EOL; } o << INDENT3 << "if (!include_gqs__) return;" << EOL; if (prog.generated_decl_.first.size() > 0) { generate_comment("declare and define generated quantities", 3, o); for (size_t i = 0; i < prog.generated_decl_.first.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.generated_decl_.first[i].begin_line_ << ";" << EOL; generate_block_var(prog.generated_decl_.first[i], "double", 3, o); o << EOL; } } if (prog.generated_decl_.second.size() > 0) { generate_comment("generated quantities statements", 3, o); generate_statements(prog.generated_decl_.second, 3, o); o << EOL; } if (prog.generated_decl_.first.size() > 0) { generate_comment("validate, write generated quantities", 3, o); for (size_t i = 0; i < prog.generated_decl_.first.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.generated_decl_.first[i].begin_line_ << ";" << EOL; generate_validate_block_var(prog.generated_decl_.first[i], 3, o); generate_write_block_var(prog.generated_decl_.first[i], 3, o); o << EOL; } } generate_catch_throw_located(2, o); o << INDENT << "}" << EOL2; o << INDENT << "template " << EOL; o << INDENT << "void write_array(RNG& base_rng," << EOL; o << INDENT << " Eigen::Matrix& params_r," << EOL; o << INDENT << " Eigen::Matrix& vars," << EOL; o << INDENT << " bool include_tparams = true," << EOL; o << INDENT << " bool include_gqs = true," << EOL; o << INDENT << " std::ostream* pstream = 0) const {" << EOL; o << INDENT << " std::vector params_r_vec(params_r.size());" << EOL; o << INDENT << " for (int i = 0; i < params_r.size(); ++i)" << EOL; o << INDENT << " params_r_vec[i] = params_r(i);" << EOL; o << INDENT << " std::vector vars_vec;" << EOL; o << INDENT << " std::vector params_i_vec;" << EOL; o << INDENT << " write_array(base_rng, params_r_vec, params_i_vec, " << "vars_vec, include_tparams, include_gqs, pstream);" << EOL; o << INDENT << " vars.resize(vars_vec.size());" << EOL; o << INDENT << " for (int i = 0; i < vars.size(); ++i)" << EOL; o << INDENT << " vars(i) = vars_vec[i];" << EOL; o << INDENT << "}" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/printable_visgen.hpp0000644000176200001440000000221413766554456025606 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_PRINTABLE_VISGEN_HPP #define STAN_LANG_GENERATOR_PRINTABLE_VISGEN_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * A visitor for generating strings and expressions, printing them * for C++. */ struct printable_visgen : public visgen { /** * Construct a printable visitor that generates to the specified * stream. * * @param o stream for generating */ explicit printable_visgen(std::ostream& o) : visgen(o) {} /** * Generate a quoted version of the specified string, escaping * control characters as necessary. * * @param s string to generate */ void operator()(const std::string& s) const { generate_quoted_string(s, o_); } /** * Generate the specified expression. * * @param e expression to generate */ void operator()(const expression& e) const { generate_expression(e, NOT_USER_FACING, o_); } }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_validate_var_decl.hpp0000644000176200001440000000542713766554456027566 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VALIDATE_VAR_DECL_HPP #define STAN_LANG_GENERATOR_GENERATE_VALIDATE_VAR_DECL_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate code to validate the specified variable declaration * using the specified indentation level and stream. * Checks any defined bounds or constraints on specialized types. * NOTE: bounded / specialized types are mutually exclusive * * @param[in] decl variable declaration * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_validate_var_decl(const block_var_decl decl, int indent, std::ostream& o) { std::string var_name(decl.name()); std::vector ar_lens(decl.type().array_lens()); block_var_type btype = decl.type().innermost_type(); if (btype.has_def_bounds()) { range bounds = btype.bounds(); write_begin_array_dims_loop(decl, true, indent, o); if (bounds.has_low()) { generate_indent(indent + ar_lens.size(), o); o << "check_greater_or_equal(function__, "; o << "\"" << var_name; write_var_idx_array_dims(ar_lens.size(), o); o << "\", " << var_name; write_var_idx_array_dims(ar_lens.size(), o); o << ", "; generate_expression(bounds.low_.expr_, NOT_USER_FACING, o); o << ");" << EOL; } if (bounds.has_high()) { generate_indent(indent + ar_lens.size(), o); o << "check_less_or_equal(function__, "; o << "\"" << var_name; write_var_idx_array_dims(ar_lens.size(), o); o << "\", " << var_name; write_var_idx_array_dims(ar_lens.size(), o); o << ", "; generate_expression(bounds.high_.expr_, NOT_USER_FACING, o); o << ");" << EOL; } write_end_loop(ar_lens.size(), indent, o); } else if (btype.is_specialized()) { write_begin_array_dims_loop(decl, true, indent, o); generate_indent(indent + ar_lens.size(), o); o << "stan::math::check_"; // kludge - inconsistent naming specialized cholesky_factor types if (btype.name() == "cholesky_factor_cov") o << "cholesky_factor"; else o << btype.name(); o << "(function__, \"" << var_name; write_var_idx_array_dims(ar_lens.size(), o); o << "\", " << var_name; write_var_idx_array_dims(ar_lens.size(), o); o << ");" << EOL; write_end_loop(ar_lens.size(), indent, o); } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_catch_throw_located.hpp0000644000176200001440000000226413766554456030132 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_CATCH_THROW_LOCATED_HPP #define STAN_LANG_GENERATOR_GENERATE_CATCH_THROW_LOCATED_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate code to catch and rethrow an exception that includes * location information read out of the generated context. * * @param[in] indent indentation level * @param[in,out] o stream for generating. */ void generate_catch_throw_located(int indent, std::ostream& o) { generate_indent(indent, o); o << "} catch (const std::exception& e) {" << EOL; generate_indent(indent + 1, o); o << "stan::lang::rethrow_located(e, current_statement_begin__" << ", prog_reader__());" << EOL; generate_comment("Next line prevents compiler griping about no return", indent + 1, o); generate_indent(indent + 1, o); o << "throw std::runtime_error" << "(\"*** IF YOU SEE THIS, PLEASE REPORT A BUG ***\");" << EOL; generate_indent(indent, o); o << "}" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_local_var_decl_inits.hpp0000644000176200001440000000541013766554456030265 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_LOCAL_VAR_DECL_INITS_HPP #define STAN_LANG_GENERATOR_GENERATE_LOCAL_VAR_DECL_INITS_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate local variable declarations, including * initializations, for the specified declarations, indentation * level, writing to the specified stream. * Generated code is preceeded by stmt updating global variable * `current_statement_begin__` to src file line number where * variable is declared. * * @param[in] vs variable declarations * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_local_var_decl_inits(const std::vector& vs, int indent, std::ostream& o) { for (size_t i = 0; i < vs.size(); ++i) { generate_indent(indent, o); o << "current_statement_begin__ = " << vs[i].begin_line_ << ";" << EOL; // validate dimensions before declaration if (vs[i].type().num_dims() > 0) generate_validate_var_dims(vs[i], indent, o); // declare std::string var_name(vs[i].name()); local_var_type ltype = vs[i].type().innermost_type(); std::string cpp_type_str = get_verbose_var_type(ltype.bare_type()); write_var_decl_type(ltype.bare_type(), cpp_type_str, vs[i].type().array_dims(), indent, o); o << " " << var_name; write_var_decl_arg(ltype.bare_type(), cpp_type_str, vs[i].type().array_lens(), ltype.arg1(), ltype.arg2(), o); o << ";" << EOL; // initialize if (vs[i].type().num_dims() == 0) generate_void_statement(var_name, indent, o); if (!ltype.bare_type().is_int_type()) { generate_indent(indent, o); o << "stan::math::initialize(" << var_name << ", DUMMY_VAR__);" << EOL; } // fill generate_indent(indent, o); o << "stan::math::fill(" << var_name << ", " << (ltype.bare_type().is_int_type() ? "std::numeric_limits::min()" : "DUMMY_VAR__") << ");" << EOL; // define if (vs[i].has_def()) { generate_indent(indent, o); o << "stan::math::assign(" << vs[i].name() << ","; generate_expression(vs[i].def(), NOT_USER_FACING, o); o << ");" << EOL; } o << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_arguments.hpp0000644000176200001440000000473213766554456030046 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_ARGUMENTS_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_ARGUMENTS_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the arguments for the specified function, with * precalculated flags for whether it is an RNG, uses the log * density accumulator or is a probability function, to the * specified stream. * * @param[in] fun function declaration * @param[in] is_rng true if function is an RNG * @param[in] is_lp true if function accesses log density * accumulator * @param[in] is_log true if function is log probability function * @param[in,out] o stream for generating * @param[in] double_only do not do any templating and make all arguments * based on the standard double type * @param[in] rng_type set a type of the rng argument in _rng functions * @param[in] parameter_defaults if true, default values for the standard * parameters (now only pstream__) will be generated */ void generate_function_arguments(const function_decl_def& fun, bool is_rng, bool is_lp, bool is_log, std::ostream& o, bool double_only = false, std::string rng_type = "RNG", bool parameter_defaults = false) { o << "("; for (size_t i = 0; i < fun.arg_decls_.size(); ++i) { std::string template_type_i; if (double_only) { template_type_i = "double"; } else { template_type_i = "T" + boost::lexical_cast(i) + "__"; } generate_arg_decl(true, true, fun.arg_decls_[i], template_type_i, o); if (i + 1 < fun.arg_decls_.size()) { o << "," << EOL << INDENT; for (size_t i = 0; i <= fun.name_.size(); ++i) o << " "; } } if ((is_rng || is_lp) && fun.arg_decls_.size() > 0) o << ", "; if (is_rng) { o << rng_type << "& base_rng__"; } else if (is_lp) { if (double_only) { o << "double& lp__, stan::math::accumulator& lp_accum__"; } else { o << "T_lp__& lp__, T_lp_accum__& lp_accum__"; } } if (is_rng || is_lp || fun.arg_decls_.size() > 0) o << ", "; o << "std::ostream* pstream__"; if (parameter_defaults) { o << " = nullptr"; } o << ")"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_resize_var_idx.hpp0000644000176200001440000000113213766554456026500 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_RESIZE_VAR_IDX_HPP #define STAN_LANG_GENERATOR_WRITE_RESIZE_VAR_IDX_HPP #include namespace stan { namespace lang { /** * Generate the loop indexes for the first n-1 of the specified * number of array dimensions, writing to the specified stream. * * @param[in] num_ar_dims number of array dimensions of variable * @param[in,out] o stream for generating */ void write_resize_var_idx(size_t num_ar_dims, std::ostream& o) { for (size_t i = 0; i < num_ar_dims - 1; ++i) o << "[d_" << i << "__]"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_instantiation_body.hpp0000644000176200001440000000434413766554456031741 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_BODY_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_BODY_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the body for a function instantiation (e.g., the * call to the templated function with all templated arguments based on * double). * Requires precalculated flags for whether it is an RNG, uses the log * density accumulator or is a probability function, to the * specified stream. * * @param[in] fun function declaration * @param[in] namespaces vector of strings used to generate the * namespaces generated code is nested in. * @param[in] is_rng true if function is an RNG * @param[in] is_lp true if function accesses log density * accumulator * @param[in] is_log true if function is log probability function * @param[in] rng_class class of the RNG being used (required by xxx_rng * functions) * @param[in,out] o stream for generating */ void generate_function_instantiation_body( const function_decl_def& fun, const std::vector& namespaces, bool is_rng, bool is_lp, bool is_log, const std::string& rng_class, std::ostream& o) { o << "{" << EOL; o << " "; if (!fun.return_type_.is_void_type()) { o << "return "; } o << EOL; for (const std::string& namespace_i : namespaces) { o << namespace_i << "::"; } generate_function_name(fun, o); generate_function_instantiation_template_parameters(fun, is_rng, is_lp, is_log, rng_class, o); o << "("; for (size_t arg_i = 0; arg_i < fun.arg_decls_.size(); ++arg_i) { o << fun.arg_decls_[arg_i].name(); if (arg_i + 1 < fun.arg_decls_.size()) { o << ", "; } } if ((is_rng || is_lp) && fun.arg_decls_.size() > 0) o << ", "; if (is_rng) o << "base_rng__"; else if (is_lp) o << "lp__, lp_accum__"; if (is_rng || is_lp || fun.arg_decls_.size() > 0) o << ", "; o << "pstream__"; o << ");" << EOL; o << "}" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_propto_default_function_body.hpp0000644000176200001440000000173213766554456032102 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PROPTO_DEFAULT_FUNCTION_BODY_HPP #define STAN_LANG_GENERATOR_GENERATE_PROPTO_DEFAULT_FUNCTION_BODY_HPP #include #include #include namespace stan { namespace lang { /** * Generate the body of the specified function with * propto set to false, writing to the specified * stream. * * @param[in] fun function declaration * @param[in,out] o stream for generating */ void generate_propto_default_function_body(const function_decl_def& fun, std::ostream& o) { o << " {" << EOL; o << INDENT << "return "; o << fun.name_ << "("; for (size_t i = 0; i < fun.arg_decls_.size(); ++i) { if (i > 0) o << ","; o << fun.arg_decls_[i].name(); } if (fun.arg_decls_.size() > 0) o << ", "; o << "pstream__"; o << ");" << EOL; o << "}" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_param_names_array.hpp0000644000176200001440000000351413766554456027612 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PARAM_NAMES_ARRAY_HPP #define STAN_LANG_GENERATOR_GENERATE_PARAM_NAMES_ARRAY_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the parameter names for the specified parameter variable. * * @param[in] indent level of indentation * @param[in,out] o stream for generating * @param[in] var_decl block_var_decl */ void generate_param_names_array(size_t indent, std::ostream& o, const block_var_decl& var_decl) { std::string var_name(var_decl.name()); block_var_type vtype = var_decl.type(); block_var_type el_type = vtype.innermost_type(); write_begin_all_dims_col_maj_loop(var_decl, true, indent, o); generate_indent(indent + vtype.num_dims(), o); o << "param_name_stream__.str(std::string());" << EOL; generate_indent(indent + vtype.num_dims(), o); o << "param_name_stream__ << \"" << var_name << '"'; size_t num_ar_dims = vtype.array_dims(); size_t num_args = vtype.num_dims() - vtype.array_dims(); for (size_t i = 0; i < num_ar_dims; ++i) o << " << '.' << k_" << i << "__ + 1"; if (num_args == 1) o << " << '.' << j_1__ + 1"; else if (num_args == 2) o << " << '.' << j_1__ + 1 << '.' << j_2__ + 1"; o << ';' << EOL; generate_indent(indent + vtype.num_dims(), o); o << "param_names__.push_back(param_name_stream__.str());" << EOL; write_end_loop(vtype.num_dims(), indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_using_namespace.hpp0000644000176200001440000000117313766554456027271 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_USING_NAMESPACE_HPP #define STAN_LANG_GENERATOR_GENERATE_USING_NAMESPACE_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate using statement for the specified namespace to the * specfied stream. * * @param[in] ns namespace for which using statement is generated * @param[in,out] o stream for generating */ void generate_using_namespace(const std::string& ns, std::ostream& o) { o << "using namespace " << ns << ";" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_typedef.hpp0000644000176200001440000000124513766554456025570 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_TYPEDEF_HPP #define STAN_LANG_GENERATOR_GENERATE_TYPEDEF_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate a typedef statement for the specified type. * * @param[in] type type for definition * @param[in] abbrev abbreviation defined for type * @param[in,out] o stream for writing */ void generate_typedef(const std::string& type, const std::string& abbrev, std::ostream& o) { o << "typedef" << " " << type << " " << abbrev << ";" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_functions.hpp0000644000176200001440000000170713766554456026143 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTIONS_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTIONS_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate function forward declarations, definitions, and * functors for the the specified sequence of function * declarations and definitions, writing to the specified stream. * * @param[in] funs sequence of function declarations and * definitions * @param[in,out] o stream for generating * are generated (for non-templated functions only) */ void generate_functions(const std::vector& funs, std::ostream& o) { for (size_t i = 0; i < funs.size(); ++i) { generate_function(funs[i], o); generate_function_functor(funs[i], o); } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_template_parameters.hpp0000644000176200001440000000373213766554456032076 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_TEMPLATE_PARAMETERS_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_TEMPLATE_PARAMETERS_HPP #include #include #include namespace stan { namespace lang { /** * Generate the template declaration for functions. * * @param[in] fun function declaration * @param[in] is_rng true if function is a random number generator * @param[in] is_lp true if function accesses log density * accumulator * @param[in] is_log true if function is a probability function * @param[in] out stream for generating */ void generate_function_template_parameters(const function_decl_def& fun, bool is_rng, bool is_lp, bool is_log, std::ostream& out) { if (!fun.has_only_int_args()) { // other cases handled below out << "template <"; bool continuing_tps = false; if (is_log) { out << "bool propto"; continuing_tps = true; } for (size_t i = 0; i < fun.arg_decls_.size(); ++i) { // no template parameter for int based args if (!fun.arg_decls_[i].bare_type().innermost_type().is_int_type()) { if (continuing_tps) out << ", "; out << "typename T" << i << "__"; continuing_tps = true; } } if (is_rng) { if (continuing_tps) out << ", "; out << "class RNG"; continuing_tps = true; } else if (is_lp) { if (continuing_tps) out << ", "; out << "typename T_lp__, typename T_lp_accum__"; continuing_tps = true; } out << ">" << EOL; } else { // no-arg function if (is_rng) { // nullary RNG case out << "template " << EOL; } else if (is_lp) { out << "template " << EOL; } else if (is_log) { out << "template " << EOL; } } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/visgen.hpp0000644000176200001440000000265013766554456023552 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_VISGEN_HPP #define STAN_LANG_GENERATOR_VISGEN_HPP #include #include namespace stan { namespace lang { /** * Base class for variant type visitor that generates output by * writing to an output stream. */ struct visgen { /** * Result type for visitor pattern; always void for generators. */ typedef void result_type; /** * Construct a varint type visitor for generation to the * specified output stream, with indentation level zero. The * specified output stream must remain in scope in order to use * this object. * * @param[in,out] o output stream to store by reference for generation */ explicit visgen(std::ostream& o) : indent_(0), o_(o) {} /** * Construct a varint type visitor for generation to the * specified output stream at the specified indentation level. * The specified output stream must remain in scope in order to * use this object. * * @param[in] indent indentation level * @param[in,out] o output stream to store by reference for generation */ explicit visgen(int indent, std::ostream& o) : indent_(indent), o_(o) {} /** * Base destructor does nothing. Specialize in subclasses. */ virtual ~visgen() {} /** * Indentation level. */ int indent_; /** * Reference to output stream for generation. */ std::ostream& o_; }; } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_validate_nonnegative.hpp0000644000176200001440000000316513766554456030321 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VALIDATE_NONNEGATIVE_HPP #define STAN_LANG_GENERATOR_GENERATE_VALIDATE_NONNEGATIVE_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate call to stan_math lib function validate_non_negative_index * which will throw an informative error if dim size is < 0 * * This check should precede the variable declaration in order to * avoid bad alloc runtime error. * Called by *
generate_validate_context_size - data variables *
generate_initialization - transformed data declarations *
generate_var_resiszing - initializes transformed data variables *
generate_local_var_decl_inits - local variables, transformed parameters * write array, generated quantities *
generate_set_param_ranges - parameter variables * * @param[in] name variable name * @param[in] expr dim size expression * @param[in] indent indentation level * @param[in,out] o output stream for generated code */ void generate_validate_nonnegative(const std::string& name, const expression& expr, int indent, std::ostream& o) { generate_indent(indent, o); o << "validate_non_negative_index(\"" << name << "\", "; generate_quoted_expression(expr, o); o << ", "; generate_expression(expr, NOT_USER_FACING, o); o << ");" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_includes.hpp0000644000176200001440000000107113766554456025733 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_INCLUDES_HPP #define STAN_LANG_GENERATOR_GENERATE_INCLUDES_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate include statements for a Stan model class to the * specified stream. * * @param o stream for generating */ void generate_includes(std::ostream& o) { generate_include("stan/model/model_header.hpp", o); o << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_model_typedef.hpp0000644000176200001440000000220713766554456026747 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_MODEL_TYPEDEF_HPP #define STAN_LANG_GENERATOR_GENERATE_MODEL_TYPEDEF_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate reusable typedef of stan_model for * specified model name writing to the specified stream along with * a factory method `new_model()` to create a reference to a base model. * * @param model_name name of model * @param o stream for generating */ void generate_model_typedef(const std::string& model_name, std::ostream& o) { o << "typedef " << model_name << "_namespace::" << model_name << " stan_model;" << EOL2; o << "#ifndef USING_R" << EOL2; o << "stan::model::model_base& new_model(" << EOL << " stan::io::var_context& data_context," << EOL << " unsigned int seed," << EOL << " std::ostream* msg_stream) {" << EOL << " stan_model* m = new stan_model(data_context, seed, msg_stream);" << EOL << " return *m;" << EOL << "}" << EOL2; o << "#endif" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_statements.hpp0000644000176200001440000000142613766554456026320 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_STATEMENTS_HPP #define STAN_LANG_GENERATOR_GENERATE_STATEMENTS_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the set of statements in a program block with * the specified indentation level on the specified stream. * * @param[in] statements vector of statements * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_statements(const std::vector statements, int indent, std::ostream& o) { for (size_t i = 0; i < statements.size(); ++i) generate_statement(statements[i], indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_fun_inst_templ_params.hpp0000644000176200001440000000362113766554456030521 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_TEMPLATE_PARAMETERS_HPP // NOLINT #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATION_TEMPLATE_PARAMETERS_HPP // NOLINT #include #include #include #include #include namespace stan { namespace lang { /** * Generate the concrete template parameters for function instantiation. * * @param[in] fun function declaration * @param[in] is_rng true if function is a random number generator * @param[in] is_lp true if function accesses log density * accumulator * @param[in] is_log true if function is a probability function * @param[in] rng_class class of the RNG being used (required by xxx_rng * functions) * @param[in] out stream for generating */ void generate_function_instantiation_template_parameters( const function_decl_def& fun, bool is_rng, bool is_lp, bool is_log, const std::string& rng_class, std::ostream& out) { std::vector type_params; type_params.reserve(fun.arg_decls_.size()); if (is_log) { std::string propto_value = "false"; type_params.push_back(propto_value); } for (size_t i = 0; i < fun.arg_decls_.size(); ++i) { // no template parameter for int.innermost_type()d args if (!fun.arg_decls_[i].bare_type().innermost_type().is_int_type()) { type_params.push_back("double"); } } if (is_rng) { type_params.push_back(rng_class); } else if (is_lp) { type_params.push_back("double"); // the trailing space after '>' is necessary to compile type_params.push_back("stan::math::accumulator "); } if (!type_params.empty()) { out << "<"; for (size_t param_i = 0; param_i < type_params.size(); ++param_i) { if (param_i > 0) out << ", "; out << type_params[param_i]; } out << ">"; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_globals.hpp0000644000176200001440000000070713766554456025555 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_GLOBALS_HPP #define STAN_LANG_GENERATOR_GENERATE_GLOBALS_HPP #include #include namespace stan { namespace lang { /** * Generate the global variables to the specified stream. * * @param[in] o stream for generating */ void generate_globals(std::ostream& o) { o << "static int current_statement_begin__;" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_inline_return_type.hpp0000644000176200001440000000220213766554456031745 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_INLINE_RETURN_TYPE_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_INLINE_RETURN_TYPE_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the return type for the specified function declaration * in the context of the specified scalar type at the specified * indentation level on the specified stream. * * @param[in] fun function declaration * @param[in] scalar_t_name string version of scalar type in * context * @param[in] indent indentation level * @param[in,out] out stream for generating */ void generate_function_inline_return_type(const function_decl_def& fun, const std::string& scalar_t_name, int indent, std::ostream& out) { generate_indent(indent, out); generate_bare_type(fun.return_type_, scalar_t_name, out); out << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_functor_arguments.hpp0000644000176200001440000000250413766554456027674 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTOR_ARGUMENTS_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTOR_ARGUMENTS_HPP #include #include namespace stan { namespace lang { /** * Generate the arguments for the functor for the specified * function declaration, with flags indicating whether it is a * random number generator, accesses the log density accumulator, * or is a probability function, writing to the specified stream. * * @param[in] fun function declaration * @param[in] is_rng true if function is a random number generator * @param[in] is_lp true if function acceses log density * accumulator * @param[in] is_log true if function is log probability function * @param[in,out] o stream for generating */ void generate_functor_arguments(const function_decl_def& fun, bool is_rng, bool is_lp, bool is_log, std::ostream& o) { o << "("; for (size_t i = 0; i < fun.arg_decls_.size(); ++i) { if (i > 0) o << ", "; o << fun.arg_decls_[i].name(); } if ((is_rng || is_lp) && fun.arg_decls_.size() > 0) o << ", "; if (is_rng) o << "base_rng__"; else if (is_lp) o << "lp__, lp_accum__"; if (is_rng || is_lp || fun.arg_decls_.size() > 0) o << ", "; o << "pstream__"; o << ")"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_body.hpp0000644000176200001440000000341613766554456026774 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_BODY_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_BODY_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the body of the specified function, with the specified * local scalar type, writing to the specified stream. * * @param[in] fun function declaration * @param[in] scalar_t_name name of type to use for scalars in the * function body * @param[in,out] o stream for generating */ void generate_function_body(const function_decl_def& fun, const std::string& scalar_t_name, std::ostream& o) { if (fun.body_.is_no_op_statement()) { o << ";" << EOL; return; } o << " {" << EOL; o << INDENT << "typedef " << scalar_t_name << " local_scalar_t__;" << EOL; o << INDENT << "typedef " << (fun.return_type_.innermost_type().is_int_type() ? "int" : "local_scalar_t__") << " fun_return_scalar_t__;" << EOL; o << INDENT << "const static bool propto__ = true;" << EOL << INDENT << "(void) propto__;" << EOL; // use this dummy for inits o << INDENT2 << "local_scalar_t__ " << "DUMMY_VAR__(std::numeric_limits::quiet_NaN());" << EOL; o << INDENT2 << "(void) DUMMY_VAR__; // suppress unused var warning" << EOL2; o << INDENT << "int current_statement_begin__ = -1;" << EOL; generate_try(1, o); generate_statement(fun.body_, 2, o); generate_catch_throw_located(1, o); o << "}" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_constructor.hpp0000644000176200001440000001314113766554456026513 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_CONSTRUCTOR_HPP #define STAN_LANG_GENERATOR_GENERATE_CONSTRUCTOR_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the constructor method initial boilerplate. * * @param[in] model_name name of model for class name * @param[in,out] o stream for generating */ void generate_method_begin(const std::string& model_name, std::ostream& o) { // constructor without seed or template parameter o << INDENT << model_name << "(stan::io::var_context& context__," << EOL; o << INDENT << " std::ostream* pstream__ = 0)" << EOL; o << INDENT2 << ": model_base_crtp(0) {" << EOL; o << INDENT2 << "ctor_body(context__, 0, pstream__);" << EOL; o << INDENT << "}" << EOL2; // constructor with specified seed o << INDENT << model_name << "(stan::io::var_context& context__," << EOL; o << INDENT << " unsigned int random_seed__," << EOL; o << INDENT << " std::ostream* pstream__ = 0)" << EOL; o << INDENT2 << ": model_base_crtp(0) {" << EOL; o << INDENT2 << "ctor_body(context__, random_seed__, pstream__);" << EOL; o << INDENT << "}" << EOL2; // body of constructor now in function o << INDENT << "void ctor_body(stan::io::var_context& context__," << EOL; o << INDENT << " unsigned int random_seed__," << EOL; o << INDENT << " std::ostream* pstream__) {" << EOL; o << INDENT2 << "typedef double local_scalar_t__;" << EOL2; o << INDENT2 << "boost::ecuyer1988 base_rng__ =" << EOL; o << INDENT2 << " stan::services::util::create_rng(random_seed__, 0);" << EOL; o << INDENT2 << "(void) base_rng__; // suppress unused var warning" << EOL2; o << INDENT2 << "current_statement_begin__ = -1;" << EOL2; o << INDENT2 << "static const char* function__ = \"" << model_name << "_namespace::" << model_name << "\";" << EOL; generate_void_statement("function__", 2, o); o << INDENT2 << "size_t pos__;" << EOL; generate_void_statement("pos__", 2, o); o << INDENT2 << "std::vector vals_i__;" << EOL; o << INDENT2 << "std::vector vals_r__;" << EOL; o << INDENT2 << "local_scalar_t__ DUMMY_VAR__" << "(std::numeric_limits::quiet_NaN());" << EOL; o << INDENT2 << "(void) DUMMY_VAR__; // suppress unused var warning" << EOL2; } /** * Generate the constructors for the specified program with the * specified model name to the specified stream. * * @param[in] prog program from which to generate * @param[in] model_name name of model for class name * @param[in,out] o stream for generating */ void generate_constructor(const program& prog, const std::string& model_name, std::ostream& o) { generate_method_begin(model_name, o); generate_try(2, o); generate_comment("initialize data block variables from context__", 3, o); // todo: bundle into single function for (size_t i = 0; i < prog.data_decl_.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.data_decl_[i].begin_line_ << ";" << EOL; generate_validate_var_dims(prog.data_decl_[i], 3, o); generate_validate_context_size(prog.data_decl_[i], "data initialization", 3, o); generate_data_var_ctor(prog.data_decl_[i], 3, o); generate_data_var_init(prog.data_decl_[i], 3, o); generate_validate_var_decl(prog.data_decl_[i], 3, o); o << EOL; } o << EOL; generate_comment("initialize transformed data variables", 3, o); // todo: bundle into single function for (size_t i = 0; i < prog.derived_data_decl_.first.size(); ++i) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.derived_data_decl_.first[i].begin_line_ << ";" << EOL; generate_validate_var_dims(prog.derived_data_decl_.first[i], 3, o); generate_data_var_ctor(prog.derived_data_decl_.first[i], 3, o); generate_var_fill_define(prog.derived_data_decl_.first[i], 3, o); o << EOL; } generate_comment("execute transformed data statements", 3, o); generate_statements(prog.derived_data_decl_.second, 3, o); o << EOL; generate_comment("validate transformed data", 3, o); // todo: bundle into single function for (size_t i = 0; i < prog.derived_data_decl_.first.size(); ++i) { if (prog.derived_data_decl_.first[i] .type() .innermost_type() .is_constrained()) { generate_indent(3, o); o << "current_statement_begin__ = " << prog.derived_data_decl_.first[i].begin_line_ << ";" << EOL; generate_validate_var_decl(prog.derived_data_decl_.first[i], 3, o); o << EOL; } } o << EOL; generate_comment("validate, set parameter ranges", 3, o); generate_set_param_ranges(prog.parameter_decl_, 3, o); generate_catch_throw_located(2, o); o << INDENT << "}" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_begin_param_elements_loop.hpp0000644000176200001440000000613613766554456030665 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_BEGIN_PARAM_ELEMENTS_LOOP_HPP #define STAN_LANG_GENERATOR_WRITE_BEGIN_PARAM_ELEMENTS_LOOP_HPP #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generates unconstrained parameter element names in column-major order, * e.g., order for 3-d array of matrices: col, row, d3, d2, d1 * Generated code consists of zero of more for loops, one per dimension, * with the specified indentation level writing to the specified stream. * If specified, declare named size_t variable for each dimension * which avoids re-evaluation of size expression on each iteration. * * @param[in] var_decl variable declaration * @param[in] declare_size_vars if true, generate size_t var decls * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_begin_param_elements_loop(const block_var_decl& var_decl, bool declare_size_vars, int indent, std::ostream& o) { std::string name(var_decl.name()); expression arg1(var_decl.type().innermost_type().arg1()); expression arg2(var_decl.type().innermost_type().arg2()); if (var_decl.type().innermost_type().is_specialized()) { // num dims for specialized matrices less than N*M arg1 = var_decl.type().innermost_type().params_total(); arg2 = expression(nil()); } // get values for loop bounds, generate loop bound declarations std::vector ar_var_dims = var_decl.type().array_lens(); if (!is_nil(arg2)) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_j_2_max__ = "; generate_expression(arg2, NOT_USER_FACING, o); o << ";" << EOL; } if (!is_nil(arg1)) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_j_1_max__ = "; generate_expression(arg1, NOT_USER_FACING, o); o << ";" << EOL; } for (size_t i = 0; i < ar_var_dims.size(); ++i) { generate_indent(indent, o); if (declare_size_vars) o << "size_t "; o << name << "_k_" << i << "_max__ = "; generate_expression(ar_var_dims[i], NOT_USER_FACING, o); o << ";" << EOL; } // nested for stmts open, row, col indexes if (!is_nil(arg2)) { generate_indent(indent++, o); o << "for (size_t j_2__ = 0; " << "j_2__ < " << name << "_j_2_max__;" << " ++j_2__) {" << EOL; } if (!is_nil(arg1)) { generate_indent(indent++, o); o << "for (size_t j_1__ = 0; " << "j_1__ < " << name << "_j_1_max__;" << " ++j_1__) {" << EOL; } for (size_t i = ar_var_dims.size(); i > 0; --i) { int idx = i - 1; // size == N, indexes run from 0 .. N - 1 generate_indent(indent++, o); o << "for (size_t k_" << idx << "__ = 0;" << " k_" << idx << "__ < " << name << "_k_" << idx << "_max__;" << " ++k_" << idx << "__) {" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_validate_var_dims.hpp0000644000176200001440000000310113766554456027576 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VALIDATE_VAR_DIMS_HPP #define STAN_LANG_GENERATOR_GENERATE_VALIDATE_VAR_DIMS_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate code to validate variable sizes for array dimensions * and vector/matrix number of rows, columns to the specified stream * at the specified level of indentation. * * @param[in] var_decl variable declaration * @param[in] indent indentation level * @param[in,out] o stream for generating */ template void generate_validate_var_dims(const T& var_decl, int indent, std::ostream& o) { std::string name(var_decl.name()); expression arg1 = var_decl.type().innermost_type().arg1(); expression arg2 = var_decl.type().innermost_type().arg2(); std::vector ar_var_dims = var_decl.type().array_lens(); if (!is_nil(arg1)) generate_validate_nonnegative(name, arg1, indent, o); if (!is_nil(arg2)) generate_validate_nonnegative(name, arg2, indent, o); for (size_t i = 0; i < ar_var_dims.size(); ++i) generate_validate_nonnegative(name, ar_var_dims[i], indent, o); } template void generate_validate_var_dims(const block_var_decl& var_decl, int indent, std::ostream& o); template void generate_validate_var_dims(const local_var_decl& var_decl, int indent, std::ostream& o); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_usings_standalone_functions.hpp0000644000176200001440000000146713766554456031746 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_USINGS_STANDALONE_FUNCTIONS_HPP #define STAN_LANG_GENERATOR_GENERATE_USINGS_STANDALONE_FUNCTIONS_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate the using statements for a Stan standalone functions file. * * @param[in,out] o stream for generating */ void generate_usings_standalone_functions(std::ostream& o) { generate_using("std::istream", o); generate_using("std::string", o); generate_using("std::stringstream", o); generate_using("std::vector", o); generate_using_namespace("stan::math", o); o << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_printable.hpp0000644000176200001440000000106613766554456026111 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PRINTABLE_HPP #define STAN_LANG_GENERATOR_GENERATE_PRINTABLE_HPP #include #include #include namespace stan { namespace lang { /** * Generate the specified printable object to the specified * stream. * * @param p object to print * @param o stream for printing */ void generate_printable(const printable& p, std::ostream& o) { printable_visgen vis(o); boost::apply_visitor(vis, p.printable_); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_arg_decl.hpp0000644000176200001440000000221713766554456025670 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_ARG_DECL_HPP #define STAN_LANG_GENERATOR_GENERATE_ARG_DECL_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate the argument declaration for a function with flags * indicating whether to generate a const qualifer * and whether to make the variable a reference, for the specified * declaration and scalar type name from context, writing to the * specified stream. * * @param[in] gen_const true if declaration is for const * @param[in] gen_ref true if declaration is for reference * @param[in] decl argument declaration * @param[in] scalar_t_name string representing context scalar * type * @param[in,out] o stream for writing */ void generate_arg_decl(bool gen_const, bool gen_ref, const var_decl& decl, const std::string& scalar_t_name, std::ostream& o) { if (gen_const) o << "const "; generate_bare_type(decl.bare_type(), scalar_t_name, o); if (gen_ref) o << "&"; o << " " << decl.name(); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_real_var_type.hpp0000644000176200001440000000141113766554456026757 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_REAL_VAR_TYPE_HPP #define STAN_LANG_GENERATOR_GENERATE_REAL_VAR_TYPE_HPP #include #include namespace stan { namespace lang { /** * Generate correct C++ type for expressions which contain a Stan * real variable according to scope in which * expression is used and expression contents. * * @param[in] var_scope expression origin block * @param[in] has_var does expression contains a variable? * @param[in,out] o generated typename */ void generate_real_var_type(const scope& var_scope, bool has_var, std::ostream& o) { if (var_scope.fun() || has_var) o << "local_scalar_t__"; else o << "double"; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_param_var.hpp0000644000176200001440000000530213766554456026076 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PARAM_VAR_HPP #define STAN_LANG_GENERATOR_GENERATE_PARAM_VAR_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate dynamic initializations for container parameter variables * or void statement for scalar parameters. * * @param[in] var_decl parameter block variable * @param[in] gen_decl_stmt if true, generate variable declaration * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_param_var(const block_var_decl &var_decl, bool gen_decl_stmt, int indent, std::ostream &o) { // setup - name, type, and var shape std::string var_name(var_decl.name()); std::vector dims(var_decl.type().array_lens()); block_var_type btype = var_decl.type().innermost_type(); std::string constrain_str = write_constraints_fn(btype, "constrain"); // lp__ is single or last arg to write_constraints_fn std::string lp_arg("lp__)"); if (btype.has_def_bounds() || btype.has_def_offset_multiplier() || !btype.bare_type().is_double_type()) lp_arg = ", lp__)"; // declare if (gen_decl_stmt) { generate_indent(indent, o); generate_bare_type(var_decl.type().bare_type(), "local_scalar_t__", o); o << " " << var_name << ";" << EOL; } // init write_nested_resize_loop_begin(var_name, dims, indent, o); // innermost loop stmt: read in param, apply jacobian generate_indent(indent + dims.size(), o); o << "if (jacobian__)" << EOL; generate_indent(indent + dims.size() + 1, o); if (dims.size() > 0) { o << var_name; write_resize_var_idx(dims.size(), o); o << ".push_back(in__." << constrain_str << lp_arg << ");" << EOL; } else { o << var_name << " = in__." << constrain_str << lp_arg << ";" << EOL; } generate_indent(indent + dims.size(), o); o << "else" << EOL; generate_indent(indent + dims.size() + 1, o); if (dims.size() > 0) { o << var_name; write_resize_var_idx(dims.size(), o); o << ".push_back(in__." << constrain_str << "));" << EOL; } else { o << var_name << " = in__." << constrain_str << ");" << EOL; } write_end_loop(dims.size(), indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/write_end_loop.hpp0000644000176200001440000000136213766554456025267 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_WRITE_END_LOOP_HPP #define STAN_LANG_GENERATOR_WRITE_END_LOOP_HPP #include #include #include namespace stan { namespace lang { /** * Generate the close `}` for a sequence of zero or more nested for loops * with the specified indentation level writing to the specified stream. * * @param[in] dims_size dimension sizes * @param[in] indent indentation level * @param[in,out] o stream for generating */ void write_end_loop(size_t dims_size, int indent, std::ostream& o) { for (size_t i = dims_size; i > 0; --i) { generate_indent(indent + i - 1, o); o << "}" << EOL; } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_instantiations.hpp0000644000176200001440000000173513766554456031110 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATONS_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_INSTANTIATONS_HPP #include #include #include #include #include namespace stan { namespace lang { /** * Generate instantiations of templated functions with non-variable * parametersfor standalone generation of functions. * * @param[in] funs sequence of function declarations and * definitions * @param[in] namespaces vector of strings used to generate the * namespaces generated code is nested in. * @param[in,out] o stream for generating */ void generate_function_instantiations( const std::vector& funs, const std::vector& namespaces, std::ostream& o) { for (size_t i = 0; i < funs.size(); ++i) { generate_function_instantiation(funs[i], namespaces, o); } } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_data_var_init.hpp0000644000176200001440000000415413766554456026736 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_DATA_VAR_INIT_HPP #define STAN_LANG_GENERATOR_GENERATE_DATA_VAR_INIT_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate initializations for data block variables by reading * dump format data from constructor variable context. * In dump format data, arrays are indexed in last-index major fashion, * which corresponds to column-major order for matrices * represented as two-dimensional arrays. As a result, the first * indices change fastest. Therefore loops must be constructed: * (col) (row) (array-dim-N) ... (array-dim-1) * * @param[in] var_decl block variable declaration * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_data_var_init(const block_var_decl& var_decl, int indent, std::ostream& o) { // setup - name, type, and var shape std::string var_name(var_decl.name()); block_var_type vtype = var_decl.type(); block_var_type el_type = var_decl.type().innermost_type(); std::string vals("vals_r"); if (vtype.bare_type().innermost_type().is_int_type()) vals = "vals_i"; generate_indent(indent, o); o << vals << "__ = context__." << vals << "(\"" << var_name << "\");" << EOL; generate_indent(indent, o); o << "pos__ = 0;" << EOL; write_begin_all_dims_col_maj_loop(var_decl, true, indent, o); // innermost loop stmt: update pos__ generate_indent(indent + vtype.num_dims(), o); o << var_name; write_var_idx_all_dims(vtype.array_dims(), vtype.num_dims() - vtype.array_dims(), o); o << " = " << vals << "__[pos__++];" << EOL; write_end_loop(vtype.num_dims(), indent, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/constants.hpp0000644000176200001440000000157513766554456024300 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_CONSTANTS_HPP #define STAN_LANG_GENERATOR_CONSTANTS_HPP #include #include #include namespace stan { namespace lang { /** * End-of-line marker. */ const std::string EOL("\n"); /** * Sequence of two end-of-line markers. */ const std::string EOL2("\n\n"); /** * Single indentation. */ const std::string INDENT(" "); /** * Double indentation. */ const std::string INDENT2(" "); /** * Triple indentation. */ const std::string INDENT3(" "); /** * Size zero vector of expressions. */ const std::vector EMPTY_EXP_VECTOR(0); /** * Flag for generating expressions when code is user facing. */ const bool USER_FACING(true); /** * Flag for generating expressions when code is not user facing. */ const bool NOT_USER_FACING(false); } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_private_decl.hpp0000644000176200001440000000075713766554456026600 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_PRIVATE_DECL_HPP #define STAN_LANG_GENERATOR_GENERATE_PRIVATE_DECL_HPP #include #include #include namespace stan { namespace lang { /** * Generate the private declaration scope for a class to the * specified stream. * * @param[in,out] o stream for generating */ void generate_private_decl(std::ostream& o) { o << "private:" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_indexed_expr.hpp0000644000176200001440000000523313766554456026607 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_INDEXED_EXPR_HPP #define STAN_LANG_GENERATOR_GENERATE_INDEXED_EXPR_HPP #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the specified expression indexed with the specified * indices with the specified base type of expression being * indexed, number of dimensions, and a flag indicating whether * the generation is for user output or C++ compilation. * Depending on the base type, two layers of parens may be written * in the underlying code. * * @tparam isLHS true if indexed expression appears on left-hand * side of an assignment * @param[in] expr string for expression * @param[in] indexes indexes for expression * @param[in] base_type base type of expression * @param[in] user_facing true if expression might be reported to user * @param[in,out] o stream for generating */ template void generate_indexed_expr(const std::string& expr, const std::vector& indexes, bare_expr_type base_type, bool user_facing, std::ostream& o) { if (user_facing) { generate_indexed_expr_user(expr, indexes, o); return; } if (indexes.size() == 0) { o << expr; return; } if (base_type.innermost_type().is_matrix_type() && base_type.num_dims() == indexes.size()) { for (size_t n = 0; n < indexes.size() - 1; ++n) o << (isLHS ? "get_base1_lhs(" : "get_base1("); o << expr; for (size_t n = 0; n < indexes.size() - 2; ++n) { o << ", "; generate_expression(indexes[n], user_facing, o); o << ", "; generate_quoted_string(expr, o); o << ", " << (n + 1) << ')'; } o << ", "; generate_expression(indexes[indexes.size() - 2U], user_facing, o); o << ", "; generate_expression(indexes[indexes.size() - 1U], user_facing, o); o << ", "; generate_quoted_string(expr, o); o << ", " << (indexes.size() - 1U) << ')'; return; } for (size_t n = 0; n < indexes.size(); ++n) o << (isLHS ? "get_base1_lhs(" : "get_base1("); o << expr; for (size_t n = 0; n < indexes.size() - 1; ++n) { o << ", "; generate_expression(indexes[n], user_facing, o); o << ", "; generate_quoted_string(expr, o); o << ", " << (n + 1) << ')'; } o << ", "; generate_expression(indexes[indexes.size() - 1U], user_facing, o); o << ", "; generate_quoted_string(expr, o); o << ", " << (indexes.size()) << ')'; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_indexed_expr_user.hpp0000644000176200001440000000216213766554456027643 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_INDEXED_EXPR_USER_HPP #define STAN_LANG_GENERATOR_GENERATE_INDEXED_EXPR_USER_HPP #include #include #include #include namespace stan { namespace lang { void generate_expression(const expression& e, bool user_facing, std::ostream& o); /** * Generate an expression with indices, writing brackets around * indices and commas in between as necessary. If no indices are * presents, no brackets will be written. * * @param[in] expr expression for indexing * @param[in] indexes sequence of indexes * @param[in,out] o stream for writing */ void generate_indexed_expr_user(const std::string& expr, const std::vector indexes, std::ostream& o) { static const bool user_facing = true; o << expr; if (indexes.size() == 0) return; o << '['; for (size_t i = 0; i < indexes.size(); ++i) { if (i > 0) o << ", "; generate_expression(indexes[i], user_facing, o); } o << ']'; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_quoted_string.hpp0000644000176200001440000000131713766554456027017 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_QUOTED_STRING_HPP #define STAN_LANG_GENERATOR_GENERATE_QUOTED_STRING_HPP #include #include namespace stan { namespace lang { /** * Print the specified string to the specified output stream, * wrapping in double quotes (") and inserting a backslash to * escape double quotes, single quotes, and backslashes. * * @param[in] s String to output * @param[in,out] o Output stream */ void generate_quoted_string(const std::string& s, std::ostream& o) { o << '"'; for (size_t i = 0; i < s.size(); ++i) { if (s[i] == '"' || s[i] == '\\' || s[i] == '\'') o << '\\'; o << s[i]; } o << '"'; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_function_functor.hpp0000644000176200001440000000360613766554456027520 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_FUNCTION_FUNCTOR_HPP #define STAN_LANG_GENERATOR_GENERATE_FUNCTION_FUNCTOR_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the functor to accompnay a function with the specified * declaration, writing to the specified stream. * * @param[in] fun function declaration * @param[in,out] o stream for generating */ void generate_function_functor(const function_decl_def& fun, std::ostream& o) { if (fun.body_.is_no_op_statement()) return; // forward declaration, so no functor needed bool is_rng = ends_with("_rng", fun.name_); bool is_lp = ends_with("_lp", fun.name_); bool is_pf = ends_with("_log", fun.name_) || ends_with("_lpdf", fun.name_) || ends_with("_lpmf", fun.name_); std::string scalar_t_name = fun_scalar_type(fun, is_lp); o << EOL << "struct "; generate_function_name(fun, o); o << "_functor__ {" << EOL; o << INDENT; generate_function_template_parameters(fun, is_rng, is_lp, is_pf, o); o << INDENT; generate_function_inline_return_type(fun, scalar_t_name, 1, o); o << INDENT << "operator()"; generate_function_arguments(fun, is_rng, is_lp, is_pf, o); o << " const {" << EOL; o << INDENT2 << "return "; generate_function_name(fun, o); generate_functor_arguments(fun, is_rng, is_lp, is_pf, o); o << ";" << EOL; o << INDENT << "}" << EOL; o << "};" << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_standalone_functions.hpp0000644000176200001440000000370613766554456030354 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_STANDALONE_FUNCTIONS_HPP #define STAN_LANG_GENERATOR_GENERATE_STANDALONE_FUNCTIONS_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Generate the C++ code for standalone functions, generating it * in the namespace provided, * writing to the specified stream. * * @param[in] prog program from which to generate * @param[in] namespaces namespace to generate the functions in * @param[in] history I/O include history for text underlying * program * @param[in,out] o stream for generating */ void generate_standalone_functions( const program& prog, const std::vector& namespaces, const std::vector& history, std::ostream& o) { generate_version_comment(o); generate_include("stan/model/standalone_functions_header.hpp", o); o << EOL; // generate namespace starts for (size_t namespace_i = 0; namespace_i < namespaces.size(); ++namespace_i) { o << "namespace " << namespaces[namespace_i] << " { "; } o << EOL; generate_usings_standalone_functions(o); generate_typedefs(o); generate_program_reader_fun(history, o); generate_functions(prog.function_decl_defs_, o); // generate namespace ends for (size_t namespace_i = 0; namespace_i < namespaces.size(); ++namespace_i) { o << " } "; } o << EOL; generate_function_instantiations(prog.function_decl_defs_, namespaces, o); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_version_comment.hpp0000644000176200001440000000124213766554456027334 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VERSION_COMMENT_HPP #define STAN_LANG_GENERATOR_GENERATE_VERSION_COMMENT_HPP #include #include #include #include namespace stan { namespace lang { /** * Generate a comment indicating which version of Stan generated * the model code to the specified stream. * * @param[in,out] o stream for generating */ void generate_version_comment(std::ostream& o) { o << "// Code generated by Stan version " << stan::MAJOR_VERSION << "." << stan::MINOR_VERSION << "." << stan::PATCH_VERSION << EOL2; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator/generate_validate_context_size.hpp0000644000176200001440000000405113766554456030515 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_GENERATE_VALIDATE_CONTEXT_SIZE_HPP #define STAN_LANG_GENERATOR_GENERATE_VALIDATE_CONTEXT_SIZE_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace lang { /* * Generates code to validate data variables to make sure they * only use positive dimension sizes and that the var_context * out of which they are read have matching dimension sizes. * * @param[in] var_decl block variable declaration * @param[in] stage id string for error msgs * @param[in] indent indentation level * @param[in,out] o stream for generating */ void generate_validate_context_size(const block_var_decl& var_decl, const std::string& stage, size_t indent, std::ostream& o) { std::string var_name(var_decl.name()); block_var_type btype = var_decl.type().innermost_type(); std::vector array_dim_sizes = var_decl.type().array_lens(); expression arg1 = btype.arg1(); expression arg2 = btype.arg2(); // check declared sizes against actual sizes generate_indent(indent, o); o << "context__.validate_dims(" << '"' << stage << '"' << ", " << '"' << var_name << '"' << ", " << '"' << get_typedef_var_type(btype.bare_type()) << '"' << ", " << "context__.to_vec("; for (size_t i = 0; i < array_dim_sizes.size(); ++i) { if (i > 0) o << ","; generate_expression(array_dim_sizes[i].expr_, NOT_USER_FACING, o); } if (!is_nil(arg1)) { if (array_dim_sizes.size() > 0) o << ","; generate_expression(arg1.expr_, NOT_USER_FACING, o); if (!is_nil(arg2)) { o << ","; generate_expression(arg2.expr_, NOT_USER_FACING, o); } } o << "));" << EOL; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/generator.hpp0000644000176200001440000001417013766554456022257 0ustar liggesusers#ifndef STAN_LANG_GENERATOR_HPP #define STAN_LANG_GENERATOR_HPP // helper, utility functions #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include // visitor classes for generation #include #include #include #include #include #include #include // generation functions, starts from generate_cpp #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/src/stan/lang/compiler.hpp0000644000176200001440000000340013766554456022075 0ustar liggesusers#ifndef STAN_LANG_COMPILER_HPP #define STAN_LANG_COMPILER_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Read a Stan model specification from the specified input, parse * it, and write the C++ code for it to the specified output, * allowing undefined function declarations if the flag is set to * true and searching the specified include path for included * files. * * @param msgs Output stream for warning messages * @param in Stan model specification * @param out C++ code output stream * @param name Name of model class * @param allow_undefined true if permits undefined functions * @param filename name of file or other source from which input * stream was derived * @param include_paths array of paths to search for included files * @return false if code could not be generated due * to syntax error in the Stan model; true * otherwise. */ bool compile(std::ostream* msgs, std::istream& in, std::ostream& out, const std::string& name, const bool allow_undefined = false, const std::string& filename = "unknown file name", const std::vector& include_paths = std::vector()) { io::program_reader reader(in, filename, include_paths); std::string s = reader.program(); std::stringstream ss(s); program prog; bool parse_succeeded = parse(msgs, ss, name, reader, prog, allow_undefined); if (!parse_succeeded) return false; generate_cpp(prog, name, reader.history(), out); return true; } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/rethrow_located.hpp0000644000176200001440000001165113766554456023457 0ustar liggesusers#ifndef STAN_LANG_RETHROW_LOCATED_HPP #define STAN_LANG_RETHROW_LOCATED_HPP #include #include #include #include #include #include #include #include namespace stan { namespace lang { /** * Returns true if the specified exception can be dynamically * cast to the template parameter type. * * @tparam E Type to test. * @param[in] e Exception to test. * @return true if exception can be dynamically cast to type. */ template bool is_type(const std::exception& e) { try { (void)dynamic_cast(e); return true; } catch (...) { return false; } } /** * Structure for a located exception for standard library * exception types that have no what-based constructors. * * @param E Type of original exception. */ template struct located_exception : public E { std::string what_; /** * Construct a located exception with no what message. */ located_exception() throw() : what_("") {} /** * Construct a located exception with the specified what * message and specified original type. * * @param[in] what Original what message. * @param[in] orig_type Original type. */ located_exception(const std::string& what, const std::string& orig_type) throw() : what_(what + " [origin: " + orig_type + "]") {} /** * Destroy a located exception. */ ~located_exception() throw() {} /** * Return the character sequence describing the exception, * including the original waht message and original type if * constructed with such. * * @return Description of exception. */ const char* what() const throw() { return what_.c_str(); } }; /** * Rethrow an exception of type specified by the dynamic type of * the specified exception, adding the specified source file location to * the specified exception's message. * * @param[in] e original exception * @param[in] location string representing the source file location */ inline void rethrow_located(const std::exception& e, std::string location) { using std::bad_alloc; // -> exception using std::bad_cast; // -> exception using std::bad_exception; // -> exception using std::bad_typeid; // -> exception using std::domain_error; // -> logic_error using std::exception; using std::invalid_argument; // -> logic_error using std::ios_base; // ::failure -> exception using std::length_error; // -> logic_error using std::logic_error; // -> exception using std::out_of_range; // -> logic_error using std::overflow_error; // -> runtime_error using std::range_error; // -> runtime_error using std::runtime_error; // -> exception using std::underflow_error; // -> runtime_error // create message with trace of includes and location of error std::stringstream o; o << "Exception: " << e.what() << location; std::string s = o.str(); if (is_type(e)) throw located_exception(s, "bad_alloc"); if (is_type(e)) throw located_exception(s, "bad_cast"); if (is_type(e)) throw located_exception(s, "bad_exception"); if (is_type(e)) throw located_exception(s, "bad_typeid"); if (is_type(e)) throw domain_error(s); if (is_type(e)) throw invalid_argument(s); if (is_type(e)) throw length_error(s); if (is_type(e)) throw out_of_range(s); if (is_type(e)) throw logic_error(s); if (is_type(e)) throw overflow_error(s); if (is_type(e)) throw range_error(s); if (is_type(e)) throw underflow_error(s); if (is_type(e)) throw runtime_error(s); throw located_exception(s, "unknown original type"); } /** * Rethrow an exception of type specified by the dynamic type of * the specified exception, adding the specified line number to * the specified exception's message. * * @param[in] e original exception * @param[in] line line number in Stan source program where * exception originated * @param[in] reader trace of how program was included from files */ inline void rethrow_located(const std::exception& e, int line, const io::program_reader& reader = stan::io::program_reader()) { std::stringstream o; if (line < 1) { o << " Found before start of program."; } else { io::program_reader::trace_t tr = reader.trace(line); o << " (in '" << tr[tr.size() - 1].first << "' at line " << tr[tr.size() - 1].second; for (int i = tr.size() - 1; --i >= 0;) o << "; included from '" << tr[i].first << "' at line " << tr[i].second; o << ")" << std::endl; } std::string s = o.str(); rethrow_located(e, s); } } // namespace lang } // namespace stan #endif StanHeaders/inst/include/src/stan/lang/function_signatures.h0000644000176200001440000030256113766554456024026 0ustar liggesusers// included from constructor for function_signatures() in src/stan/lang/ast.hpp std::vector bare_types; bare_types.push_back(int_type()); bare_types.push_back(double_type()); bare_types.push_back(vector_type()); bare_types.push_back(row_vector_type()); bare_types.push_back(matrix_type()); std::vector vector_types; vector_types.push_back(double_type()); // scalar vector_types.push_back(bare_array_type(double_type(), 1)); // std vector vector_types.push_back(vector_type()); // Eigen vector vector_types.push_back(row_vector_type()); // Eigen row vector std::vector int_vector_types; int_vector_types.push_back(int_type()); // scalar int_vector_types.push_back(bare_array_type(int_type())); // std vector std::vector primitive_types; primitive_types.push_back(int_type()); primitive_types.push_back(double_type()); std::vector all_vector_types; all_vector_types.push_back(bare_expr_type(double_type())); // scalar all_vector_types.push_back(bare_expr_type(bare_array_type(double_type()))); // std vector all_vector_types.push_back(bare_expr_type(vector_type())); // Eigen vector all_vector_types.push_back(bare_expr_type(row_vector_type())); // Eigen row vector all_vector_types.push_back(bare_expr_type(int_type())); // scalar all_vector_types.push_back(bare_expr_type(bare_array_type(int_type()))); // std vector add("abs", bare_expr_type(int_type()), bare_expr_type(int_type())); add("abs", bare_expr_type(double_type()), bare_expr_type(double_type())); add_unary_vectorized("acos"); add_unary_vectorized("acosh"); for (size_t i = 0; i < bare_types.size(); ++i) { add("add", bare_types[i], bare_types[i], bare_types[i]); } add("add", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("add", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(double_type())); add("add", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("add", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("add", bare_expr_type(row_vector_type()), bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("add", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); for (size_t i = 0; i < bare_types.size(); ++i) { add("add", bare_types[i], bare_types[i]); } add("add_diag", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("add_diag", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("add_diag", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(row_vector_type())); for (size_t i = 1; i < 8; ++i) { add("append_array", bare_expr_type(bare_array_type(int_type(), i)), bare_expr_type(bare_array_type(int_type(), i)), bare_expr_type(bare_array_type(int_type(), i))); add("append_array", bare_expr_type(bare_array_type(double_type(), i)), bare_expr_type(bare_array_type(double_type(), i)), bare_expr_type(bare_array_type(double_type(), i))); add("append_array", bare_expr_type(bare_array_type(vector_type(), i)), bare_expr_type(bare_array_type(vector_type(), i)), bare_expr_type(bare_array_type(vector_type(), i))); add("append_array", bare_expr_type(bare_array_type(row_vector_type(), i)), bare_expr_type(bare_array_type(row_vector_type(), i)), bare_expr_type(bare_array_type(row_vector_type(), i))); add("append_array", bare_expr_type(bare_array_type(matrix_type(), i)), bare_expr_type(bare_array_type(matrix_type(), i)), bare_expr_type(bare_array_type(matrix_type(), i))); } add_unary_vectorized("asin"); add_unary_vectorized("asinh"); add_unary_vectorized("atan"); add_binary("atan2"); add_unary_vectorized("atanh"); for (size_t i = 0; i < int_vector_types.size(); ++i) for (size_t j = 0; j < vector_types.size(); ++j) { add("bernoulli_ccdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_cdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_cdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_lccdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_lcdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); } for (const auto& t : all_vector_types) { add("bernoulli_rng", rng_return_type(t), t); } for (const auto& t : all_vector_types) { add("bernoulli_logit_rng", rng_return_type(t), t); } for (size_t i = 0; i < int_vector_types.size(); ++i) for (size_t j = 0; j < vector_types.size(); ++j) { add("bernoulli_logit_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("bernoulli_logit_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); } add("bernoulli_logit_glm_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("bernoulli_logit_glm_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("bessel_first_kind", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); add("bessel_second_kind", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); for (size_t i = 0; i < int_vector_types.size(); i++) for (size_t j = 0; j < int_vector_types.size(); j++) for (size_t k = 0; k < vector_types.size(); k++) for (size_t l = 0; l < vector_types.size(); l++) { add("beta_binomial_ccdf_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); add("beta_binomial_cdf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); add("beta_binomial_cdf_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); add("beta_binomial_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); add("beta_binomial_lccdf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); add("beta_binomial_lcdf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); add("beta_binomial_lpmf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k], vector_types[l]); } for (const auto& t : int_vector_types) { for (const auto& u : all_vector_types) { for (const auto& v : all_vector_types) { add("beta_binomial_rng", rng_return_type(t, u, v), t, u, v); } } } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("beta_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("beta_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("beta_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("beta_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("beta_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("beta_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("beta_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("beta_rng", rng_return_type(t, u), t, u); } } for (const auto& t : vector_types) { for (const auto& u : vector_types) { for (const auto& v : all_vector_types) { add("beta_proportion_ccdf_log", bare_expr_type(double_type()), t, u, v); add("beta_proportion_cdf_log", bare_expr_type(double_type()), t, u, v); add("beta_proportion_log", bare_expr_type(double_type()), t, u, v); add("beta_proportion_lccdf", bare_expr_type(double_type()), t, u, v); add("beta_proportion_lcdf", bare_expr_type(double_type()), t, u, v); add("beta_proportion_lpdf", bare_expr_type(double_type()), t, u, v); } } } for (const auto& t : vector_types) { for (const auto& u : all_vector_types) { add("beta_proportion_rng", rng_return_type(t, u), t, u); } } add("binary_log_loss", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); for (size_t i = 0; i < int_vector_types.size(); ++i) { for (size_t j = 0; j < int_vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("binomial_ccdf_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_cdf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_cdf_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_lccdf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_lcdf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_lpmf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); } } } for (const auto& t : int_vector_types) { for (const auto& u : all_vector_types) { add("binomial_rng", rng_return_type(t, u), t, u); } } add_binary("binomial_coefficient_log"); for (size_t i = 0; i < int_vector_types.size(); ++i) { for (size_t j = 0; j < int_vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("binomial_logit_log", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); add("binomial_logit_lpmf", bare_expr_type(double_type()), int_vector_types[i], int_vector_types[j], vector_types[k]); } } } add("block", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); for (size_t i = 0; i < int_vector_types.size(); ++i) { add("categorical_log", bare_expr_type(double_type()), int_vector_types[i], bare_expr_type(vector_type())); add("categorical_logit_log", bare_expr_type(double_type()), int_vector_types[i], bare_expr_type(vector_type())); add("categorical_lpmf", bare_expr_type(double_type()), int_vector_types[i], bare_expr_type(vector_type())); add("categorical_logit_lpmf", bare_expr_type(double_type()), int_vector_types[i], bare_expr_type(vector_type())); } add("categorical_rng", bare_expr_type(int_type()), bare_expr_type(vector_type())); add("categorical_logit_rng", bare_expr_type(int_type()), bare_expr_type(vector_type())); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("cauchy_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("cauchy_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("cauchy_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("cauchy_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("cauchy_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("cauchy_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("cauchy_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("cauchy_rng", rng_return_type(t, u), t, u); } } add("append_col", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("append_col", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("append_col", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("append_col", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("append_col", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("append_col", bare_expr_type(row_vector_type()), bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("append_col", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(double_type())); add_unary_vectorized("cbrt"); add_unary_vectorized("ceil"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { add("chi_square_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("chi_square_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("chi_square_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("chi_square_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("chi_square_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("chi_square_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("chi_square_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); } } for (const auto& t : all_vector_types) { add("chi_square_rng", rng_return_type(t), t); } add("cholesky_decompose", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("choose", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("col", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type())); add("cols", bare_expr_type(int_type()), bare_expr_type(vector_type())); add("cols", bare_expr_type(int_type()), bare_expr_type(row_vector_type())); add("cols", bare_expr_type(int_type()), bare_expr_type(matrix_type())); add("columns_dot_product", bare_expr_type(row_vector_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("columns_dot_product", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("columns_dot_product", bare_expr_type(row_vector_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("columns_dot_self", bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add("columns_dot_self", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("columns_dot_self", bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add_unary_vectorized("cos"); add_unary_vectorized("cosh"); add("cov_exp_quad", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("cov_exp_quad", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("cov_exp_quad", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(row_vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("cov_exp_quad", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)),bare_expr_type(double_type()), bare_expr_type(double_type())); add("cov_exp_quad", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("cov_exp_quad", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(row_vector_type(), 1)), bare_expr_type(bare_array_type(row_vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("crossprod", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("csr_matrix_times_vector", bare_expr_type(vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(vector_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type())); add("csr_to_dense_matrix", bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(vector_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), 1))); add("csr_extract_w", bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("csr_extract_v", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type())); add("csr_extract_u", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type())); add("cumulative_sum", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1))); add("cumulative_sum", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("cumulative_sum", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("determinant", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("diag_matrix", bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("diag_post_multiply", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("diag_post_multiply", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(row_vector_type())); add("diag_pre_multiply", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("diag_pre_multiply", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("diagonal", bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add_unary_vectorized("digamma"); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(int_type())); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(double_type())); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type())); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(row_vector_type())); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type())); for (size_t i = 0; i < 8; ++i) { add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), i + 1))); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(double_type(), i + 1))); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(vector_type(), i + 1))); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(row_vector_type(), i + 1))); add("dims", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(matrix_type(), i + 1))); } add("dirichlet_log", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("dirichlet_lpdf", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("dirichlet_rng", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("distance", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("distance", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("distance", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("distance", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add("divide", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("divide", bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("divide", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("divide", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(double_type())); add("divide", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("dot_product", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("dot_product", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("dot_product", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("dot_product", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add("dot_product", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1))); add("dot_self", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("dot_self", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("double_exponential_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("double_exponential_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("double_exponential_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("double_exponential_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("double_exponential_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("double_exponential_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("double_exponential_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("double_exponential_rng", rng_return_type(t, u), t, u); } } add_nullary("e"); add("eigenvalues_sym", bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("eigenvectors_sym", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("qr_Q", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("qr_R", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("qr_thin_Q", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("qr_thin_R", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("elt_divide", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("elt_divide", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("elt_divide", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("elt_divide", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("elt_divide", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(double_type())); add("elt_divide", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("elt_divide", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("elt_divide", bare_expr_type(row_vector_type()), bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("elt_divide", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("elt_multiply", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("elt_multiply", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("elt_multiply", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add_unary_vectorized("erf"); add_unary_vectorized("erfc"); add_unary_vectorized("exp"); add_unary_vectorized("exp2"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { for (size_t l = 0; l < vector_types.size(); ++l) { add("exp_mod_normal_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("exp_mod_normal_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("exp_mod_normal_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("exp_mod_normal_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("exp_mod_normal_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("exp_mod_normal_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("exp_mod_normal_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); } } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { for (const auto& v : all_vector_types) { add("exp_mod_normal_rng", rng_return_type(t, u, v), t, u, v); } } } add_unary_vectorized("expm1"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { add("exponential_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("exponential_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("exponential_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("exponential_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("exponential_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("exponential_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("exponential_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); } } for (const auto& t : all_vector_types) { add("exponential_rng", rng_return_type(t), t); } add_unary_vectorized("fabs"); add("falling_factorial", bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(int_type())); add("falling_factorial", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add_binary("fdim"); add_unary_vectorized("floor"); add_ternary("fma"); add_binary("fmax"); add_binary("fmin"); add_binary("fmod"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("frechet_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("frechet_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("frechet_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("frechet_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("frechet_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("frechet_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("frechet_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("frechet_rng", rng_return_type(t, u), t, u); } } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("gamma_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gamma_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gamma_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gamma_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gamma_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gamma_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gamma_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } add_binary("gamma_p"); add_binary("gamma_q"); for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("gamma_rng", rng_return_type(t, u), t, u); } } add("gaussian_dlm_obs_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("gaussian_dlm_obs_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("gaussian_dlm_obs_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("gaussian_dlm_obs_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add_nullary("get_lp"); // special handling in term_grammar_def add("gp_dot_prod_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type())); add("gp_dot_prod_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type())); add("gp_dot_prod_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type())); add("gp_dot_prod_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type())); add("gp_exp_quad_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exp_quad_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exp_quad_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exp_quad_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exp_quad_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_exp_quad_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_exponential_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exponential_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exponential_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exponential_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_exponential_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_exponential_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_matern52_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern52_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern52_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern52_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern52_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_matern52_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_matern32_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern32_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern32_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern32_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_matern32_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_matern32_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("gp_periodic_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_periodic_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_periodic_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("gp_periodic_cov", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("gumbel_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gumbel_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gumbel_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gumbel_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gumbel_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gumbel_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("gumbel_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("gumbel_rng", rng_return_type(t, u), t, u); } } add("head", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type())); add("head", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(int_type())); for (size_t i = 0; i < bare_types.size(); ++i) { add("head", bare_expr_type(bare_array_type(bare_types[i], 1)), bare_expr_type(bare_array_type(bare_types[i], 1)), bare_expr_type(int_type())); add("head", bare_expr_type(bare_array_type(bare_types[i], 2)), bare_expr_type(bare_array_type(bare_types[i], 2)), bare_expr_type(int_type())); add("head", bare_expr_type(bare_array_type(bare_types[i], 3)), bare_expr_type(bare_array_type(bare_types[i], 3)), bare_expr_type(int_type())); } add("hypergeometric_log", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("hypergeometric_lpmf", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("hypergeometric_rng", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add_binary("hypot"); add("if_else", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("inc_beta", bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("int_step", bare_expr_type(int_type()), bare_expr_type(double_type())); add("int_step", bare_expr_type(int_type()), bare_expr_type(int_type())); add_unary_vectorized("inv"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { add("inv_chi_square_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("inv_chi_square_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("inv_chi_square_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("inv_chi_square_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("inv_chi_square_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("inv_chi_square_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("inv_chi_square_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); } } for (const auto& t : all_vector_types) { add("inv_chi_square_rng", rng_return_type(t), t); } add_unary_vectorized("inv_cloglog"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("inv_gamma_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("inv_gamma_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("inv_gamma_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("inv_gamma_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("inv_gamma_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("inv_gamma_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("inv_gamma_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("inv_gamma_rng", rng_return_type(t, u), t, u); } } add_unary_vectorized("inv_logit"); add_unary_vectorized("inv_Phi"); add_unary_vectorized("inv_sqrt"); add_unary_vectorized("inv_square"); add("inv_wishart_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("inv_wishart_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("inv_wishart_rng", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("inverse", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("inverse_spd", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("is_inf", bare_expr_type(int_type()), bare_expr_type(double_type())); add("is_nan", bare_expr_type(int_type()), bare_expr_type(double_type())); add_binary("lbeta"); add_binary("lchoose"); add_unary_vectorized("lgamma"); add("lkj_corr_cholesky_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("lkj_corr_cholesky_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("lkj_corr_cholesky_rng", bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); add("lkj_corr_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("lkj_corr_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("lkj_corr_rng", bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); add("lkj_cov_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("lmgamma", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); add_binary("lmultiply"); add_unary_vectorized("log"); add_nullary("log10"); add_unary_vectorized("log10"); add_unary_vectorized("log1m"); add_unary_vectorized("log1m_exp"); add_unary_vectorized("log1m_inv_logit"); add_unary_vectorized("log1p"); add_unary_vectorized("log1p_exp"); add_nullary("log2"); add_unary_vectorized("log2"); add("log_determinant", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add_binary("log_diff_exp"); add_binary("log_falling_factorial"); add_ternary("log_mix"); // adds fn over double, double, double for (size_t i = 1; i < vector_types.size(); ++i) { for (size_t j = 1; j < vector_types.size(); ++j) { add("log_mix", bare_expr_type(double_type()), bare_expr_type(vector_types[i]), bare_expr_type(vector_types[j])); } add("log_mix", bare_expr_type(double_type()), bare_expr_type(vector_types[i]), bare_expr_type(bare_array_type(vector_type(), 1))); add("log_mix", bare_expr_type(double_type()), bare_expr_type(vector_types[i]), bare_expr_type(bare_array_type(row_vector_type(), 1))); } add_binary("log_rising_factorial"); add_unary_vectorized("log_inv_logit"); add("log_softmax", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("log_sum_exp", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("log_sum_exp", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("log_sum_exp", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("log_sum_exp", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add_binary("log_sum_exp"); for (size_t i = 0; i < primitive_types.size(); ++i) { add("logical_negation", bare_expr_type(int_type()), primitive_types[i]); for (size_t j = 0; j < primitive_types.size(); ++j) { add("logical_or", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_and", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_eq", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_neq", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_lt", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_lte", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_gt", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); add("logical_gte", bare_expr_type(int_type()), primitive_types[i], primitive_types[j]); } } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("logistic_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("logistic_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("logistic_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("logistic_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("logistic_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("logistic_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("logistic_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("logistic_rng", rng_return_type(t, u), t, u); } } add_unary_vectorized("logit"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("lognormal_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("lognormal_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("lognormal_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("lognormal_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("lognormal_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("lognormal_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("lognormal_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("lognormal_rng", rng_return_type(t, u), t, u); } } add_nullary("machine_precision"); add("matrix_exp", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("matrix_exp_multiply", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("max", bare_expr_type(int_type()), bare_expr_type(bare_array_type(int_type(), 1))); add("max", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("max", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("max", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("max", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("max", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("mdivide_left", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("mdivide_left", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("mdivide_left_spd", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("mdivide_left_spd", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("mdivide_left_tri_low", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("mdivide_left_tri_low", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("mdivide_right", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("mdivide_right_spd", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("mdivide_right_spd", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("mdivide_right", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("mdivide_right_tri_low", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("mdivide_right_tri_low", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("mean", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("mean", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("mean", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("mean", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("min", bare_expr_type(int_type()), bare_expr_type(bare_array_type(int_type(), 1))); add("min", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("min", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("min", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("min", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("min", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("minus", bare_expr_type(double_type()), bare_expr_type(double_type())); add("minus", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("minus", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("minus", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("modified_bessel_first_kind", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); add("modified_bessel_second_kind", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type())); add("modulus", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("multi_gp_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("multi_gp_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("multi_gp_cholesky_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("multi_gp_cholesky_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); { std::vector eigen_vector_types; eigen_vector_types.push_back(vector_type()); eigen_vector_types.push_back(bare_array_type(vector_type())); eigen_vector_types.push_back(row_vector_type()); eigen_vector_types.push_back(bare_array_type(row_vector_type())); for (size_t k = 0; k < 4; ++k) { for (size_t l = 0; l < 4; ++l) { add("multi_normal_cholesky_log", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_normal_cholesky_lpdf", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_normal_log", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_normal_lpdf", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_normal_prec_log", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_normal_prec_lpdf", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_student_t_log", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); add("multi_student_t_lpdf", bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[k]), bare_expr_type(double_type()), bare_expr_type(eigen_vector_types[l]), bare_expr_type(matrix_type())); } } } add("multi_normal_rng", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("multi_normal_rng", bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(matrix_type())); add("multi_normal_rng", bare_expr_type(vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("multi_normal_rng", bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(row_vector_type(), 1)), bare_expr_type(matrix_type())); add("multi_normal_cholesky_rng", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("multi_normal_cholesky_rng", bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(matrix_type())); add("multi_normal_cholesky_rng", bare_expr_type(vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("multi_normal_cholesky_rng", bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(bare_array_type(row_vector_type(), 1)), bare_expr_type(matrix_type())); add("multi_student_t_rng", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("multi_student_t_rng", bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(matrix_type())); add("multi_student_t_rng", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("multi_student_t_rng", bare_expr_type(bare_array_type(vector_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(row_vector_type(), 1)), bare_expr_type(matrix_type())); add("multinomial_log", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type())); add("multinomial_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type())); add("multinomial_rng", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(int_type())); add("multiply", bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("multiply", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("multiply", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(double_type())); add("multiply", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("multiply", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add("multiply", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("multiply", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("multiply", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("multiply", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("multiply", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("multiply", bare_expr_type(row_vector_type()), bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("multiply", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add_binary("multiply_log"); add("multiply_lower_tri_self_transpose", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); for (size_t i = 0; i < int_vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("neg_binomial_ccdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_cdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_cdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_lccdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_lcdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_ccdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_cdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_cdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_lccdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_lcdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_log_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); add("neg_binomial_2_log_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("neg_binomial_rng", rng_return_type(t, u), t, u); } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("neg_binomial_2_rng", rng_return_type(t, u), t, u); } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("neg_binomial_2_log_rng", rng_return_type(t, u), t, u); } } add("neg_binomial_2_log_glm_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("neg_binomial_2_log_glm_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add_nullary("negative_infinity"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("normal_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("normal_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("normal_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("normal_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("normal_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("normal_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("normal_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("normal_rng", rng_return_type(t, u), t, u); } } add("normal_id_glm_lpdf", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("normal_id_glm_lpdf", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add_nullary("not_a_number"); add("num_elements", bare_expr_type(int_type()), bare_expr_type(matrix_type())); add("num_elements", bare_expr_type(int_type()), bare_expr_type(vector_type())); add("num_elements", bare_expr_type(int_type()), bare_expr_type(row_vector_type())); for (size_t i=1; i < 10; i++) { add("num_elements", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(int_type(), i)))); add("num_elements", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(double_type(), i)))); add("num_elements", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(matrix_type(), i)))); add("num_elements", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(row_vector_type(), i)))); add("num_elements", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(vector_type(), i)))); } add("ordered_logistic_log", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("ordered_logistic_log", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("ordered_logistic_log", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(bare_array_type(vector_type(), 1))); add("ordered_logistic_lpmf", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("ordered_logistic_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("ordered_logistic_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(bare_array_type(vector_type(), 1))); add("ordered_logistic_rng", bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("ordered_probit_log", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("ordered_probit_log", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("ordered_probit_log", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type()), bare_expr_type(bare_array_type(vector_type(), 1))); add("ordered_probit_lpmf", bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("ordered_probit_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("ordered_probit_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(double_type()), bare_expr_type(bare_array_type(vector_type(), 1))); add("ordered_probit_rng", bare_expr_type(int_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add_binary("owens_t"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("pareto_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("pareto_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("pareto_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("pareto_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("pareto_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("pareto_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("pareto_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("pareto_rng", rng_return_type(t, u), t, u); } } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { for (size_t l = 0; l < vector_types.size(); ++l) { add("pareto_type_2_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("pareto_type_2_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("pareto_type_2_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("pareto_type_2_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("pareto_type_2_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("pareto_type_2_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("pareto_type_2_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); } } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { for (const auto& v : all_vector_types) { add("pareto_type_2_rng", rng_return_type(t, u, v), t, u, v); } } } add_unary_vectorized("Phi"); add_unary_vectorized("Phi_approx"); add_nullary("pi"); for (size_t i = 0; i < int_vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { add("poisson_ccdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_cdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_cdf_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_lccdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_lcdf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); } } for (const auto& t : all_vector_types) { add("poisson_rng", rng_return_type(t), t); } for (size_t i = 0; i < int_vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { add("poisson_log_log", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); add("poisson_log_lpmf", bare_expr_type(double_type()), int_vector_types[i], vector_types[j]); } } for (const auto& t : all_vector_types) { add("poisson_log_rng", rng_return_type(t), t); } add("poisson_log_glm_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("poisson_log_glm_lpmf", bare_expr_type(double_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add_nullary("positive_infinity"); add_binary("pow"); add("prod", bare_expr_type(int_type()), bare_expr_type(bare_array_type(int_type(), 1))); add("prod", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("prod", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("prod", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("prod", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("quad_form", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("quad_form", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("quad_form_sym", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("quad_form_sym", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("quad_form_diag", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("quad_form_diag", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(row_vector_type())); add("rank", bare_expr_type(int_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(int_type())); add("rank", bare_expr_type(int_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(int_type())); add("rank", bare_expr_type(int_type()), bare_expr_type(vector_type()), bare_expr_type(int_type())); add("rank", bare_expr_type(int_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type())); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { add("rayleigh_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("rayleigh_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("rayleigh_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("rayleigh_log", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("rayleigh_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("rayleigh_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); add("rayleigh_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j]); } } for (const auto& t : all_vector_types) { add("rayleigh_rng", rng_return_type(t), t); } add("append_row", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("append_row", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("append_row", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(row_vector_type())); add("append_row", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("append_row", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("append_row", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("append_row", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); for (size_t i = 0; i < bare_types.size(); ++i) { add("rep_array", bare_expr_type(bare_array_type(bare_types[i], 1)), bare_types[i], bare_expr_type(int_type())); add("rep_array", bare_expr_type(bare_array_type(bare_types[i], 2)), bare_types[i], bare_expr_type(int_type()), bare_expr_type(int_type())); add("rep_array", bare_expr_type(bare_array_type(bare_types[i], 3)), bare_types[i], bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); for (size_t j = 1; j <= 3; ++j) { add("rep_array", bare_expr_type(bare_array_type(bare_types[i], j + 1)), bare_expr_type(bare_array_type(bare_types[i], j)), bare_expr_type(int_type())); add("rep_array", bare_expr_type(bare_array_type(bare_types[i], j + 2)), bare_expr_type(bare_array_type(bare_types[i], j)), bare_expr_type(int_type()), bare_expr_type(int_type())); add("rep_array", bare_expr_type(bare_array_type(bare_types[i], j + 3)), bare_expr_type(bare_array_type(bare_types[i], j)), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); } } add("rep_matrix", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("rep_matrix", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(int_type())); add("rep_matrix", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type())); add("rep_row_vector", bare_expr_type(row_vector_type()), bare_expr_type(double_type()), bare_expr_type(int_type())); add("rep_vector", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(int_type())); add("rising_factorial", bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(int_type())); add("rising_factorial", bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add_unary_vectorized("round"); add("row", bare_expr_type(row_vector_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type())); add("rows", bare_expr_type(int_type()), bare_expr_type(vector_type())); add("rows", bare_expr_type(int_type()), bare_expr_type(row_vector_type())); add("rows", bare_expr_type(int_type()), bare_expr_type(matrix_type())); add("rows_dot_product", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("rows_dot_product", bare_expr_type(vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("rows_dot_product", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("rows_dot_self", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("rows_dot_self", bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("rows_dot_self", bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("scale_matrix_exp_multiply", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("scaled_inv_chi_square_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("scaled_inv_chi_square_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("scaled_inv_chi_square_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("scaled_inv_chi_square_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("scaled_inv_chi_square_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("scaled_inv_chi_square_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("scaled_inv_chi_square_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("scaled_inv_chi_square_rng", rng_return_type(t, u), t, u); } } add("sd", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("sd", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("sd", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("sd", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("segment", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("segment", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); for (size_t i = 0; i < bare_types.size(); ++i) { add("segment", bare_expr_type(bare_array_type(bare_types[i], 1)), bare_expr_type(bare_array_type(bare_types[i], 1)), bare_expr_type(int_type()), bare_expr_type(int_type())); add("segment", bare_expr_type(bare_array_type(bare_types[i], 2)), bare_expr_type(bare_array_type(bare_types[i], 2)), bare_expr_type(int_type()), bare_expr_type(int_type())); add("segment", bare_expr_type(bare_array_type(bare_types[i], 3)), bare_expr_type(bare_array_type(bare_types[i], 3)), bare_expr_type(int_type()), bare_expr_type(int_type())); } add_unary_vectorized("sin"); add("singular_values", bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add_unary_vectorized("sinh"); // size() is polymorphic over arrays, so start i at 1 for (size_t i = 1; i < 8; ++i) { add("size", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(int_type(), i)))); add("size", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(double_type(), i)))); add("size", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(vector_type(), i)))); add("size", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(row_vector_type(), i)))); add("size", bare_expr_type(int_type()), bare_expr_type(bare_array_type(bare_array_type(matrix_type(), i)))); } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { for (size_t l = 0; l < vector_types.size(); ++l) { add("skew_normal_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("skew_normal_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("skew_normal_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("skew_normal_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("skew_normal_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("skew_normal_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("skew_normal_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); } } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { for (const auto& v : all_vector_types) { add("skew_normal_rng", rng_return_type(t, u, v), t, u, v); } } } add("softmax", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("sort_asc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), 1))); add("sort_asc", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1))); add("sort_asc", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("sort_asc", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("sort_desc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), 1))); add("sort_desc", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1))); add("sort_desc", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("sort_desc", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("sort_indices_asc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), 1))); add("sort_indices_asc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1))); add("sort_indices_asc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type())); add("sort_indices_asc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(row_vector_type())); add("sort_indices_desc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(int_type(), 1))); add("sort_indices_desc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(double_type(), 1))); add("sort_indices_desc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(vector_type())); add("sort_indices_desc", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(row_vector_type())); add("squared_distance", bare_expr_type(double_type()), bare_expr_type(double_type()), bare_expr_type(double_type())); add("squared_distance", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("squared_distance", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("squared_distance", bare_expr_type(double_type()), bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("squared_distance", bare_expr_type(double_type()), bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add_unary_vectorized("sqrt"); add_nullary("sqrt2"); add_unary_vectorized("square"); for (size_t i = 0; i < vector_types.size(); ++i) { add("std_normal_log", bare_expr_type(double_type()), vector_types[i]); add("std_normal_lpdf", bare_expr_type(double_type()), vector_types[i]); } add_unary("step"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { for (size_t l = 0; l < vector_types.size(); ++l) { add("student_t_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("student_t_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("student_t_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("student_t_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("student_t_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("student_t_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); add("student_t_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k], vector_types[l]); } } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { for (const auto& v : all_vector_types) { add("student_t_rng", rng_return_type(t, u, v), t, u, v); } } } add("sub_col", bare_expr_type(vector_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("sub_row", bare_expr_type(row_vector_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("subtract", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("subtract", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("subtract", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("subtract", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(double_type())); add("subtract", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(double_type())); add("subtract", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type())); add("subtract", bare_expr_type(vector_type()), bare_expr_type(double_type()), bare_expr_type(vector_type())); add("subtract", bare_expr_type(row_vector_type()), bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("subtract", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("sum", bare_expr_type(int_type()), bare_expr_type(bare_array_type(int_type(), 1))); add("sum", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("sum", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("sum", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("sum", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("tail", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type())); add("tail", bare_expr_type(vector_type()), bare_expr_type(vector_type()), bare_expr_type(int_type())); for (size_t i = 0; i < bare_types.size(); ++i) { add("tail", bare_expr_type(bare_array_type(bare_types[i], 1)), bare_expr_type(bare_array_type(bare_types[i], 1)), bare_expr_type(int_type())); add("tail", bare_expr_type(bare_array_type(bare_types[i], 2)), bare_expr_type(bare_array_type(bare_types[i], 2)), bare_expr_type(int_type())); add("tail", bare_expr_type(bare_array_type(bare_types[i], 3)), bare_expr_type(bare_array_type(bare_types[i], 3)), bare_expr_type(int_type())); } add_unary_vectorized("tan"); add_unary_vectorized("tanh"); add_nullary("target"); // converted to "get_lp" in term_grammar semantics add("tcrossprod", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add_unary_vectorized("tgamma"); add("to_array_1d", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(matrix_type())); add("to_array_1d", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(vector_type())); add("to_array_1d", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(row_vector_type())); for (size_t i=1; i < 10; i++) { add("to_array_1d", bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(bare_array_type(bare_array_type(double_type(), i)))); add("to_array_1d", bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(bare_array_type(bare_array_type(int_type(), i)))); } add("to_array_2d", bare_expr_type(bare_array_type(double_type(), 2)), bare_expr_type(matrix_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(row_vector_type()), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 1)), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(int_type(), 1)), bare_expr_type(int_type()), bare_expr_type(int_type()), bare_expr_type(int_type())); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(double_type(), 2))); add("to_matrix", bare_expr_type(matrix_type()), bare_expr_type(bare_array_type(int_type(), 2))); add("to_row_vector", bare_expr_type(row_vector_type()), bare_expr_type(matrix_type())); add("to_row_vector", bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add("to_row_vector", bare_expr_type(row_vector_type()), bare_expr_type(row_vector_type())); add("to_row_vector", bare_expr_type(row_vector_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("to_row_vector", bare_expr_type(row_vector_type()), bare_expr_type(bare_array_type(int_type(), 1))); add("to_vector", bare_expr_type(vector_type()), bare_expr_type(matrix_type())); add("to_vector", bare_expr_type(vector_type()), bare_expr_type(vector_type())); add("to_vector", bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("to_vector", bare_expr_type(vector_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("to_vector", bare_expr_type(vector_type()), bare_expr_type(bare_array_type(int_type(), 1))); add("trace", bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("trace_gen_quad_form", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("trace_quad_form", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(vector_type())); add("trace_quad_form", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add("transpose", bare_expr_type(row_vector_type()), bare_expr_type(vector_type())); add("transpose", bare_expr_type(vector_type()), bare_expr_type(row_vector_type())); add("transpose", bare_expr_type(matrix_type()), bare_expr_type(matrix_type())); add_unary_vectorized("trunc"); add_unary_vectorized("trigamma"); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("uniform_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("uniform_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("uniform_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("uniform_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("uniform_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("uniform_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("uniform_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("uniform_rng", rng_return_type(t, u), t, u); } } add("variance", bare_expr_type(double_type()), bare_expr_type(bare_array_type(double_type(), 1))); add("variance", bare_expr_type(double_type()), bare_expr_type(vector_type())); add("variance", bare_expr_type(double_type()), bare_expr_type(row_vector_type())); add("variance", bare_expr_type(double_type()), bare_expr_type(matrix_type())); for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("von_mises_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("von_mises_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("von_mises_rng", rng_return_type(t, u), t, u); } } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { add("weibull_ccdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("weibull_cdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("weibull_cdf_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("weibull_log", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("weibull_lccdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("weibull_lcdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); add("weibull_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j], vector_types[k]); } } } for (const auto& t : all_vector_types) { for (const auto& u : all_vector_types) { add("weibull_rng", rng_return_type(t, u), t, u); } } for (size_t i = 0; i < vector_types.size(); ++i) { for (size_t j = 0; j < vector_types.size(); ++j) { for (size_t k = 0; k < vector_types.size(); ++k) { for (size_t l = 0; l < vector_types.size(); ++l) { for (size_t m = 0; m < vector_types.size(); ++m) { add("wiener_log", bare_expr_type(double_type()), vector_types[i], vector_types[j],vector_types[k], vector_types[l], vector_types[m]); add("wiener_lpdf", bare_expr_type(double_type()), vector_types[i], vector_types[j],vector_types[k], vector_types[l], vector_types[m]); } } } } } add("wishart_log", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("wishart_lpdf", bare_expr_type(double_type()), bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); add("wishart_rng", bare_expr_type(matrix_type()), bare_expr_type(double_type()), bare_expr_type(matrix_type())); StanHeaders/inst/include/src/stan/lang/ast.hpp0000644000176200001440000001551113766554456021060 0ustar liggesusers#ifndef STAN_LANG_AST_HPP #define STAN_LANG_AST_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/src/stan/mcmc/0000755000176200001440000000000013766554456017553 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/stepsize_adaptation.hpp0000644000176200001440000000363113766554456024341 0ustar liggesusers#ifndef STAN_MCMC_STEPSIZE_ADAPTATION_HPP #define STAN_MCMC_STEPSIZE_ADAPTATION_HPP #include #include namespace stan { namespace mcmc { class stepsize_adaptation : public base_adaptation { public: stepsize_adaptation() : mu_(0.5), delta_(0.5), gamma_(0.05), kappa_(0.75), t0_(10) { restart(); } void set_mu(double m) { mu_ = m; } void set_delta(double d) { if (d > 0 && d < 1) delta_ = d; } void set_gamma(double g) { if (g > 0) gamma_ = g; } void set_kappa(double k) { if (k > 0) kappa_ = k; } void set_t0(double t) { if (t > 0) t0_ = t; } double get_mu() { return mu_; } double get_delta() { return delta_; } double get_gamma() { return gamma_; } double get_kappa() { return kappa_; } double get_t0() { return t0_; } void restart() { counter_ = 0; s_bar_ = 0; x_bar_ = 0; } void learn_stepsize(double& epsilon, double adapt_stat) { ++counter_; adapt_stat = adapt_stat > 1 ? 1 : adapt_stat; // Nesterov Dual-Averaging of log(epsilon) const double eta = 1.0 / (counter_ + t0_); s_bar_ = (1.0 - eta) * s_bar_ + eta * (delta_ - adapt_stat); const double x = mu_ - s_bar_ * std::sqrt(counter_) / gamma_; const double x_eta = std::pow(counter_, -kappa_); x_bar_ = (1.0 - x_eta) * x_bar_ + x_eta * x; epsilon = std::exp(x); } void complete_adaptation(double& epsilon) { epsilon = std::exp(x_bar_); } protected: double counter_; // Adaptation iteration double s_bar_; // Moving average statistic double x_bar_; // Moving average parameter double mu_; // Asymptotic mean of parameter double delta_; // Target value of statistic double gamma_; // Adaptation scaling double kappa_; // Adaptation shrinkage double t0_; // Effective starting iteration }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/0000755000176200001440000000000013766554456020322 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/base_hmc.hpp0000644000176200001440000001163113766554456022576 0ustar liggesusers#ifndef STAN_MCMC_HMC_BASE_HMC_HPP #define STAN_MCMC_HMC_BASE_HMC_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { template class Hamiltonian, template class Integrator, class BaseRNG> class base_hmc : public base_mcmc { public: base_hmc(const Model& model, BaseRNG& rng) : base_mcmc(), z_(model.num_params_r()), integrator_(), hamiltonian_(model), rand_int_(rng), rand_uniform_(rand_int_), nom_epsilon_(0.1), epsilon_(nom_epsilon_), epsilon_jitter_(0.0) {} /** * format and write stepsize */ void write_sampler_stepsize(callbacks::writer& writer) { std::stringstream nominal_stepsize; nominal_stepsize << "Step size = " << get_nominal_stepsize(); writer(nominal_stepsize.str()); } /** * write elements of mass matrix */ void write_sampler_metric(callbacks::writer& writer) { z_.write_metric(writer); } /** * write stepsize and elements of mass matrix */ void write_sampler_state(callbacks::writer& writer) { write_sampler_stepsize(writer); write_sampler_metric(writer); } void get_sampler_diagnostic_names(std::vector& model_names, std::vector& names) { z_.get_param_names(model_names, names); } void get_sampler_diagnostics(std::vector& values) { z_.get_params(values); } void seed(const Eigen::VectorXd& q) { z_.q = q; } void init_hamiltonian(callbacks::logger& logger) { this->hamiltonian_.init(this->z_, logger); } void init_stepsize(callbacks::logger& logger) { ps_point z_init(this->z_); // Skip initialization for extreme step sizes if (this->nom_epsilon_ == 0 || this->nom_epsilon_ > 1e7) return; this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); // Guaranteed to be finite if randomly initialized double H0 = this->hamiltonian_.H(this->z_); this->integrator_.evolve(this->z_, this->hamiltonian_, this->nom_epsilon_, logger); double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); double delta_H = H0 - h; int direction = delta_H > std::log(0.8) ? 1 : -1; while (1) { this->z_.ps_point::operator=(z_init); this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); double H0 = this->hamiltonian_.H(this->z_); this->integrator_.evolve(this->z_, this->hamiltonian_, this->nom_epsilon_, logger); double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); double delta_H = H0 - h; if ((direction == 1) && !(delta_H > std::log(0.8))) break; else if ((direction == -1) && !(delta_H < std::log(0.8))) break; else this->nom_epsilon_ = direction == 1 ? 2.0 * this->nom_epsilon_ : 0.5 * this->nom_epsilon_; if (this->nom_epsilon_ > 1e7) throw std::runtime_error( "Posterior is improper. " "Please check your model."); if (this->nom_epsilon_ == 0) throw std::runtime_error( "No acceptably small step size could " "be found. Perhaps the posterior is " "not continuous?"); } this->z_.ps_point::operator=(z_init); } typename Hamiltonian::PointType& z() { return z_; } virtual void set_nominal_stepsize(double e) { if (e > 0) nom_epsilon_ = e; } double get_nominal_stepsize() { return this->nom_epsilon_; } double get_current_stepsize() { return this->epsilon_; } virtual void set_stepsize_jitter(double j) { if (j > 0 && j < 1) epsilon_jitter_ = j; } double get_stepsize_jitter() { return this->epsilon_jitter_; } void sample_stepsize() { this->epsilon_ = this->nom_epsilon_; if (this->epsilon_jitter_) this->epsilon_ *= 1.0 + this->epsilon_jitter_ * (2.0 * this->rand_uniform_() - 1.0); } protected: typename Hamiltonian::PointType z_; Integrator > integrator_; Hamiltonian hamiltonian_; BaseRNG& rand_int_; // Uniform(0, 1) RNG boost::uniform_01 rand_uniform_; double nom_epsilon_; double epsilon_; double epsilon_jitter_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/0000755000176200001440000000000013766554456023010 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/softabs_metric.hpp0000644000176200001440000001545013766554456026532 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_SOFTABS_METRIC_HPP #define STAN_MCMC_HMC_HAMILTONIANS_SOFTABS_METRIC_HPP #include #include #include #include #include namespace stan { namespace mcmc { template struct softabs_fun { const Model& model_; std::ostream* o_; softabs_fun(const Model& m, std::ostream* out) : model_(m), o_(out) {} template T operator()(const Eigen::Matrix& x) const { // log_prob() requires non-const but doesn't modify its argument return model_.template log_prob( const_cast&>(x), o_); } }; // Riemannian manifold with SoftAbs metric template class softabs_metric : public base_hamiltonian { private: typedef typename stan::math::index_type::type idx_t; public: explicit softabs_metric(const Model& model) : base_hamiltonian(model) {} double T(softabs_point& z) { return this->tau(z) + 0.5 * z.log_det_metric; } double tau(softabs_point& z) { Eigen::VectorXd Qp = z.eigen_deco.eigenvectors().transpose() * z.p; return 0.5 * Qp.transpose() * z.softabs_lambda_inv.cwiseProduct(Qp); } double phi(softabs_point& z) { return this->V(z) + 0.5 * z.log_det_metric; } double dG_dt(softabs_point& z, callbacks::logger& logger) { return 2 * T(z) - z.q.dot(dtau_dq(z, logger) + dphi_dq(z, logger)); } Eigen::VectorXd dtau_dq(softabs_point& z, callbacks::logger& logger) { Eigen::VectorXd a = z.softabs_lambda_inv.cwiseProduct( z.eigen_deco.eigenvectors().transpose() * z.p); Eigen::MatrixXd A = a.asDiagonal() * z.eigen_deco.eigenvectors().transpose(); Eigen::MatrixXd B = z.pseudo_j.selfadjointView() * A; Eigen::MatrixXd C = A.transpose() * B; Eigen::VectorXd b(z.q.size()); stan::math::grad_tr_mat_times_hessian(softabs_fun(this->model_, 0), z.q, C, b); return 0.5 * b; } Eigen::VectorXd dtau_dp(softabs_point& z) { return z.eigen_deco.eigenvectors() * z.softabs_lambda_inv.cwiseProduct( z.eigen_deco.eigenvectors().transpose() * z.p); } Eigen::VectorXd dphi_dq(softabs_point& z, callbacks::logger& logger) { Eigen::VectorXd a = z.softabs_lambda_inv.cwiseProduct(z.pseudo_j.diagonal()); Eigen::MatrixXd A = a.asDiagonal() * z.eigen_deco.eigenvectors().transpose(); Eigen::MatrixXd B = z.eigen_deco.eigenvectors() * A; stan::math::grad_tr_mat_times_hessian(softabs_fun(this->model_, 0), z.q, B, a); return -0.5 * a + z.g; } void sample_p(softabs_point& z, BaseRNG& rng) { boost::variate_generator > rand_unit_gaus(rng, boost::normal_distribution<>()); Eigen::VectorXd a(z.p.size()); for (idx_t n = 0; n < z.p.size(); ++n) a(n) = sqrt(z.softabs_lambda(n)) * rand_unit_gaus(); z.p = z.eigen_deco.eigenvectors() * a; } void init(softabs_point& z, callbacks::logger& logger) { update_metric(z, logger); update_metric_gradient(z, logger); } void update_metric(softabs_point& z, callbacks::logger& logger) { math::hessian >(softabs_fun(this->model_, 0), z.q, z.V, z.g, z.hessian); z.V = -z.V; z.g = -z.g; z.hessian = -z.hessian; // Compute the eigen decomposition of the Hessian, // then perform the SoftAbs transformation z.eigen_deco.compute(z.hessian); for (idx_t i = 0; i < z.q.size(); ++i) { double lambda = z.eigen_deco.eigenvalues()(i); double alpha_lambda = z.alpha * lambda; double softabs_lambda = 0; // Thresholds defined such that the approximation // error is on the same order of double precision if (std::fabs(alpha_lambda) < lower_softabs_thresh) { softabs_lambda = (1.0 + (1.0 / 3.0) * alpha_lambda * alpha_lambda) / z.alpha; } else if (std::fabs(alpha_lambda) > upper_softabs_thresh) { softabs_lambda = std::fabs(lambda); } else { softabs_lambda = lambda / std::tanh(alpha_lambda); } z.softabs_lambda(i) = softabs_lambda; z.softabs_lambda_inv(i) = 1.0 / softabs_lambda; } // Compute the log determinant of the metric z.log_det_metric = 0; for (idx_t i = 0; i < z.q.size(); ++i) z.log_det_metric += std::log(z.softabs_lambda(i)); } void update_metric_gradient(softabs_point& z, callbacks::logger& logger) { // Compute the pseudo-Jacobian of the SoftAbs transform for (idx_t i = 0; i < z.q.size(); ++i) { for (idx_t j = 0; j <= i; ++j) { double delta = z.eigen_deco.eigenvalues()(i) - z.eigen_deco.eigenvalues()(j); if (std::fabs(delta) < jacobian_thresh) { double lambda = z.eigen_deco.eigenvalues()(i); double alpha_lambda = z.alpha * lambda; // Thresholds defined such that the approximation // error is on the same order of double precision if (std::fabs(alpha_lambda) < lower_softabs_thresh) { z.pseudo_j(i, j) = (2.0 / 3.0) * alpha_lambda * (1.0 - (2.0 / 15.0) * alpha_lambda * alpha_lambda); } else if (std::fabs(alpha_lambda) > upper_softabs_thresh) { z.pseudo_j(i, j) = lambda > 0 ? 1 : -1; } else { double sdx = std::sinh(alpha_lambda) / lambda; z.pseudo_j(i, j) = (z.softabs_lambda(i) - z.alpha / (sdx * sdx)) / lambda; } } else { z.pseudo_j(i, j) = (z.softabs_lambda(i) - z.softabs_lambda(j)) / delta; } } } } void update_gradients(softabs_point& z, callbacks::logger& logger) { update_metric_gradient(z, logger); } // Threshold below which a power series // approximation of the softabs function is used static double lower_softabs_thresh; // Threshold above which an asymptotic // approximation of the softabs function is used static double upper_softabs_thresh; // Threshold below which an exact derivative is // used in the Jacobian calculation instead of // finite differencing static double jacobian_thresh; }; template double softabs_metric::lower_softabs_thresh = 1e-4; template double softabs_metric::upper_softabs_thresh = 18; template double softabs_metric::jacobian_thresh = 1e-10; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/dense_e_point.hpp0000644000176200001440000000271013766554456026334 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_DENSE_E_POINT_HPP #define STAN_MCMC_HMC_HAMILTONIANS_DENSE_E_POINT_HPP #include #include namespace stan { namespace mcmc { /** * Point in a phase space with a base * Euclidean manifold with dense metric */ class dense_e_point : public ps_point { public: /** * Inverse mass matrix. */ Eigen::MatrixXd inv_e_metric_; /** * Construct a dense point in n-dimensional phase space * with identity matrix as inverse mass matrix. * * @param n number of dimensions */ explicit dense_e_point(int n) : ps_point(n), inv_e_metric_(n, n) { inv_e_metric_.setIdentity(); } /** * Set elements of mass matrix * * @param inv_e_metric initial mass matrix */ void set_metric(const Eigen::MatrixXd& inv_e_metric) { inv_e_metric_ = inv_e_metric; } /** * Write elements of mass matrix to string and handoff to writer. * * @param writer Stan writer callback */ inline void write_metric(stan::callbacks::writer& writer) { writer("Elements of inverse mass matrix:"); for (int i = 0; i < inv_e_metric_.rows(); ++i) { std::stringstream inv_e_metric_ss; inv_e_metric_ss << inv_e_metric_(i, 0); for (int j = 1; j < inv_e_metric_.cols(); ++j) inv_e_metric_ss << ", " << inv_e_metric_(i, j); writer(inv_e_metric_ss.str()); } } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/dense_e_metric.hpp0000644000176200001440000000343613766554456026474 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_DENSE_E_METRIC_HPP #define STAN_MCMC_HMC_HAMILTONIANS_DENSE_E_METRIC_HPP #include #include #include #include #include #include #include namespace stan { namespace mcmc { // Euclidean manifold with dense metric template class dense_e_metric : public base_hamiltonian { public: explicit dense_e_metric(const Model& model) : base_hamiltonian(model) {} double T(dense_e_point& z) { return 0.5 * z.p.transpose() * z.inv_e_metric_ * z.p; } double tau(dense_e_point& z) { return T(z); } double phi(dense_e_point& z) { return this->V(z); } double dG_dt(dense_e_point& z, callbacks::logger& logger) { return 2 * T(z) - z.q.dot(z.g); } Eigen::VectorXd dtau_dq(dense_e_point& z, callbacks::logger& logger) { return Eigen::VectorXd::Zero(this->model_.num_params_r()); } Eigen::VectorXd dtau_dp(dense_e_point& z) { return z.inv_e_metric_ * z.p; } Eigen::VectorXd dphi_dq(dense_e_point& z, callbacks::logger& logger) { return z.g; } void sample_p(dense_e_point& z, BaseRNG& rng) { typedef typename stan::math::index_type::type idx_t; boost::variate_generator > rand_dense_gaus(rng, boost::normal_distribution<>()); Eigen::VectorXd u(z.p.size()); for (idx_t i = 0; i < u.size(); ++i) u(i) = rand_dense_gaus(); z.p = z.inv_e_metric_.llt().matrixU().solve(u); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/base_hamiltonian.hpp0000644000176200001440000000560213766554456027021 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_BASE_HAMILTONIAN_HPP #define STAN_MCMC_HMC_HAMILTONIANS_BASE_HAMILTONIAN_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { template class base_hamiltonian { public: explicit base_hamiltonian(const Model& model) : model_(model) {} ~base_hamiltonian() {} typedef Point PointType; virtual double T(Point& z) = 0; double V(Point& z) { return z.V; } virtual double tau(Point& z) = 0; virtual double phi(Point& z) = 0; double H(Point& z) { return T(z) + V(z); } // The time derivative of the virial, G = \sum_{d = 1}^{D} q^{d} p_{d}. virtual double dG_dt(Point& z, callbacks::logger& logger) = 0; // tau = 0.5 p_{i} p_{j} Lambda^{ij} (q) virtual Eigen::VectorXd dtau_dq(Point& z, callbacks::logger& logger) = 0; virtual Eigen::VectorXd dtau_dp(Point& z) = 0; // phi = 0.5 * log | Lambda (q) | + V(q) virtual Eigen::VectorXd dphi_dq(Point& z, callbacks::logger& logger) = 0; virtual void sample_p(Point& z, BaseRNG& rng) = 0; void init(Point& z, callbacks::logger& logger) { this->update_potential_gradient(z, logger); } void update_potential(Point& z, callbacks::logger& logger) { try { z.V = -stan::model::log_prob_propto(model_, z.q); } catch (const std::exception& e) { this->write_error_msg_(e, logger); z.V = std::numeric_limits::infinity(); } } void update_potential_gradient(Point& z, callbacks::logger& logger) { try { stan::model::gradient(model_, z.q, z.V, z.g, logger); z.V = -z.V; } catch (const std::exception& e) { this->write_error_msg_(e, logger); z.V = std::numeric_limits::infinity(); } z.g = -z.g; } void update_metric(Point& z, callbacks::logger& logger) {} void update_metric_gradient(Point& z, callbacks::logger& logger) {} void update_gradients(Point& z, callbacks::logger& logger) { update_potential_gradient(z, logger); } protected: const Model& model_; void write_error_msg_(const std::exception& e, callbacks::logger& logger) { logger.error( "Informational Message: The current Metropolis proposal " "is about to be rejected because of the following issue:"); logger.error(e.what()); logger.error( "If this warning occurs sporadically, such as for highly " "constrained variable types like covariance matrices, " "then the sampler is fine,"); logger.error( "but if this warning occurs often then your model may be " "either severely ill-conditioned or misspecified."); logger.error(""); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/ps_point.hpp0000644000176200001440000000300613766554456025353 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_PS_POINT_HPP #define STAN_MCMC_HMC_HAMILTONIANS_PS_POINT_HPP #include #include #include #include #include #include namespace stan { namespace mcmc { using Eigen::Dynamic; /** * Point in a generic phase space */ class ps_point { public: explicit ps_point(int n) : q(n), p(n), g(n) {} Eigen::VectorXd q; Eigen::VectorXd p; Eigen::VectorXd g; double V{0}; virtual inline void get_param_names(std::vector& model_names, std::vector& names) { names.reserve(q.size() + p.size() + g.size()); for (int i = 0; i < q.size(); ++i) names.emplace_back(model_names[i]); for (int i = 0; i < p.size(); ++i) names.emplace_back(std::string("p_") + model_names[i]); for (int i = 0; i < g.size(); ++i) names.emplace_back(std::string("g_") + model_names[i]); } virtual inline void get_params(std::vector& values) { values.reserve(q.size() + p.size() + g.size()); for (int i = 0; i < q.size(); ++i) values.push_back(q[i]); for (int i = 0; i < p.size(); ++i) values.push_back(p[i]); for (int i = 0; i < g.size(); ++i) values.push_back(g[i]); } /** * Writes the metric * * @param writer writer callback */ virtual inline void write_metric(stan::callbacks::writer& writer) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/diag_e_metric.hpp0000644000176200001440000000314313766554456026275 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_DIAG_E_METRIC_HPP #define STAN_MCMC_HMC_HAMILTONIANS_DIAG_E_METRIC_HPP #include #include #include #include #include namespace stan { namespace mcmc { // Euclidean manifold with diagonal metric template class diag_e_metric : public base_hamiltonian { public: explicit diag_e_metric(const Model& model) : base_hamiltonian(model) {} double T(diag_e_point& z) { return 0.5 * z.p.dot(z.inv_e_metric_.cwiseProduct(z.p)); } double tau(diag_e_point& z) { return T(z); } double phi(diag_e_point& z) { return this->V(z); } double dG_dt(diag_e_point& z, callbacks::logger& logger) { return 2 * T(z) - z.q.dot(z.g); } Eigen::VectorXd dtau_dq(diag_e_point& z, callbacks::logger& logger) { return Eigen::VectorXd::Zero(this->model_.num_params_r()); } Eigen::VectorXd dtau_dp(diag_e_point& z) { return z.inv_e_metric_.cwiseProduct(z.p); } Eigen::VectorXd dphi_dq(diag_e_point& z, callbacks::logger& logger) { return z.g; } void sample_p(diag_e_point& z, BaseRNG& rng) { boost::variate_generator > rand_diag_gaus(rng, boost::normal_distribution<>()); for (int i = 0; i < z.p.size(); ++i) z.p(i) = rand_diag_gaus() / sqrt(z.inv_e_metric_(i)); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/diag_e_point.hpp0000644000176200001440000000266113766554456026147 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_DIAG_E_POINT_HPP #define STAN_MCMC_HMC_HAMILTONIANS_DIAG_E_POINT_HPP #include #include namespace stan { namespace mcmc { /** * Point in a phase space with a base * Euclidean manifold with diagonal metric */ class diag_e_point : public ps_point { public: /** * Vector of diagonal elements of inverse mass matrix. */ Eigen::VectorXd inv_e_metric_; /** * Construct a diag point in n-dimensional phase space * with vector of ones for diagonal elements of inverse mass matrix. * * @param n number of dimensions */ explicit diag_e_point(int n) : ps_point(n), inv_e_metric_(n) { inv_e_metric_.setOnes(); } /** * Set elements of mass matrix * * @param inv_e_metric initial mass matrix */ void set_metric(const Eigen::VectorXd& inv_e_metric) { inv_e_metric_ = inv_e_metric; } /** * Write elements of mass matrix to string and handoff to writer. * * @param writer Stan writer callback */ inline void write_metric(stan::callbacks::writer& writer) { writer("Diagonal elements of inverse mass matrix:"); std::stringstream inv_e_metric_ss; inv_e_metric_ss << inv_e_metric_(0); for (int i = 1; i < inv_e_metric_.size(); ++i) inv_e_metric_ss << ", " << inv_e_metric_(i); writer(inv_e_metric_ss.str()); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/softabs_point.hpp0000644000176200001440000000243713766554456026401 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_SOFTABS_POINT_HPP #define STAN_MCMC_HMC_HAMILTONIANS_SOFTABS_POINT_HPP #include #include namespace stan { namespace mcmc { /** * Point in a phase space with a base * Riemannian manifold with SoftAbs metric */ class softabs_point : public ps_point { public: explicit softabs_point(int n) : ps_point(n), alpha(1.0), hessian(Eigen::MatrixXd::Identity(n, n)), eigen_deco(n), log_det_metric(0), softabs_lambda(Eigen::VectorXd::Zero(n)), softabs_lambda_inv(Eigen::VectorXd::Zero(n)), pseudo_j(Eigen::MatrixXd::Identity(n, n)) {} // SoftAbs regularization parameter double alpha; Eigen::MatrixXd hessian; // Eigendecomposition of the Hessian Eigen::SelfAdjointEigenSolver eigen_deco; // Log determinant of metric double log_det_metric; // SoftAbs transformed eigenvalues of Hessian Eigen::VectorXd softabs_lambda; Eigen::VectorXd softabs_lambda_inv; // Psuedo-Jacobian of the eigenvalues Eigen::MatrixXd pseudo_j; virtual inline void write_metric(stan::callbacks::writer& writer) { writer("No free parameters for SoftAbs metric"); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/unit_e_metric.hpp0000644000176200001440000000273413766554456026355 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_UNIT_E_METRIC_HPP #define STAN_MCMC_HMC_HAMILTONIANS_UNIT_E_METRIC_HPP #include #include #include #include namespace stan { namespace mcmc { // Euclidean manifold with unit metric template class unit_e_metric : public base_hamiltonian { public: explicit unit_e_metric(const Model& model) : base_hamiltonian(model) {} double T(unit_e_point& z) { return 0.5 * z.p.squaredNorm(); } double tau(unit_e_point& z) { return T(z); } double phi(unit_e_point& z) { return this->V(z); } double dG_dt(unit_e_point& z, callbacks::logger& logger) { return 2 * T(z) - z.q.dot(z.g); } Eigen::VectorXd dtau_dq(unit_e_point& z, callbacks::logger& logger) { return Eigen::VectorXd::Zero(this->model_.num_params_r()); } Eigen::VectorXd dtau_dp(unit_e_point& z) { return z.p; } Eigen::VectorXd dphi_dq(unit_e_point& z, callbacks::logger& logger) { return z.g; } void sample_p(unit_e_point& z, BaseRNG& rng) { boost::variate_generator > rand_unit_gaus(rng, boost::normal_distribution<>()); for (int i = 0; i < z.p.size(); ++i) z.p(i) = rand_unit_gaus(); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/hamiltonians/unit_e_point.hpp0000644000176200001440000000103113766554456026210 0ustar liggesusers#ifndef STAN_MCMC_HMC_HAMILTONIANS_UNIT_E_POINT_HPP #define STAN_MCMC_HMC_HAMILTONIANS_UNIT_E_POINT_HPP #include namespace stan { namespace mcmc { /** * Point in a phase space with a base * Euclidean manifold with unit metric */ class unit_e_point : public ps_point { public: explicit unit_e_point(int n) : ps_point(n) {} }; inline void write_metric(stan::callbacks::writer& writer) { writer("No free parameters for unit metric"); } } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/0000755000176200001440000000000013766554456023014 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/dense_e_nuts_classic.hpp0000644000176200001440000000237113766554456027704 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_DENSE_E_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_DENSE_E_NUTS_CLASSIC_HPP #include #include #include #include namespace stan { namespace mcmc { // The No-U-Turn Sampler (NUTS) on a // Euclidean manifold with dense metric template class dense_e_nuts_classic : public base_nuts_classic { public: dense_e_nuts_classic(const Model& model, BaseRNG& rng) : base_nuts_classic(model, rng) {} // Note that the points don't need to be swapped // here since start.inv_e_metric_ = finish.inv_e_metric_ bool compute_criterion(ps_point& start, dense_e_point& finish, Eigen::VectorXd& rho) { return finish.p.transpose() * finish.inv_e_metric_ * (rho - finish.p) > 0 && start.p.transpose() * finish.inv_e_metric_ * (rho - start.p) > 0; } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/adapt_diag_e_nuts_classic.hpp0000644000176200001440000000325513766554456030665 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_ADAPT_DIAG_E_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_ADAPT_DIAG_E_NUTS_CLASSIC_HPP #include #include #include namespace stan { namespace mcmc { // The No-U-Turn Sampler (NUTS) on a // Euclidean manifold with diagonal metric // and adaptive stepsize template class adapt_diag_e_nuts_classic : public diag_e_nuts_classic, public stepsize_var_adapter { public: adapt_diag_e_nuts_classic(const Model& model, BaseRNG& rng) : diag_e_nuts_classic(model, rng), stepsize_var_adapter(model.num_params_r()) {} ~adapt_diag_e_nuts_classic() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = diag_e_nuts_classic::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->var_adaptation_.learn_variance(this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/base_nuts_classic.hpp0000644000176200001440000001534613766554456027222 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_BASE_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_BASE_NUTS_CLASSIC_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { struct nuts_util { // Constants through each recursion double log_u; double H0; int sign; // Aggregators through each recursion int n_tree; double sum_prob; bool criterion; // just to guarantee bool initializes to valid value nuts_util() : criterion(false) {} }; // The No-U-Turn Sampler (NUTS) with the // original slice sampler implementation template class Hamiltonian, template class Integrator, class BaseRNG> class base_nuts_classic : public base_hmc { public: base_nuts_classic(const Model& model, BaseRNG& rng) : base_hmc(model, rng), depth_(0), max_depth_(5), max_delta_(1000), n_leapfrog_(0), divergent_(0), energy_(0) {} ~base_nuts_classic() {} void set_max_depth(int d) { if (d > 0) max_depth_ = d; } void set_max_delta(double d) { max_delta_ = d; } int get_max_depth() { return this->max_depth_; } double get_max_delta() { return this->max_delta_; } sample transition(sample& init_sample, callbacks::logger& logger) { // Initialize the algorithm this->sample_stepsize(); nuts_util util; this->seed(init_sample.cont_params()); this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); ps_point z_plus(this->z_); ps_point z_minus(z_plus); ps_point z_sample(z_plus); ps_point z_propose(z_plus); int n_cont = init_sample.cont_params().size(); Eigen::VectorXd rho_init = this->z_.p; Eigen::VectorXd rho_plus(n_cont); rho_plus.setZero(); Eigen::VectorXd rho_minus(n_cont); rho_minus.setZero(); util.H0 = this->hamiltonian_.H(this->z_); // Sample the slice variable util.log_u = std::log(this->rand_uniform_()); // Build a balanced binary tree until the NUTS criterion fails util.criterion = true; int n_valid = 0; this->depth_ = 0; this->divergent_ = 0; util.n_tree = 0; util.sum_prob = 0; while (util.criterion && (this->depth_ <= this->max_depth_)) { // Randomly sample a direction in time ps_point* z = 0; Eigen::VectorXd* rho = 0; if (this->rand_uniform_() > 0.5) { z = &z_plus; rho = &rho_plus; util.sign = 1; } else { z = &z_minus; rho = &rho_minus; util.sign = -1; } // And build a new subtree in that direction this->z_.ps_point::operator=(*z); int n_valid_subtree = build_tree(depth_, *rho, 0, z_propose, util, logger); ++(this->depth_); *z = this->z_; // Metropolis-Hastings sample the fresh subtree if (!util.criterion) break; double subtree_prob = 0; if (n_valid) { subtree_prob = static_cast(n_valid_subtree) / static_cast(n_valid); } else { subtree_prob = n_valid_subtree ? 1 : 0; } if (this->rand_uniform_() < subtree_prob) z_sample = z_propose; n_valid += n_valid_subtree; // Check validity of completed tree this->z_.ps_point::operator=(z_plus); Eigen::VectorXd delta_rho = rho_minus + rho_init + rho_plus; util.criterion = compute_criterion(z_minus, this->z_, delta_rho); } this->n_leapfrog_ = util.n_tree; double accept_prob = util.sum_prob / static_cast(util.n_tree); this->z_.ps_point::operator=(z_sample); this->energy_ = this->hamiltonian_.H(this->z_); return sample(this->z_.q, -this->z_.V, accept_prob); } void get_sampler_param_names(std::vector& names) { names.push_back("stepsize__"); names.push_back("treedepth__"); names.push_back("n_leapfrog__"); names.push_back("divergent__"); names.push_back("energy__"); } void get_sampler_params(std::vector& values) { values.push_back(this->epsilon_); values.push_back(this->depth_); values.push_back(this->n_leapfrog_); values.push_back(this->divergent_); values.push_back(this->energy_); } virtual bool compute_criterion( ps_point& start, typename Hamiltonian::PointType& finish, Eigen::VectorXd& rho) = 0; // Returns number of valid points in the completed subtree int build_tree(int depth, Eigen::VectorXd& rho, ps_point* z_init_parent, ps_point& z_propose, nuts_util& util, callbacks::logger& logger) { // Base case if (depth == 0) { this->integrator_.evolve(this->z_, this->hamiltonian_, util.sign * this->epsilon_, logger); rho += this->z_.p; if (z_init_parent) *z_init_parent = this->z_; z_propose = this->z_; double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); util.criterion = util.log_u + (h - util.H0) < this->max_delta_; if (!util.criterion) ++(this->divergent_); util.sum_prob += std::min(1.0, std::exp(util.H0 - h)); util.n_tree += 1; return (util.log_u + (h - util.H0) < 0); } else { // General recursion Eigen::VectorXd left_subtree_rho(rho.size()); left_subtree_rho.setZero(); ps_point z_init(this->z_); int n1 = build_tree(depth - 1, left_subtree_rho, &z_init, z_propose, util, logger); if (z_init_parent) *z_init_parent = z_init; if (!util.criterion) return 0; Eigen::VectorXd right_subtree_rho(rho.size()); right_subtree_rho.setZero(); ps_point z_propose_right(z_init); int n2 = build_tree(depth - 1, right_subtree_rho, 0, z_propose_right, util, logger); double accept_prob = static_cast(n2) / static_cast(n1 + n2); if (util.criterion && (this->rand_uniform_() < accept_prob)) z_propose = z_propose_right; Eigen::VectorXd& subtree_rho = left_subtree_rho; subtree_rho += right_subtree_rho; rho += subtree_rho; util.criterion &= compute_criterion(z_init, this->z_, subtree_rho); return n1 + n2; } } int depth_; int max_depth_; double max_delta_; int n_leapfrog_; int divergent_; double energy_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/adapt_dense_e_nuts_classic.hpp0000644000176200001440000000321713766554456031055 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_ADAPT_DENSE_E_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_ADAPT_DENSE_E_NUTS_CLASSIC_HPP #include #include #include namespace stan { namespace mcmc { // The No-U-Turn Sampler (NUTS) on a // Euclidean manifold with dense metric // and adaptive stepsize template class adapt_dense_e_nuts_classic : public dense_e_nuts_classic, public stepsize_covar_adapter { public: adapt_dense_e_nuts_classic(const Model& model, BaseRNG& rng) : dense_e_nuts_classic(model, rng), stepsize_covar_adapter(model.num_params_r()) {} ~adapt_dense_e_nuts_classic() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = dense_e_nuts_classic::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->covar_adaptation_.learn_covariance( this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/adapt_unit_e_nuts_classic.hpp0000644000176200001440000000242413766554456030735 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_ADAPT_UNIT_E_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_ADAPT_UNIT_E_NUTS_CLASSIC_HPP #include #include #include namespace stan { namespace mcmc { // The No-U-Turn Sampler (NUTS) on a // Euclidean manifold with unit metric // and adaptive stepsize template class adapt_unit_e_nuts_classic : public unit_e_nuts_classic, public stepsize_adapter { public: adapt_unit_e_nuts_classic(const Model& model, BaseRNG& rng) : unit_e_nuts_classic(model, rng) {} ~adapt_unit_e_nuts_classic() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = unit_e_nuts_classic::transition(init_sample, logger); if (this->adapt_flag_) this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/diag_e_nuts_classic.hpp0000644000176200001440000000236413766554456027514 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_DIAG_E_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_DIAG_E_NUTS_CLASSIC_HPP #include #include #include #include namespace stan { namespace mcmc { // The No-U-Turn Sampler (NUTS) on a // Euclidean manifold with diagonal metric template class diag_e_nuts_classic : public base_nuts_classic { public: diag_e_nuts_classic(const Model& model, BaseRNG& rng) : base_nuts_classic(model, rng) {} // Note that the points don't need to be swapped here // since start.inv_e_metric_ = finish.inv_e_metric_ bool compute_criterion(ps_point& start, diag_e_point& finish, Eigen::VectorXd& rho) { return finish.inv_e_metric_.cwiseProduct(finish.p).dot(rho - finish.p) > 0 && finish.inv_e_metric_.cwiseProduct(start.p).dot(rho - start.p) > 0; } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts_classic/unit_e_nuts_classic.hpp0000644000176200001440000000206113766554456027561 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_CLASSIC_UNIT_E_NUTS_CLASSIC_HPP #define STAN_MCMC_HMC_NUTS_CLASSIC_UNIT_E_NUTS_CLASSIC_HPP #include #include #include #include namespace stan { namespace mcmc { // The No-U-Turn Sampler (NUTS) on a // Euclidean manifold with unit metric template class unit_e_nuts_classic : public base_nuts_classic { public: unit_e_nuts_classic(const Model& model, BaseRNG& rng) : base_nuts_classic(model, rng) {} bool compute_criterion(ps_point& start, unit_e_point& finish, Eigen::VectorXd& rho) { return finish.p.dot(rho - finish.p) > 0 && start.p.dot(rho - start.p) > 0; } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/0000755000176200001440000000000013766554456021261 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/diag_e_xhmc.hpp0000644000176200001440000000142613766554456024224 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_DIAG_E_XHMC_HPP #define STAN_MCMC_HMC_NUTS_DIAG_E_XHMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Euclidean disintegration and diagonal metric */ template class diag_e_xhmc : public base_xhmc { public: diag_e_xhmc(const Model& model, BaseRNG& rng) : base_xhmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/adapt_diag_e_xhmc.hpp0000644000176200001440000000320313766554456025370 0ustar liggesusers#ifndef STAN_MCMC_HMC_XHMC_ADAPT_DIAG_E_XHMC_HPP #define STAN_MCMC_HMC_XHMC_ADAPT_DIAG_E_XHMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Euclidean disintegration and adaptive * diagonal metric and adaptive step size */ template class adapt_diag_e_xhmc : public diag_e_xhmc, public stepsize_var_adapter { public: adapt_diag_e_xhmc(const Model& model, BaseRNG& rng) : diag_e_xhmc(model, rng), stepsize_var_adapter(model.num_params_r()) {} ~adapt_diag_e_xhmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = diag_e_xhmc::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->var_adaptation_.learn_variance(this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/adapt_dense_e_xhmc.hpp0000644000176200001440000000314613766554456025570 0ustar liggesusers#ifndef STAN_MCMC_HMC_XHMC_ADAPT_DENSE_E_XHMC_HPP #define STAN_MCMC_HMC_XHMC_ADAPT_DENSE_E_XHMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Euclidean disintegration and adaptive * dense metric and adaptive step size */ template class adapt_dense_e_xhmc : public dense_e_xhmc, public stepsize_covar_adapter { public: adapt_dense_e_xhmc(const Model& model, BaseRNG& rng) : dense_e_xhmc(model, rng), stepsize_covar_adapter(model.num_params_r()) {} ~adapt_dense_e_xhmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = dense_e_xhmc::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->covar_adaptation_.learn_covariance( this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/unit_e_xhmc.hpp0000644000176200001440000000142213766554456024273 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_UNIT_E_XHMC_HPP #define STAN_MCMC_HMC_NUTS_UNIT_E_XHMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Euclidean disintegration and unit metric */ template class unit_e_xhmc : public base_xhmc { public: unit_e_xhmc(const Model& model, BaseRNG& rng) : base_xhmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/dense_e_xhmc.hpp0000644000176200001440000000143313766554456024414 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_DENSE_E_XHMC_HPP #define STAN_MCMC_HMC_NUTS_DENSE_E_XHMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Euclidean disintegration and dense metric */ template class dense_e_xhmc : public base_xhmc { public: dense_e_xhmc(const Model& model, BaseRNG& rng) : base_xhmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/adapt_unit_e_xhmc.hpp0000644000176200001440000000234113766554456025445 0ustar liggesusers#ifndef STAN_MCMC_HMC_XHMC_ADAPT_UNIT_E_XHMC_HPP #define STAN_MCMC_HMC_XHMC_ADAPT_UNIT_E_XHMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Euclidean disintegration and unit metric * and adaptive step size */ template class adapt_unit_e_xhmc : public unit_e_xhmc, public stepsize_adapter { public: adapt_unit_e_xhmc(const Model& model, BaseRNG& rng) : unit_e_xhmc(model, rng) {} ~adapt_unit_e_xhmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = unit_e_xhmc::transition(init_sample, logger); if (this->adapt_flag_) this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/adapt_softabs_xhmc.hpp0000644000176200001440000000235713766554456025632 0ustar liggesusers#ifndef STAN_MCMC_HMC_XHMC_ADAPT_SOFTABS_XHMC_HPP #define STAN_MCMC_HMC_XHMC_ADAPT_SOFTABS_XHMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Riemannian disintegration and SoftAbs metric * and adaptive step size */ template class adapt_softabs_xhmc : public softabs_xhmc, public stepsize_adapter { public: adapt_softabs_xhmc(const Model& model, BaseRNG& rng) : softabs_xhmc(model, rng) {} ~adapt_softabs_xhmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = softabs_xhmc::transition(init_sample, logger); if (this->adapt_flag_) this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/base_xhmc.hpp0000644000176200001440000002174113766554456023730 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_BASE_XHMC_HPP #define STAN_MCMC_HMC_NUTS_BASE_XHMC_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { /** * Exhaustive Hamiltonian Monte Carlo (XHMC) with multinomial sampling. * See http://arxiv.org/abs/1601.00225. */ template class Hamiltonian, template class Integrator, class BaseRNG> class base_xhmc : public base_hmc { public: base_xhmc(const Model& model, BaseRNG& rng) : base_hmc(model, rng), depth_(0), max_depth_(5), max_deltaH_(1000), x_delta_(0.1), n_leapfrog_(0), divergent_(0), energy_(0) {} ~base_xhmc() {} void set_max_depth(int d) { if (d > 0) max_depth_ = d; } void set_max_deltaH(double d) { max_deltaH_ = d; } void set_x_delta(double d) { if (d > 0) x_delta_ = d; } int get_max_depth() { return this->max_depth_; } double get_max_deltaH() { return this->max_deltaH_; } double get_x_delta() { return this->x_delta_; } sample transition(sample& init_sample, callbacks::logger& logger) { // Initialize the algorithm this->sample_stepsize(); this->seed(init_sample.cont_params()); this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); ps_point z_plus(this->z_); ps_point z_minus(z_plus); ps_point z_sample(z_plus); ps_point z_propose(z_plus); double ave = this->hamiltonian_.dG_dt(this->z_, logger); double log_sum_weight = 0; // log(exp(H0 - H0)) double H0 = this->hamiltonian_.H(this->z_); int n_leapfrog = 0; double sum_metro_prob = 1; // exp(H0 - H0) // Build a trajectory until the NUTS criterion is no longer satisfied this->depth_ = 0; this->divergent_ = 0; while (this->depth_ < this->max_depth_) { // Build a new subtree in a random direction bool valid_subtree = false; double ave_subtree = 0; double log_sum_weight_subtree = -std::numeric_limits::infinity(); if (this->rand_uniform_() > 0.5) { this->z_.ps_point::operator=(z_plus); valid_subtree = build_tree(this->depth_, z_propose, ave_subtree, log_sum_weight_subtree, H0, 1, n_leapfrog, sum_metro_prob, logger); z_plus.ps_point::operator=(this->z_); } else { this->z_.ps_point::operator=(z_minus); valid_subtree = build_tree(this->depth_, z_propose, ave_subtree, log_sum_weight_subtree, H0, -1, n_leapfrog, sum_metro_prob, logger); z_minus.ps_point::operator=(this->z_); } if (!valid_subtree) break; std::tie(ave, log_sum_weight) = stable_sum( ave, log_sum_weight, ave_subtree, log_sum_weight_subtree); // Sample from an accepted subtree ++(this->depth_); double accept_prob = std::exp(log_sum_weight_subtree - log_sum_weight); if (this->rand_uniform_() < accept_prob) z_sample = z_propose; // Break if exhaustion criterion is satisfied if (std::fabs(ave) < x_delta_) break; } this->n_leapfrog_ = n_leapfrog; // Compute average acceptance probabilty across entire trajectory, // even over subtrees that may have been rejected double accept_prob = sum_metro_prob / static_cast(n_leapfrog + 1); this->z_.ps_point::operator=(z_sample); this->energy_ = this->hamiltonian_.H(this->z_); return sample(this->z_.q, -this->z_.V, accept_prob); } void get_sampler_param_names(std::vector& names) { names.push_back("stepsize__"); names.push_back("treedepth__"); names.push_back("n_leapfrog__"); names.push_back("divergent__"); names.push_back("energy__"); } void get_sampler_params(std::vector& values) { values.push_back(this->epsilon_); values.push_back(this->depth_); values.push_back(this->n_leapfrog_); values.push_back(this->divergent_); values.push_back(this->energy_); } /** * Recursively build a new subtree to completion or until * the subtree becomes invalid. Returns validity of the * resulting subtree. * * @param depth Depth of the desired subtree * @param z_propose State proposed from subtree * @param ave Weighted average of dG/dt across trajectory * @param log_sum_weight Log of summed weights across trajectory * @param H0 Hamiltonian of initial state * @param sign Direction in time to built subtree * @param n_leapfrog Summed number of leapfrog evaluations * @param sum_metro_prob Summed Metropolis probabilities across trajectory * @param logger Logger for messages * @return whether built tree is valid */ bool build_tree(int depth, ps_point& z_propose, double& ave, double& log_sum_weight, double H0, double sign, int& n_leapfrog, double& sum_metro_prob, callbacks::logger& logger) { // Base case if (depth == 0) { this->integrator_.evolve(this->z_, this->hamiltonian_, sign * this->epsilon_, logger); ++n_leapfrog; double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); if ((h - H0) > this->max_deltaH_) this->divergent_ = true; double dG_dt = this->hamiltonian_.dG_dt(this->z_, logger); std::tie(ave, log_sum_weight) = stable_sum(ave, log_sum_weight, dG_dt, H0 - h); if (H0 - h > 0) sum_metro_prob += 1; else sum_metro_prob += std::exp(H0 - h); z_propose = this->z_; return !this->divergent_; } // General recursion // Build the left subtree double ave_left = 0; double log_sum_weight_left = -std::numeric_limits::infinity(); bool valid_left = build_tree(depth - 1, z_propose, ave_left, log_sum_weight_left, H0, sign, n_leapfrog, sum_metro_prob, logger); if (!valid_left) return false; std::tie(ave, log_sum_weight) = stable_sum(ave, log_sum_weight, ave_left, log_sum_weight_left); // Build the right subtree ps_point z_propose_right(this->z_); double ave_right = 0; double log_sum_weight_right = -std::numeric_limits::infinity(); bool valid_right = build_tree(depth - 1, z_propose_right, ave_right, log_sum_weight_right, H0, sign, n_leapfrog, sum_metro_prob, logger); if (!valid_right) return false; std::tie(ave, log_sum_weight) = stable_sum(ave, log_sum_weight, ave_right, log_sum_weight_right); // Multinomial sample from right subtree double ave_subtree; double log_sum_weight_subtree; std::tie(ave_subtree, log_sum_weight_subtree) = stable_sum( ave_left, log_sum_weight_left, ave_right, log_sum_weight_right); double accept_prob = std::exp(log_sum_weight_right - log_sum_weight_subtree); if (this->rand_uniform_() < accept_prob) z_propose = z_propose_right; return std::abs(ave_subtree) >= x_delta_; } /** * a1 and a2 are running averages of the form * \f$ a1 = ( \sum_{n \in N1} w_{n} f_{n} ) * / ( \sum_{n \in N1} w_{n} ) \f$ * \f$ a2 = ( \sum_{n \in N2} w_{n} f_{n} ) * / ( \sum_{n \in N2} w_{n} ) \f$ * and the weights are the respective normalizing constants * \f$ w1 = \sum_{n \in N1} w_{n} \f$ * \f$ w2 = \sum_{n \in N2} w_{n}. \f$ * * This function returns the pooled average * \f$ sum_a = ( \sum_{n \in N1 \cup N2} w_{n} f_{n} ) * / ( \sum_{n \in N1 \cup N2} w_{n} ) \f$ * and the pooled weights * \f$ log_sum_w = log(w1 + w2). \f$ * * @param[in] a1 First running average, f1 / w1 * @param[in] log_w1 Log of first summed weight * @param[in] a2 Second running average * @param[in] log_w2 Log of second summed weight * @return Pair of average of input running averages and log of summed input * weights */ static std::pair stable_sum(double a1, double log_w1, double a2, double log_w2) { if (log_w2 > log_w1) { const double e = std::exp(log_w1 - log_w2); return std::make_pair((e * a1 + a2) / (1 + e), log_w2 + std::log1p(e)); } else { const double e = std::exp(log_w2 - log_w1); return std::make_pair((a1 + e * a2) / (1 + e), log_w1 + std::log1p(e)); } } int depth_; int max_depth_; double max_deltaH_; double x_delta_; int n_leapfrog_; bool divergent_; double energy_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/xhmc/softabs_xhmc.hpp0000644000176200001440000000143613766554456024456 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_SOFTABS_XHMC_HPP #define STAN_MCMC_HMC_NUTS_SOFTABS_XHMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Exhausive Hamiltonian Monte Carlo (XHMC) with multinomial sampling * with a Gaussian-Riemannian disintegration and SoftAbs metric */ template class softabs_xhmc : public base_xhmc { public: softabs_xhmc(const Model& model, BaseRNG& rng) : base_xhmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/0000755000176200001440000000000013766554456023350 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/adapt_softabs_static_uniform.hpp0000644000176200001440000000271613766554456032007 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_ADAPT_SOFTABS_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_ADAPT_SOFTABS_STATIC_HMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Riemannian disintegration and SoftAbs metric and * adaptive step size */ template class adapt_softabs_static_uniform : public softabs_static_uniform, public stepsize_adapter { public: adapt_softabs_static_uniform(const Model& model, BaseRNG& rng) : softabs_static_uniform(model, rng) {} ~adapt_softabs_static_uniform() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = softabs_static_uniform::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); this->update_L_(); } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/dense_e_static_uniform.hpp0000644000176200001440000000173713766554456030601 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIFORM_DENSE_E_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_STATIC_UNIFORM_DENSE_E_STATIC_UNIFORM_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Euclidean disintegration and dense metric */ template class dense_e_static_uniform : public base_static_uniform { public: dense_e_static_uniform(const Model& model, BaseRNG& rng) : base_static_uniform( model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/unit_e_static_uniform.hpp0000644000176200001440000000166513766554456030462 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIFORM_UNIT_E_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_STATIC_UNIFORM_UNIT_E_STATIC_UNIFORM_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Euclidean disintegration and unit metric */ template class unit_e_static_uniform : public base_static_uniform { public: unit_e_static_uniform(const Model& model, BaseRNG& rng) : base_static_uniform( model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/diag_e_static_uniform.hpp0000644000176200001440000000167113766554456030404 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIFORM_DIAG_E_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_STATIC_UNIFORM_DIAG_E_STATIC_UNIFORM_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Euclidean disintegration and diagonal metric */ template class diag_e_static_uniform : public base_static_uniform { public: diag_e_static_uniform(const Model& model, BaseRNG& rng) : base_static_uniform( model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/base_static_uniform.hpp0000644000176200001440000000764213766554456030112 0ustar liggesusers#ifndef STAN_MCMC_HMC_UNIFORM_BASE_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_UNIFORM_BASE_STATIC_UNIFORM_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time */ template class Hamiltonian, template class Integrator, class BaseRNG> class base_static_uniform : public base_hmc { public: base_static_uniform(const Model& model, BaseRNG& rng) : base_hmc(model, rng), T_(1), energy_(0) { update_L_(); } ~base_static_uniform() {} sample transition(sample& init_sample, callbacks::logger& logger) { this->sample_stepsize(); this->seed(init_sample.cont_params()); this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); ps_point z_init(this->z_); double H0 = this->hamiltonian_.H(this->z_); ps_point z_sample(this->z_); double sum_prob = 1; double sum_metro_prob = 1; boost::random::uniform_int_distribution<> uniform(0, L_ - 1); int Lp = uniform(this->rand_int_); for (int l = 0; l < Lp; ++l) { this->integrator_.evolve(this->z_, this->hamiltonian_, -this->epsilon_, logger); double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); double prob = std::exp(H0 - h); sum_prob += prob; sum_metro_prob += prob > 1 ? 1 : prob; if (this->rand_uniform_() < prob / sum_prob) z_sample = this->z_; } this->z_.ps_point::operator=(z_init); for (int l = 0; l < L_ - 1 - Lp; ++l) { this->integrator_.evolve(this->z_, this->hamiltonian_, this->epsilon_, logger); double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); double prob = std::exp(H0 - h); sum_prob += prob; sum_metro_prob += prob > 1 ? 1 : prob; if (this->rand_uniform_() < prob / sum_prob) z_sample = this->z_; } double accept_prob = sum_metro_prob / static_cast(L_); this->z_.ps_point::operator=(z_sample); this->energy_ = this->hamiltonian_.H(this->z_); return sample(this->z_.q, -this->hamiltonian_.V(this->z_), accept_prob); } void get_sampler_param_names(std::vector& names) { names.push_back("stepsize__"); names.push_back("int_time__"); names.push_back("energy__"); } void get_sampler_params(std::vector& values) { values.push_back(this->epsilon_); values.push_back(this->T_); values.push_back(this->energy_); } void set_nominal_stepsize_and_T(const double e, const double t) { if (e > 0 && t > 0) { this->nom_epsilon_ = e; T_ = t; update_L_(); } } void set_nominal_stepsize_and_L(const double e, const int l) { if (e > 0 && l > 0) { this->nom_epsilon_ = e; L_ = l; T_ = this->nom_epsilon_ * L_; } } void set_T(const double t) { if (t > 0) { T_ = t; update_L_(); } } void set_nominal_stepsize(const double e) { if (e > 0) { this->nom_epsilon_ = e; update_L_(); } } double get_T() { return this->T_; } int get_L() { return this->L_; } protected: double T_; int L_; double energy_; void update_L_() { L_ = static_cast(T_ / this->nom_epsilon_); L_ = L_ < 1 ? 1 : L_; } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/softabs_static_uniform.hpp0000644000176200001440000000174213766554456030634 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIFORM_SOFTABS_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_STATIC_UNIFORM_SOFTABS_STATIC_UNIFORM_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Riemannian disintegration and SoftAbs metric */ template class softabs_static_uniform : public base_static_uniform { public: softabs_static_uniform(const Model& model, BaseRNG& rng) : base_static_uniform( model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/adapt_diag_e_static_uniform.hpp0000644000176200001440000000346713766554456031562 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIFORM_ADAPT_DIAG_E_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_STATIC_UNIFORM_ADAPT_DIAG_E_STATIC_UNIFORM_HPP #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Euclidean disintegration and adaptive diagonal metric and * adaptive step size */ template class adapt_diag_e_static_uniform : public diag_e_static_uniform, public stepsize_var_adapter { public: adapt_diag_e_static_uniform(const Model& model, BaseRNG& rng) : diag_e_static_uniform(model, rng), stepsize_var_adapter(model.num_params_r()) {} ~adapt_diag_e_static_uniform() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = diag_e_static_uniform::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->var_adaptation_.learn_variance(this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/adapt_unit_e_static_uniform.hpp0000644000176200001440000000270113766554456031623 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_ADAPT_UNIT_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_ADAPT_UNIT_E_STATIC_HMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Euclidean disintegration and unit metric and * adaptive step size */ template class adapt_unit_e_static_uniform : public unit_e_static_uniform, public stepsize_adapter { public: adapt_unit_e_static_uniform(const Model& model, BaseRNG& rng) : unit_e_static_uniform(model, rng) {} ~adapt_unit_e_static_uniform() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = unit_e_static_uniform::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); this->update_L_(); } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static_uniform/adapt_dense_e_static_uniform.hpp0000644000176200001440000000343313766554456031745 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIFORM_ADAPT_DENSE_E_STATIC_UNIFORM_HPP #define STAN_MCMC_HMC_STATIC_UNIFORM_ADAPT_DENSE_E_STATIC_UNIFORM_HPP #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation that uniformly samples * from trajectories with a static integration time with a * Gaussian-Euclidean disintegration and adaptive dense metric and * adaptive step size */ template class adapt_dense_e_static_uniform : public dense_e_static_uniform, public stepsize_covar_adapter { public: adapt_dense_e_static_uniform(const Model& model, BaseRNG& rng) : dense_e_static_uniform(model, rng), stepsize_covar_adapter(model.num_params_r()) {} ~adapt_dense_e_static_uniform() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = dense_e_static_uniform::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->covar_adaptation_.learn_covariance( this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/0000755000176200001440000000000013766554456021611 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/static/diag_e_static_hmc.hpp0000644000176200001440000000166513766554456025740 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_DIAG_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_DIAG_E_STATIC_HMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Euclidean disintegration and diagonal metric */ template class diag_e_static_hmc : public base_static_hmc { public: diag_e_static_hmc(const Model& model, BaseRNG& rng) : base_static_hmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/softabs_static_hmc.hpp0000644000176200001440000000167613766554456026173 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_SOFTABS_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_SOFTABS_STATIC_HMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Riemannian disintegration and SoftAbs metric */ template class softabs_static_hmc : public base_static_hmc { public: softabs_static_hmc(const Model& model, BaseRNG& rng) : base_static_hmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/unit_e_static_hmc.hpp0000644000176200001440000000166113766554456026007 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_UNIT_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_UNIT_E_STATIC_HMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Euclidean disintegration and unit metric */ template class unit_e_static_hmc : public base_static_hmc { public: unit_e_static_hmc(const Model& model, BaseRNG& rng) : base_static_hmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/adapt_diag_e_static_hmc.hpp0000644000176200001440000000345213766554456027105 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_ADAPT_DIAG_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_ADAPT_DIAG_E_STATIC_HMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Euclidean disintegration and adaptive diagonal metric and * adaptive step size */ template class adapt_diag_e_static_hmc : public diag_e_static_hmc, public stepsize_var_adapter { public: adapt_diag_e_static_hmc(const Model& model, BaseRNG& rng) : diag_e_static_hmc(model, rng), stepsize_var_adapter(model.num_params_r()) {} ~adapt_diag_e_static_hmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = diag_e_static_hmc::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); this->update_L_(); bool update = this->var_adaptation_.learn_variance(this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->update_L_(); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/adapt_dense_e_static_hmc.hpp0000644000176200001440000000341413766554456027275 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_ADAPT_DENSE_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_ADAPT_DENSE_E_STATIC_HMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Euclidean disintegration and adative dense metric and * adaptive step size */ template class adapt_dense_e_static_hmc : public dense_e_static_hmc, public stepsize_covar_adapter { public: adapt_dense_e_static_hmc(const Model& model, BaseRNG& rng) : dense_e_static_hmc(model, rng), stepsize_covar_adapter(model.num_params_r()) {} ~adapt_dense_e_static_hmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = dense_e_static_hmc::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); this->update_L_(); bool update = this->covar_adaptation_.learn_covariance( this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->update_L_(); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/adapt_unit_e_static_hmc.hpp0000644000176200001440000000256513766554456027164 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_ADAPT_UNIT_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_ADAPT_UNIT_E_STATIC_HMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Euclidean disintegration and unit metric and * adaptive step size */ template class adapt_unit_e_static_hmc : public unit_e_static_hmc, public stepsize_adapter { public: adapt_unit_e_static_hmc(const Model& model, BaseRNG& rng) : unit_e_static_hmc(model, rng) {} ~adapt_unit_e_static_hmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = unit_e_static_hmc::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); this->update_L_(); } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/base_static_hmc.hpp0000644000176200001440000000631413766554456025436 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_BASE_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_BASE_STATIC_HMC_HPP #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time */ template class Hamiltonian, template class Integrator, class BaseRNG> class base_static_hmc : public base_hmc { public: base_static_hmc(const Model& model, BaseRNG& rng) : base_hmc(model, rng), T_(1), energy_(0) { update_L_(); } ~base_static_hmc() {} void set_metric(const Eigen::MatrixXd& inv_e_metric) { this->z_.set_metric(inv_e_metric); } void set_metric(const Eigen::VectorXd& inv_e_metric) { this->z_.set_metric(inv_e_metric); } sample transition(sample& init_sample, callbacks::logger& logger) { this->sample_stepsize(); this->seed(init_sample.cont_params()); this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); ps_point z_init(this->z_); double H0 = this->hamiltonian_.H(this->z_); for (int i = 0; i < L_; ++i) this->integrator_.evolve(this->z_, this->hamiltonian_, this->epsilon_, logger); double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); double acceptProb = std::exp(H0 - h); if (acceptProb < 1 && this->rand_uniform_() > acceptProb) this->z_.ps_point::operator=(z_init); acceptProb = acceptProb > 1 ? 1 : acceptProb; this->energy_ = this->hamiltonian_.H(this->z_); return sample(this->z_.q, -this->hamiltonian_.V(this->z_), acceptProb); } void get_sampler_param_names(std::vector& names) { names.push_back("stepsize__"); names.push_back("int_time__"); names.push_back("energy__"); } void get_sampler_params(std::vector& values) { values.push_back(this->epsilon_); values.push_back(this->T_); values.push_back(this->energy_); } void set_nominal_stepsize_and_T(const double e, const double t) { if (e > 0 && t > 0) { this->nom_epsilon_ = e; T_ = t; update_L_(); } } void set_nominal_stepsize_and_L(const double e, const int l) { if (e > 0 && l > 0) { this->nom_epsilon_ = e; L_ = l; T_ = this->nom_epsilon_ * L_; } } void set_T(const double t) { if (t > 0) { T_ = t; update_L_(); } } void set_nominal_stepsize(const double e) { if (e > 0) { this->nom_epsilon_ = e; update_L_(); } } double get_T() { return this->T_; } int get_L() { return this->L_; } protected: double T_; int L_; double energy_; void update_L_() { L_ = static_cast(T_ / this->nom_epsilon_); L_ = L_ < 1 ? 1 : L_; } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/dense_e_static_hmc.hpp0000644000176200001440000000167313766554456026131 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_DENSE_E_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_DENSE_E_STATIC_HMC_HPP #include #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Euclidean disintegration and dense metric */ template class dense_e_static_hmc : public base_static_hmc { public: dense_e_static_hmc(const Model& model, BaseRNG& rng) : base_static_hmc(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/static/adapt_softabs_static_hmc.hpp0000644000176200001440000000260313766554456027333 0ustar liggesusers#ifndef STAN_MCMC_HMC_STATIC_ADAPT_SOFTABS_STATIC_HMC_HPP #define STAN_MCMC_HMC_STATIC_ADAPT_SOFTABS_STATIC_HMC_HPP #include #include #include namespace stan { namespace mcmc { /** * Hamiltonian Monte Carlo implementation using the endpoint * of trajectories with a static integration time with a * Gaussian-Riemannian disintegration and SoftAbs metric and * adaptive step size */ template class adapt_softabs_static_hmc : public softabs_static_hmc, public stepsize_adapter { public: adapt_softabs_static_hmc(const Model& model, BaseRNG& rng) : softabs_static_hmc(model, rng) {} ~adapt_softabs_static_hmc() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = softabs_static_hmc::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); this->update_L_(); } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/integrators/0000755000176200001440000000000013766554456022663 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/integrators/base_integrator.hpp0000644000176200001440000000077513766554456026555 0ustar liggesusers#ifndef STAN_MCMC_HMC_INTEGRATORS_BASE_INTEGRATOR_HPP #define STAN_MCMC_HMC_INTEGRATORS_BASE_INTEGRATOR_HPP #include namespace stan { namespace mcmc { template class base_integrator { public: base_integrator() {} virtual void evolve(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, const double epsilon, callbacks::logger& logger) = 0; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/integrators/expl_leapfrog.hpp0000644000176200001440000000223113766554456026221 0ustar liggesusers#ifndef STAN_MCMC_HMC_INTEGRATORS_EXPL_LEAPFROG_HPP #define STAN_MCMC_HMC_INTEGRATORS_EXPL_LEAPFROG_HPP #include #include #include namespace stan { namespace mcmc { template class expl_leapfrog : public base_leapfrog { public: expl_leapfrog() : base_leapfrog() {} void begin_update_p(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { z.p -= epsilon * hamiltonian.dphi_dq(z, logger); } void update_q(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { z.q += epsilon * hamiltonian.dtau_dp(z); hamiltonian.update_potential_gradient(z, logger); } void end_update_p(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { z.p -= epsilon * hamiltonian.dphi_dq(z, logger); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/integrators/impl_leapfrog.hpp0000644000176200001440000000550413766554456026220 0ustar liggesusers#ifndef STAN_MCMC_HMC_INTEGRATORS_IMPL_LEAPFROG_HPP #define STAN_MCMC_HMC_INTEGRATORS_IMPL_LEAPFROG_HPP #include #include namespace stan { namespace mcmc { template class impl_leapfrog : public base_leapfrog { public: impl_leapfrog() : base_leapfrog(), max_num_fixed_point_(10), fixed_point_threshold_(1e-8) {} void begin_update_p(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { hat_phi(z, hamiltonian, epsilon, logger); hat_tau(z, hamiltonian, epsilon, this->max_num_fixed_point_, logger); } void update_q(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { // hat{T} = dT/dp * d/dq Eigen::VectorXd q_init = z.q + 0.5 * epsilon * hamiltonian.dtau_dp(z); Eigen::VectorXd delta_q(z.q.size()); for (int n = 0; n < this->max_num_fixed_point_; ++n) { delta_q = z.q; z.q.noalias() = q_init + 0.5 * epsilon * hamiltonian.dtau_dp(z); hamiltonian.update_metric(z, logger); delta_q -= z.q; if (delta_q.cwiseAbs().maxCoeff() < this->fixed_point_threshold_) break; } hamiltonian.update_gradients(z, logger); } void end_update_p(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { hat_tau(z, hamiltonian, epsilon, 1, logger); hat_phi(z, hamiltonian, epsilon, logger); } // hat{phi} = dphi/dq * d/dp void hat_phi(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) { z.p -= epsilon * hamiltonian.dphi_dq(z, logger); } // hat{tau} = dtau/dq * d/dp void hat_tau(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, int num_fixed_point, callbacks::logger& logger) { Eigen::VectorXd p_init = z.p; Eigen::VectorXd delta_p(z.p.size()); for (int n = 0; n < num_fixed_point; ++n) { delta_p = z.p; z.p.noalias() = p_init - epsilon * hamiltonian.dtau_dq(z, logger); delta_p -= z.p; if (delta_p.cwiseAbs().maxCoeff() < this->fixed_point_threshold_) break; } } int max_num_fixed_point() { return this->max_num_fixed_point_; } void set_max_num_fixed_point(int n) { if (n > 0) this->max_num_fixed_point_ = n; } double fixed_point_threshold() { return this->fixed_point_threshold_; } void set_fixed_point_threshold(double t) { if (t > 0) this->fixed_point_threshold_ = t; } private: int max_num_fixed_point_; double fixed_point_threshold_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/integrators/base_leapfrog.hpp0000644000176200001440000000743213766554456026173 0ustar liggesusers#ifndef STAN_MCMC_HMC_INTEGRATORS_BASE_LEAPFROG_HPP #define STAN_MCMC_HMC_INTEGRATORS_BASE_LEAPFROG_HPP #include #include #include #include namespace stan { namespace mcmc { template class base_leapfrog : public base_integrator { public: base_leapfrog() : base_integrator() {} void evolve(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, const double epsilon, callbacks::logger& logger) { begin_update_p(z, hamiltonian, 0.5 * epsilon, logger); update_q(z, hamiltonian, epsilon, logger); end_update_p(z, hamiltonian, 0.5 * epsilon, logger); } void verbose_evolve(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, const double epsilon, callbacks::logger& logger) { std::stringstream msg; msg.precision(6); int width = 14; int nColumn = 4; msg << "Verbose Hamiltonian Evolution, Step Size = " << epsilon << ":"; logger.info(msg); msg.str(""); msg << " " << std::setw(nColumn * width) << std::setfill('-') << "" << std::setfill(' '); logger.info(msg); msg.str(""); msg << " " << std::setw(width) << std::left << "Poisson" << std::setw(width) << std::left << "Initial" << std::setw(width) << std::left << "Current" << std::setw(width) << std::left << "DeltaH"; logger.info(msg); msg.str(""); msg << " " << std::setw(width) << std::left << "Operator" << std::setw(width) << std::left << "Hamiltonian" << std::setw(width) << std::left << "Hamiltonian" << std::setw(width) << std::left << "/ Stepsize^{2}"; logger.info(msg); msg.str(""); msg << " " << std::setw(nColumn * width) << std::setfill('-') << "" << std::setfill(' '); logger.info(msg); double H0 = hamiltonian.H(z); begin_update_p(z, hamiltonian, 0.5 * epsilon, logger); double H1 = hamiltonian.H(z); msg.str(""); msg << " " << std::setw(width) << std::left << "hat{V}/2" << std::setw(width) << std::left << H0 << std::setw(width) << std::left << H1 << std::setw(width) << std::left << (H1 - H0) / (epsilon * epsilon); logger.info(msg); update_q(z, hamiltonian, epsilon, logger); double H2 = hamiltonian.H(z); msg.str(""); msg << " " << std::setw(width) << std::left << "hat{T}" << std::setw(width) << std::left << H0 << std::setw(width) << std::left << H2 << std::setw(width) << std::left << (H2 - H0) / (epsilon * epsilon); logger.info(msg); end_update_p(z, hamiltonian, 0.5 * epsilon, logger); double H3 = hamiltonian.H(z); msg.str(""); msg << " " << std::setw(width) << std::left << "hat{V}/2" << std::setw(width) << std::left << H0 << std::setw(width) << std::left << H3 << std::setw(width) << std::left << (H3 - H0) / (epsilon * epsilon); logger.info(msg); msg.str(""); msg << " " << std::setw(nColumn * width) << std::setfill('-') << "" << std::setfill(' '); logger.info(msg); } virtual void begin_update_p(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) = 0; virtual void update_q(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) = 0; virtual void end_update_p(typename Hamiltonian::PointType& z, Hamiltonian& hamiltonian, double epsilon, callbacks::logger& logger) = 0; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/0000755000176200001440000000000013766554456021313 5ustar liggesusersStanHeaders/inst/include/src/stan/mcmc/hmc/nuts/adapt_softabs_nuts.hpp0000644000176200001440000000234313766554456025711 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_ADAPT_SOFTABS_NUTS_HPP #define STAN_MCMC_HMC_NUTS_ADAPT_SOFTABS_NUTS_HPP #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Riemannian disintegration and SoftAbs metric * and adaptive step size */ template class adapt_softabs_nuts : public softabs_nuts, public stepsize_adapter { public: adapt_softabs_nuts(const Model& model, BaseRNG& rng) : softabs_nuts(model, rng) {} ~adapt_softabs_nuts() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = softabs_nuts::transition(init_sample, logger); if (this->adapt_flag_) this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/unit_e_nuts.hpp0000644000176200001440000000140613766554456024361 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_UNIT_E_NUTS_HPP #define STAN_MCMC_HMC_NUTS_UNIT_E_NUTS_HPP #include #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Euclidean disintegration and unit metric */ template class unit_e_nuts : public base_nuts { public: unit_e_nuts(const Model& model, BaseRNG& rng) : base_nuts(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/base_nuts.hpp0000644000176200001440000002766413766554456024026 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_BASE_NUTS_HPP #define STAN_MCMC_HMC_NUTS_BASE_NUTS_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling */ template class Hamiltonian, template class Integrator, class BaseRNG> class base_nuts : public base_hmc { public: base_nuts(const Model& model, BaseRNG& rng) : base_hmc(model, rng), depth_(0), max_depth_(5), max_deltaH_(1000), n_leapfrog_(0), divergent_(false), energy_(0) {} /** * specialized constructor for specified diag mass matrix */ base_nuts(const Model& model, BaseRNG& rng, Eigen::VectorXd& inv_e_metric) : base_hmc(model, rng, inv_e_metric), depth_(0), max_depth_(5), max_deltaH_(1000), n_leapfrog_(0), divergent_(false), energy_(0) {} /** * specialized constructor for specified dense mass matrix */ base_nuts(const Model& model, BaseRNG& rng, Eigen::MatrixXd& inv_e_metric) : base_hmc(model, rng, inv_e_metric), depth_(0), max_depth_(5), max_deltaH_(1000), n_leapfrog_(0), divergent_(false), energy_(0) {} ~base_nuts() {} void set_metric(const Eigen::MatrixXd& inv_e_metric) { this->z_.set_metric(inv_e_metric); } void set_metric(const Eigen::VectorXd& inv_e_metric) { this->z_.set_metric(inv_e_metric); } void set_max_depth(int d) { if (d > 0) max_depth_ = d; } void set_max_delta(double d) { max_deltaH_ = d; } int get_max_depth() { return this->max_depth_; } double get_max_delta() { return this->max_deltaH_; } sample transition(sample& init_sample, callbacks::logger& logger) { // Initialize the algorithm this->sample_stepsize(); this->seed(init_sample.cont_params()); this->hamiltonian_.sample_p(this->z_, this->rand_int_); this->hamiltonian_.init(this->z_, logger); ps_point z_fwd(this->z_); // State at forward end of trajectory ps_point z_bck(z_fwd); // State at backward end of trajectory ps_point z_sample(z_fwd); ps_point z_propose(z_fwd); // Momentum and sharp momentum at forward end of forward subtree Eigen::VectorXd p_fwd_fwd = this->z_.p; Eigen::VectorXd p_sharp_fwd_fwd = this->hamiltonian_.dtau_dp(this->z_); // Momentum and sharp momentum at backward end of forward subtree Eigen::VectorXd p_fwd_bck = this->z_.p; Eigen::VectorXd p_sharp_fwd_bck = p_sharp_fwd_fwd; // Momentum and sharp momentum at forward end of backward subtree Eigen::VectorXd p_bck_fwd = this->z_.p; Eigen::VectorXd p_sharp_bck_fwd = p_sharp_fwd_fwd; // Momentum and sharp momentum at backward end of backward subtree Eigen::VectorXd p_bck_bck = this->z_.p; Eigen::VectorXd p_sharp_bck_bck = p_sharp_fwd_fwd; // Integrated momenta along trajectory Eigen::VectorXd rho = this->z_.p.transpose(); // Log sum of state weights (offset by H0) along trajectory double log_sum_weight = 0; // log(exp(H0 - H0)) double H0 = this->hamiltonian_.H(this->z_); int n_leapfrog = 0; double sum_metro_prob = 0; // Build a trajectory until the no-u-turn // criterion is no longer satisfied this->depth_ = 0; this->divergent_ = false; while (this->depth_ < this->max_depth_) { // Build a new subtree in a random direction Eigen::VectorXd rho_fwd = Eigen::VectorXd::Zero(rho.size()); Eigen::VectorXd rho_bck = Eigen::VectorXd::Zero(rho.size()); bool valid_subtree = false; double log_sum_weight_subtree = -std::numeric_limits::infinity(); if (this->rand_uniform_() > 0.5) { // Extend the current trajectory forward this->z_.ps_point::operator=(z_fwd); rho_bck = rho; p_bck_fwd = p_fwd_fwd; p_sharp_bck_fwd = p_sharp_fwd_fwd; valid_subtree = build_tree( this->depth_, z_propose, p_sharp_fwd_bck, p_sharp_fwd_fwd, rho_fwd, p_fwd_bck, p_fwd_fwd, H0, 1, n_leapfrog, log_sum_weight_subtree, sum_metro_prob, logger); z_fwd.ps_point::operator=(this->z_); } else { // Extend the current trajectory backwards this->z_.ps_point::operator=(z_bck); rho_fwd = rho; p_fwd_bck = p_bck_bck; p_sharp_fwd_bck = p_sharp_bck_bck; valid_subtree = build_tree( this->depth_, z_propose, p_sharp_bck_fwd, p_sharp_bck_bck, rho_bck, p_bck_fwd, p_bck_bck, H0, -1, n_leapfrog, log_sum_weight_subtree, sum_metro_prob, logger); z_bck.ps_point::operator=(this->z_); } if (!valid_subtree) break; // Sample from accepted subtree ++(this->depth_); if (log_sum_weight_subtree > log_sum_weight) { z_sample = z_propose; } else { double accept_prob = std::exp(log_sum_weight_subtree - log_sum_weight); if (this->rand_uniform_() < accept_prob) z_sample = z_propose; } log_sum_weight = math::log_sum_exp(log_sum_weight, log_sum_weight_subtree); // Break when no-u-turn criterion is no longer satisfied rho = rho_bck + rho_fwd; // Demand satisfaction around merged subtrees bool persist_criterion = compute_criterion(p_sharp_bck_bck, p_sharp_fwd_fwd, rho); // Demand satisfaction between subtrees Eigen::VectorXd rho_extended = rho_bck + p_fwd_bck; persist_criterion &= compute_criterion(p_sharp_bck_bck, p_sharp_fwd_bck, rho_extended); rho_extended = rho_fwd + p_bck_fwd; persist_criterion &= compute_criterion(p_sharp_bck_fwd, p_sharp_fwd_fwd, rho_extended); if (!persist_criterion) break; } this->n_leapfrog_ = n_leapfrog; // Compute average acceptance probabilty across entire trajectory, // even over subtrees that may have been rejected double accept_prob = sum_metro_prob / static_cast(n_leapfrog); this->z_.ps_point::operator=(z_sample); this->energy_ = this->hamiltonian_.H(this->z_); return sample(this->z_.q, -this->z_.V, accept_prob); } void get_sampler_param_names(std::vector& names) { names.push_back("stepsize__"); names.push_back("treedepth__"); names.push_back("n_leapfrog__"); names.push_back("divergent__"); names.push_back("energy__"); } void get_sampler_params(std::vector& values) { values.push_back(this->epsilon_); values.push_back(this->depth_); values.push_back(this->n_leapfrog_); values.push_back(this->divergent_); values.push_back(this->energy_); } virtual bool compute_criterion(Eigen::VectorXd& p_sharp_minus, Eigen::VectorXd& p_sharp_plus, Eigen::VectorXd& rho) { return p_sharp_plus.dot(rho) > 0 && p_sharp_minus.dot(rho) > 0; } /** * Recursively build a new subtree to completion or until * the subtree becomes invalid. Returns validity of the * resulting subtree. * * @param depth Depth of the desired subtree * @param z_propose State proposed from subtree * @param p_sharp_beg Sharp momentum at beginning of new tree * @param p_sharp_end Sharp momentum at end of new tree * @param rho Summed momentum across trajectory * @param p_beg Momentum at beginning of returned tree * @param p_end Momentum at end of returned tree * @param H0 Hamiltonian of initial state * @param sign Direction in time to built subtree * @param n_leapfrog Summed number of leapfrog evaluations * @param log_sum_weight Log of summed weights across trajectory * @param sum_metro_prob Summed Metropolis probabilities across trajectory * @param logger Logger for messages */ bool build_tree(int depth, ps_point& z_propose, Eigen::VectorXd& p_sharp_beg, Eigen::VectorXd& p_sharp_end, Eigen::VectorXd& rho, Eigen::VectorXd& p_beg, Eigen::VectorXd& p_end, double H0, double sign, int& n_leapfrog, double& log_sum_weight, double& sum_metro_prob, callbacks::logger& logger) { // Base case if (depth == 0) { this->integrator_.evolve(this->z_, this->hamiltonian_, sign * this->epsilon_, logger); ++n_leapfrog; double h = this->hamiltonian_.H(this->z_); if (boost::math::isnan(h)) h = std::numeric_limits::infinity(); if ((h - H0) > this->max_deltaH_) this->divergent_ = true; log_sum_weight = math::log_sum_exp(log_sum_weight, H0 - h); if (H0 - h > 0) sum_metro_prob += 1; else sum_metro_prob += std::exp(H0 - h); z_propose = this->z_; p_sharp_beg = this->hamiltonian_.dtau_dp(this->z_); p_sharp_end = p_sharp_beg; rho += this->z_.p; p_beg = this->z_.p; p_end = p_beg; return !this->divergent_; } // General recursion // Build the initial subtree double log_sum_weight_init = -std::numeric_limits::infinity(); // Momentum and sharp momentum at end of the initial subtree Eigen::VectorXd p_init_end(this->z_.p.size()); Eigen::VectorXd p_sharp_init_end(this->z_.p.size()); Eigen::VectorXd rho_init = Eigen::VectorXd::Zero(rho.size()); bool valid_init = build_tree(depth - 1, z_propose, p_sharp_beg, p_sharp_init_end, rho_init, p_beg, p_init_end, H0, sign, n_leapfrog, log_sum_weight_init, sum_metro_prob, logger); if (!valid_init) return false; // Build the final subtree ps_point z_propose_final(this->z_); double log_sum_weight_final = -std::numeric_limits::infinity(); // Momentum and sharp momentum at beginning of the final subtree Eigen::VectorXd p_final_beg(this->z_.p.size()); Eigen::VectorXd p_sharp_final_beg(this->z_.p.size()); Eigen::VectorXd rho_final = Eigen::VectorXd::Zero(rho.size()); bool valid_final = build_tree(depth - 1, z_propose_final, p_sharp_final_beg, p_sharp_end, rho_final, p_final_beg, p_end, H0, sign, n_leapfrog, log_sum_weight_final, sum_metro_prob, logger); if (!valid_final) return false; // Multinomial sample from right subtree double log_sum_weight_subtree = math::log_sum_exp(log_sum_weight_init, log_sum_weight_final); log_sum_weight = math::log_sum_exp(log_sum_weight, log_sum_weight_subtree); if (log_sum_weight_final > log_sum_weight_subtree) { z_propose = z_propose_final; } else { double accept_prob = std::exp(log_sum_weight_final - log_sum_weight_subtree); if (this->rand_uniform_() < accept_prob) z_propose = z_propose_final; } Eigen::VectorXd rho_subtree = rho_init + rho_final; rho += rho_subtree; // Demand satisfaction around merged subtrees bool persist_criterion = compute_criterion(p_sharp_beg, p_sharp_end, rho_subtree); // Demand satisfaction between subtrees rho_subtree = rho_init + p_final_beg; persist_criterion &= compute_criterion(p_sharp_beg, p_sharp_final_beg, rho_subtree); rho_subtree = rho_final + p_init_end; persist_criterion &= compute_criterion(p_sharp_init_end, p_sharp_end, rho_subtree); return persist_criterion; } int depth_; int max_depth_; double max_deltaH_; int n_leapfrog_; bool divergent_; double energy_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/adapt_dense_e_nuts.hpp0000644000176200001440000000313213766554456025647 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_ADAPT_DENSE_E_NUTS_HPP #define STAN_MCMC_HMC_NUTS_ADAPT_DENSE_E_NUTS_HPP #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Euclidean disintegration and adaptive * dense metric and adaptive step size */ template class adapt_dense_e_nuts : public dense_e_nuts, public stepsize_covar_adapter { public: adapt_dense_e_nuts(const Model& model, BaseRNG& rng) : dense_e_nuts(model, rng), stepsize_covar_adapter(model.num_params_r()) {} ~adapt_dense_e_nuts() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = dense_e_nuts::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->covar_adaptation_.learn_covariance( this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/diag_e_nuts.hpp0000644000176200001440000000141213766554456024303 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_DIAG_E_NUTS_HPP #define STAN_MCMC_HMC_NUTS_DIAG_E_NUTS_HPP #include #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Euclidean disintegration and diagonal metric */ template class diag_e_nuts : public base_nuts { public: diag_e_nuts(const Model& model, BaseRNG& rng) : base_nuts(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/dense_e_nuts.hpp0000644000176200001440000000141713766554456024502 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_DENSE_E_NUTS_HPP #define STAN_MCMC_HMC_NUTS_DENSE_E_NUTS_HPP #include #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Euclidean disintegration and dense metric */ template class dense_e_nuts : public base_nuts { public: dense_e_nuts(const Model& model, BaseRNG& rng) : base_nuts(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/adapt_diag_e_nuts.hpp0000644000176200001440000000316713766554456025465 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_ADAPT_DIAG_E_NUTS_HPP #define STAN_MCMC_HMC_NUTS_ADAPT_DIAG_E_NUTS_HPP #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Euclidean disintegration and adaptive * diagonal metric and adaptive step size */ template class adapt_diag_e_nuts : public diag_e_nuts, public stepsize_var_adapter { public: adapt_diag_e_nuts(const Model& model, BaseRNG& rng) : diag_e_nuts(model, rng), stepsize_var_adapter(model.num_params_r()) {} ~adapt_diag_e_nuts() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = diag_e_nuts::transition(init_sample, logger); if (this->adapt_flag_) { this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); bool update = this->var_adaptation_.learn_variance(this->z_.inv_e_metric_, this->z_.q); if (update) { this->init_stepsize(logger); this->stepsize_adaptation_.set_mu(log(10 * this->nom_epsilon_)); this->stepsize_adaptation_.restart(); } } return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/softabs_nuts.hpp0000644000176200001440000000142213766554456024535 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_SOFTABS_NUTS_HPP #define STAN_MCMC_HMC_NUTS_SOFTABS_NUTS_HPP #include #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Riemannian disintegration and SoftAbs metric */ template class softabs_nuts : public base_nuts { public: softabs_nuts(const Model& model, BaseRNG& rng) : base_nuts(model, rng) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/hmc/nuts/adapt_unit_e_nuts.hpp0000644000176200001440000000232513766554456025533 0ustar liggesusers#ifndef STAN_MCMC_HMC_NUTS_ADAPT_UNIT_E_NUTS_HPP #define STAN_MCMC_HMC_NUTS_ADAPT_UNIT_E_NUTS_HPP #include #include #include namespace stan { namespace mcmc { /** * The No-U-Turn sampler (NUTS) with multinomial sampling * with a Gaussian-Euclidean disintegration and unit metric * and adaptive step size */ template class adapt_unit_e_nuts : public unit_e_nuts, public stepsize_adapter { public: adapt_unit_e_nuts(const Model& model, BaseRNG& rng) : unit_e_nuts(model, rng) {} ~adapt_unit_e_nuts() {} sample transition(sample& init_sample, callbacks::logger& logger) { sample s = unit_e_nuts::transition(init_sample, logger); if (this->adapt_flag_) this->stepsize_adaptation_.learn_stepsize(this->nom_epsilon_, s.accept_stat()); return s; } void disengage_adaptation() { base_adapter::disengage_adaptation(); this->stepsize_adaptation_.complete_adaptation(this->nom_epsilon_); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/covar_adaptation.hpp0000644000176200001440000000210713766554456023602 0ustar liggesusers#ifndef STAN_MCMC_COVAR_ADAPTATION_HPP #define STAN_MCMC_COVAR_ADAPTATION_HPP #include #include #include namespace stan { namespace mcmc { class covar_adaptation : public windowed_adaptation { public: explicit covar_adaptation(int n) : windowed_adaptation("covariance"), estimator_(n) {} bool learn_covariance(Eigen::MatrixXd& covar, const Eigen::VectorXd& q) { if (adaptation_window()) estimator_.add_sample(q); if (end_adaptation_window()) { compute_next_window(); estimator_.sample_covariance(covar); double n = static_cast(estimator_.num_samples()); covar = (n / (n + 5.0)) * covar + 1e-3 * (5.0 / (n + 5.0)) * Eigen::MatrixXd::Identity(covar.rows(), covar.cols()); estimator_.restart(); ++adapt_window_counter_; return true; } ++adapt_window_counter_; return false; } protected: stan::math::welford_covar_estimator estimator_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/stepsize_var_adapter.hpp0000644000176200001440000000203713766554456024504 0ustar liggesusers#ifndef STAN_MCMC_STEPSIZE_VAR_ADAPTER_HPP #define STAN_MCMC_STEPSIZE_VAR_ADAPTER_HPP #include #include #include #include namespace stan { namespace mcmc { class stepsize_var_adapter : public base_adapter { public: explicit stepsize_var_adapter(int n) : var_adaptation_(n) {} stepsize_adaptation& get_stepsize_adaptation() { return stepsize_adaptation_; } var_adaptation& get_var_adaptation() { return var_adaptation_; } void set_window_params(unsigned int num_warmup, unsigned int init_buffer, unsigned int term_buffer, unsigned int base_window, callbacks::logger& logger) { var_adaptation_.set_window_params(num_warmup, init_buffer, term_buffer, base_window, logger); } protected: stepsize_adaptation stepsize_adaptation_; var_adaptation var_adaptation_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/stepsize_adapter.hpp0000644000176200001440000000074013766554456023633 0ustar liggesusers#ifndef STAN_MCMC_STEPSIZE_ADAPTER_HPP #define STAN_MCMC_STEPSIZE_ADAPTER_HPP #include #include namespace stan { namespace mcmc { class stepsize_adapter : public base_adapter { public: stepsize_adapter() {} stepsize_adaptation& get_stepsize_adaptation() { return stepsize_adaptation_; } protected: stepsize_adaptation stepsize_adaptation_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/sample.hpp0000644000176200001440000000306713766554456021553 0ustar liggesusers#ifndef STAN_MCMC_SAMPLE_HPP #define STAN_MCMC_SAMPLE_HPP #include #include #include namespace stan { namespace mcmc { class sample { public: sample(const Eigen::VectorXd& q, double log_prob, double stat) : cont_params_(q), log_prob_(log_prob), accept_stat_(stat) {} sample(Eigen::VectorXd&& q, double log_prob, double stat) // NOLINT : cont_params_(std::move(q)), log_prob_(log_prob), accept_stat_(stat) {} sample(const sample&) = default; sample(sample&&) = default; sample& operator=(const sample&) = default; sample& operator=(sample&&) = default; virtual ~sample() = default; int size_cont() const { return cont_params_.size(); } double cont_params(int k) const { return cont_params_(k); } void cont_params(Eigen::VectorXd& x) const { x = cont_params_; } const Eigen::VectorXd& cont_params() const { return cont_params_; } inline double log_prob() const { return log_prob_; } inline double accept_stat() const { return accept_stat_; } static void get_sample_param_names(std::vector& names) { names.push_back("lp__"); names.push_back("accept_stat__"); } void get_sample_params(std::vector& values) { values.push_back(log_prob_); values.push_back(accept_stat_); } private: Eigen::VectorXd cont_params_; // Continuous coordinates of sample double log_prob_; // Log probability of sample double accept_stat_; // Acceptance statistic of transition }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/base_adaptation.hpp0000644000176200001440000000034513766554456023404 0ustar liggesusers#ifndef STAN_MCMC_BASE_ADAPTATION_HPP #define STAN_MCMC_BASE_ADAPTATION_HPP namespace stan { namespace mcmc { class base_adaptation { public: virtual void restart() {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/base_mcmc.hpp0000644000176200001440000000155413766554456022202 0ustar liggesusers#ifndef STAN_MCMC_BASE_MCMC_HPP #define STAN_MCMC_BASE_MCMC_HPP #include #include #include #include #include #include namespace stan { namespace mcmc { class base_mcmc { public: base_mcmc() {} virtual ~base_mcmc() {} virtual sample transition(sample& init_sample, callbacks::logger& logger) = 0; virtual void get_sampler_param_names(std::vector& names) {} virtual void get_sampler_params(std::vector& values) {} virtual void write_sampler_state(callbacks::writer& writer) {} virtual void get_sampler_diagnostic_names( std::vector& model_names, std::vector& names) {} virtual void get_sampler_diagnostics(std::vector& values) {} }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/windowed_adaptation.hpp0000644000176200001440000000745213766554456024320 0ustar liggesusers#ifndef STAN_MCMC_WINDOWED_ADAPTATION_HPP #define STAN_MCMC_WINDOWED_ADAPTATION_HPP #include #include #include #include namespace stan { namespace mcmc { class windowed_adaptation : public base_adaptation { public: explicit windowed_adaptation(std::string name) : estimator_name_(name) { num_warmup_ = 0; adapt_init_buffer_ = 0; adapt_term_buffer_ = 0; adapt_base_window_ = 0; restart(); } void restart() { adapt_window_counter_ = 0; adapt_window_size_ = adapt_base_window_; adapt_next_window_ = adapt_init_buffer_ + adapt_window_size_ - 1; } void set_window_params(unsigned int num_warmup, unsigned int init_buffer, unsigned int term_buffer, unsigned int base_window, callbacks::logger& logger) { if (num_warmup < 20) { logger.info("WARNING: No " + estimator_name_ + " estimation is"); logger.info(" performed for num_warmup < 20"); logger.info(""); return; } if (init_buffer + base_window + term_buffer > num_warmup) { logger.info( "WARNING: There aren't enough warmup " "iterations to fit the"); logger.info(" three stages of adaptation as currently" + std::string(" configured.")); num_warmup_ = num_warmup; adapt_init_buffer_ = 0.15 * num_warmup; adapt_term_buffer_ = 0.10 * num_warmup; adapt_base_window_ = num_warmup - (adapt_init_buffer_ + adapt_term_buffer_); logger.info( " Reducing each adaptation stage to " "15%/75%/10% of"); logger.info(" the given number of warmup iterations:"); std::stringstream init_buffer_msg; init_buffer_msg << " init_buffer = " << adapt_init_buffer_; logger.info(init_buffer_msg); std::stringstream adapt_window_msg; adapt_window_msg << " adapt_window = " << adapt_base_window_; logger.info(adapt_window_msg); std::stringstream term_buffer_msg; term_buffer_msg << " term_buffer = " << adapt_term_buffer_; logger.info(term_buffer_msg); logger.info(""); return; } num_warmup_ = num_warmup; adapt_init_buffer_ = init_buffer; adapt_term_buffer_ = term_buffer; adapt_base_window_ = base_window; restart(); } bool adaptation_window() { return (adapt_window_counter_ >= adapt_init_buffer_) && (adapt_window_counter_ < num_warmup_ - adapt_term_buffer_) && (adapt_window_counter_ != num_warmup_); } bool end_adaptation_window() { return (adapt_window_counter_ == adapt_next_window_) && (adapt_window_counter_ != num_warmup_); } void compute_next_window() { if (adapt_next_window_ == num_warmup_ - adapt_term_buffer_ - 1) return; adapt_window_size_ *= 2; adapt_next_window_ = adapt_window_counter_ + adapt_window_size_; if (adapt_next_window_ == num_warmup_ - adapt_term_buffer_ - 1) return; // Bounday of the following window, not the window just computed unsigned int next_window_boundary = adapt_next_window_ + 2 * adapt_window_size_; // If the following window overtakes the full adaptation window, // then stretch the current window to the end of the full window if (next_window_boundary >= num_warmup_ - adapt_term_buffer_) { adapt_next_window_ = num_warmup_ - adapt_term_buffer_ - 1; } } protected: std::string estimator_name_; unsigned int num_warmup_; unsigned int adapt_init_buffer_; unsigned int adapt_term_buffer_; unsigned int adapt_base_window_; unsigned int adapt_window_counter_; unsigned int adapt_next_window_; unsigned int adapt_window_size_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/var_adaptation.hpp0000644000176200001440000000200413766554456023254 0ustar liggesusers#ifndef STAN_MCMC_VAR_ADAPTATION_HPP #define STAN_MCMC_VAR_ADAPTATION_HPP #include #include #include namespace stan { namespace mcmc { class var_adaptation : public windowed_adaptation { public: explicit var_adaptation(int n) : windowed_adaptation("variance"), estimator_(n) {} bool learn_variance(Eigen::VectorXd& var, const Eigen::VectorXd& q) { if (adaptation_window()) estimator_.add_sample(q); if (end_adaptation_window()) { compute_next_window(); estimator_.sample_variance(var); double n = static_cast(estimator_.num_samples()); var = (n / (n + 5.0)) * var + 1e-3 * (5.0 / (n + 5.0)) * Eigen::VectorXd::Ones(var.size()); estimator_.restart(); ++adapt_window_counter_; return true; } ++adapt_window_counter_; return false; } protected: stan::math::welford_var_estimator estimator_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/fixed_param_sampler.hpp0000644000176200001440000000071413766554456024270 0ustar liggesusers#ifndef STAN_MCMC_FIXED_PARAM_SAMPLER_HPP #define STAN_MCMC_FIXED_PARAM_SAMPLER_HPP #include #include #include namespace stan { namespace mcmc { class fixed_param_sampler : public base_mcmc { public: fixed_param_sampler() {} sample transition(sample& init_sample, callbacks::logger& logger) { return init_sample; } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/chains.hpp0000644000176200001440000005000513766554456021531 0ustar liggesusers#ifndef STAN_MCMC_CHAINS_HPP #define STAN_MCMC_CHAINS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace mcmc { using Eigen::Dynamic; /** * An mcmc::chains object stores parameter names and * dimensionalities along with samples from multiple chains. * *

Synchronization: For arbitrary concurrent use, the * read and write methods need to be read/write locked. Multiple * writers can be used concurrently if they write to different * chains. Readers for single chains need only be read/write locked * with writers of that chain. For reading across chains, full * read/write locking is required. Thus methods will be classified * as global or single-chain read or write methods. * *

Storage Order: Storage is column/last-index major. */ template class chains { private: Eigen::Matrix param_names_; Eigen::Matrix samples_; Eigen::VectorXi warmup_; static double mean(const Eigen::VectorXd& x) { return (x.array() / x.size()).sum(); } static double variance(const Eigen::VectorXd& x) { double m = mean(x); return ((x.array() - m) / std::sqrt((x.size() - 1.0))).square().sum(); } static double sd(const Eigen::VectorXd& x) { return std::sqrt(variance(x)); } static double covariance(const Eigen::VectorXd& x, const Eigen::VectorXd& y, std::ostream* err = 0) { if (x.rows() != y.rows() && err) *err << "warning: covariance of different length chains"; using boost::accumulators::accumulator_set; using boost::accumulators::stats; using boost::accumulators::tag::covariance; using boost::accumulators::tag::covariate1; using boost::accumulators::tag::variance; accumulator_set > > acc; int M = std::min(x.size(), y.size()); for (int i = 0; i < M; i++) acc(x(i), boost::accumulators::covariate1 = y(i)); return boost::accumulators::covariance(acc) * M / (M - 1); } static double correlation(const Eigen::VectorXd& x, const Eigen::VectorXd& y, std::ostream* err = 0) { if (x.rows() != y.rows() && err) *err << "warning: covariance of different length chains"; using boost::accumulators::accumulator_set; using boost::accumulators::stats; using boost::accumulators::tag::covariance; using boost::accumulators::tag::covariate1; using boost::accumulators::tag::variance; accumulator_set > > acc_xy; accumulator_set > acc_y; int M = std::min(x.size(), y.size()); for (int i = 0; i < M; i++) { acc_xy(x(i), boost::accumulators::covariate1 = y(i)); acc_y(y(i)); } double cov = boost::accumulators::covariance(acc_xy); if (cov > -1e-8 && cov < 1e-8) return cov; return cov / std::sqrt(boost::accumulators::variance(acc_xy) * boost::accumulators::variance(acc_y)); } static double quantile(const Eigen::VectorXd& x, const double prob) { using boost::accumulators::accumulator_set; using boost::accumulators::left; using boost::accumulators::quantile; using boost::accumulators::quantile_probability; using boost::accumulators::right; using boost::accumulators::stats; using boost::accumulators::tag::tail; using boost::accumulators::tag::tail_quantile; double M = x.rows(); // size_t cache_size = std::min(prob, 1-prob)*M + 2; size_t cache_size = M; if (prob < 0.5) { accumulator_set > > acc( tail::cache_size = cache_size); for (int i = 0; i < M; i++) acc(x(i)); return quantile(acc, quantile_probability = prob); } accumulator_set > > acc( tail::cache_size = cache_size); for (int i = 0; i < M; i++) acc(x(i)); return quantile(acc, quantile_probability = prob); } static Eigen::VectorXd quantiles(const Eigen::VectorXd& x, const Eigen::VectorXd& probs) { using boost::accumulators::accumulator_set; using boost::accumulators::left; using boost::accumulators::quantile; using boost::accumulators::quantile_probability; using boost::accumulators::right; using boost::accumulators::stats; using boost::accumulators::tag::tail; using boost::accumulators::tag::tail_quantile; double M = x.rows(); // size_t cache_size = M/2 + 2; size_t cache_size = M; // 2 + 2; accumulator_set > > acc_left( tail::cache_size = cache_size); accumulator_set > > acc_right( tail::cache_size = cache_size); for (int i = 0; i < M; i++) { acc_left(x(i)); acc_right(x(i)); } Eigen::VectorXd q(probs.size()); for (int i = 0; i < probs.size(); i++) { if (probs(i) < 0.5) q(i) = quantile(acc_left, quantile_probability = probs(i)); else q(i) = quantile(acc_right, quantile_probability = probs(i)); } return q; } static Eigen::VectorXd autocorrelation(const Eigen::VectorXd& x) { using stan::math::index_type; using std::vector; typedef typename index_type >::type idx_t; std::vector ac; std::vector sample(x.size()); for (int i = 0; i < x.size(); i++) sample[i] = x(i); stan::math::autocorrelation(sample, ac); Eigen::VectorXd ac2(ac.size()); for (idx_t i = 0; i < ac.size(); i++) ac2(i) = ac[i]; return ac2; } static Eigen::VectorXd autocovariance(const Eigen::VectorXd& x) { using stan::math::index_type; using std::vector; typedef typename index_type >::type idx_t; std::vector ac; std::vector sample(x.size()); for (int i = 0; i < x.size(); i++) sample[i] = x(i); stan::math::autocovariance(sample, ac); Eigen::VectorXd ac2(ac.size()); for (idx_t i = 0; i < ac.size(); i++) ac2(i) = ac[i]; return ac2; } /** * Return the split potential scale reduction (split R hat) * for the specified parameter. * * Current implementation takes the minimum number of samples * across chains as the number of samples per chain. * * @param VectorXd * @param Dynamic * @param samples * * @return */ double split_potential_scale_reduction( const Eigen::Matrix& samples) const { int chains = samples.size(); int n_samples = samples(0).size(); for (int chain = 1; chain < chains; chain++) { n_samples = std::min(n_samples, static_cast(samples(chain).size())); } if (n_samples % 2 == 1) n_samples--; int n = n_samples / 2; Eigen::VectorXd split_chain_mean(2 * chains); Eigen::VectorXd split_chain_var(2 * chains); for (int chain = 0; chain < chains; chain++) { split_chain_mean(2 * chain) = mean(samples(chain).topRows(n)); split_chain_mean(2 * chain + 1) = mean(samples(chain).bottomRows(n)); split_chain_var(2 * chain) = variance(samples(chain).topRows(n)); split_chain_var(2 * chain + 1) = variance(samples(chain).bottomRows(n)); } double var_between = n * variance(split_chain_mean); double var_within = mean(split_chain_var); // rewrote [(n-1)*W/n + B/n]/W as (n-1+ B/W)/n return sqrt((var_between / var_within + n - 1) / n); } public: explicit chains(const Eigen::Matrix& param_names) : param_names_(param_names) {} explicit chains(const std::vector& param_names) : param_names_(param_names.size()) { for (size_t i = 0; i < param_names.size(); i++) param_names_(i) = param_names[i]; } explicit chains(const stan::io::stan_csv& stan_csv) : param_names_(stan_csv.header) { if (stan_csv.samples.rows() > 0) add(stan_csv); } inline int num_chains() const { return samples_.size(); } inline int num_params() const { return param_names_.size(); } const Eigen::Matrix& param_names() const { return param_names_; } const std::string& param_name(int j) const { return param_names_(j); } int index(const std::string& name) const { int index = -1; for (int i = 0; i < param_names_.size(); i++) if (param_names_(i) == name) return i; return index; } void set_warmup(const int chain, const int warmup) { warmup_(chain) = warmup; } void set_warmup(const int warmup) { warmup_.setConstant(warmup); } const Eigen::VectorXi& warmup() const { return warmup_; } int warmup(const int chain) const { return warmup_(chain); } int num_samples(const int chain) const { return samples_(chain).rows(); } int num_samples() const { int n = 0; for (int chain = 0; chain < num_chains(); chain++) n += num_samples(chain); return n; } int num_kept_samples(const int chain) const { return num_samples(chain) - warmup(chain); } int num_kept_samples() const { int n = 0; for (int chain = 0; chain < num_chains(); chain++) n += num_kept_samples(chain); return n; } void add(const int chain, const Eigen::MatrixXd& sample) { if (sample.cols() != num_params()) throw std::invalid_argument( "add(chain, sample): number of columns" " in sample does not match chains"); if (num_chains() == 0 || chain >= num_chains()) { int n = num_chains(); // Need this block for Windows. conservativeResize // does not keep the references. Eigen::Matrix samples_copy(num_chains()); Eigen::VectorXi warmup_copy(num_chains()); for (int i = 0; i < n; i++) { samples_copy(i) = samples_(i); warmup_copy(i) = warmup_(i); } samples_.resize(chain + 1); warmup_.resize(chain + 1); for (int i = 0; i < n; i++) { samples_(i) = samples_copy(i); warmup_(i) = warmup_copy(i); } for (int i = n; i < chain + 1; i++) { samples_(i) = Eigen::MatrixXd(0, num_params()); warmup_(i) = 0; } } int row = samples_(chain).rows(); Eigen::MatrixXd new_samples(row + sample.rows(), num_params()); new_samples << samples_(chain), sample; samples_(chain) = new_samples; } void add(const Eigen::MatrixXd& sample) { if (sample.rows() == 0) return; if (sample.cols() != num_params()) throw std::invalid_argument( "add(sample): number of columns in" " sample does not match chains"); add(num_chains(), sample); } /** * Convert a vector of vector to Eigen::MatrixXd * * This method is added for the benefit of software wrapping * Stan (e.g., PyStan) so that it need not additionally wrap Eigen. * */ void add(const std::vector >& sample) { int n_row = sample.size(); if (n_row == 0) return; int n_col = sample[0].size(); Eigen::MatrixXd sample_copy(n_row, n_col); for (int i = 0; i < n_row; i++) { sample_copy.row(i) = Eigen::VectorXd::Map(&sample[i][0], sample[0].size()); } add(sample_copy); } void add(const stan::io::stan_csv& stan_csv) { if (stan_csv.header.size() != num_params()) throw std::invalid_argument( "add(stan_csv): number of columns in" " sample does not match chains"); if (!param_names_.cwiseEqual(stan_csv.header).all()) { throw std::invalid_argument( "add(stan_csv): header does not match" " chain's header"); } add(stan_csv.samples); if (stan_csv.metadata.save_warmup) set_warmup(num_chains() - 1, stan_csv.metadata.num_warmup); } Eigen::VectorXd samples(const int chain, const int index) const { return samples_(chain).col(index).bottomRows(num_kept_samples(chain)); } Eigen::VectorXd samples(const int index) const { Eigen::VectorXd s(num_kept_samples()); int start = 0; for (int chain = 0; chain < num_chains(); chain++) { int n = num_kept_samples(chain); s.middleRows(start, n) = samples_(chain).col(index).bottomRows(n); start += n; } return s; } Eigen::VectorXd samples(const int chain, const std::string& name) const { return samples(chain, index(name)); } Eigen::VectorXd samples(const std::string& name) const { return samples(index(name)); } double mean(const int chain, const int index) const { return mean(samples(chain, index)); } double mean(const int index) const { return mean(samples(index)); } double mean(const int chain, const std::string& name) const { return mean(chain, index(name)); } double mean(const std::string& name) const { return mean(index(name)); } double sd(const int chain, const int index) const { return sd(samples(chain, index)); } double sd(const int index) const { return sd(samples(index)); } double sd(const int chain, const std::string& name) const { return sd(chain, index(name)); } double sd(const std::string& name) const { return sd(index(name)); } double variance(const int chain, const int index) const { return variance(samples(chain, index)); } double variance(const int index) const { return variance(samples(index)); } double variance(const int chain, const std::string& name) const { return variance(chain, index(name)); } double variance(const std::string& name) const { return variance(index(name)); } double covariance(const int chain, const int index1, const int index2) const { return covariance(samples(chain, index1), samples(chain, index2)); } double covariance(const int index1, const int index2) const { return covariance(samples(index1), samples(index2)); } double covariance(const int chain, const std::string& name1, const std::string& name2) const { return covariance(chain, index(name1), index(name2)); } double covariance(const std::string& name1, const std::string& name2) const { return covariance(index(name1), index(name2)); } double correlation(const int chain, const int index1, const int index2) const { return correlation(samples(chain, index1), samples(chain, index2)); } double correlation(const int index1, const int index2) const { return correlation(samples(index1), samples(index2)); } double correlation(const int chain, const std::string& name1, const std::string& name2) const { return correlation(chain, index(name1), index(name2)); } double correlation(const std::string& name1, const std::string& name2) const { return correlation(index(name1), index(name2)); } double quantile(const int chain, const int index, const double prob) const { return quantile(samples(chain, index), prob); } double quantile(const int index, const double prob) const { return quantile(samples(index), prob); } double quantile(int chain, const std::string& name, double prob) const { return quantile(chain, index(name), prob); } double quantile(const std::string& name, const double prob) const { return quantile(index(name), prob); } Eigen::VectorXd quantiles(int chain, int index, const Eigen::VectorXd& probs) const { return quantiles(samples(chain, index), probs); } Eigen::VectorXd quantiles(int index, const Eigen::VectorXd& probs) const { return quantiles(samples(index), probs); } Eigen::VectorXd quantiles(int chain, const std::string& name, const Eigen::VectorXd& probs) const { return quantiles(chain, index(name), probs); } Eigen::VectorXd quantiles(const std::string& name, const Eigen::VectorXd& probs) const { return quantiles(index(name), probs); } Eigen::Vector2d central_interval(int chain, int index, double prob) const { double low_prob = (1 - prob) / 2; double high_prob = 1 - low_prob; Eigen::Vector2d interval; interval << quantile(chain, index, low_prob), quantile(chain, index, high_prob); return interval; } Eigen::Vector2d central_interval(int index, double prob) const { double low_prob = (1 - prob) / 2; double high_prob = 1 - low_prob; Eigen::Vector2d interval; interval << quantile(index, low_prob), quantile(index, high_prob); return interval; } Eigen::Vector2d central_interval(int chain, const std::string& name, double prob) const { return central_interval(chain, index(name), prob); } Eigen::Vector2d central_interval(const std::string& name, double prob) const { return central_interval(index(name), prob); } Eigen::VectorXd autocorrelation(const int chain, const int index) const { return autocorrelation(samples(chain, index)); } Eigen::VectorXd autocorrelation(int chain, const std::string& name) const { return autocorrelation(chain, index(name)); } Eigen::VectorXd autocovariance(const int chain, const int index) const { return autocovariance(samples(chain, index)); } Eigen::VectorXd autocovariance(int chain, const std::string& name) const { return autocovariance(chain, index(name)); } // FIXME: reimplement using autocorrelation. double effective_sample_size(const int index) const { int n_chains = num_chains(); std::vector draws(n_chains); std::vector sizes(n_chains); int n_kept_samples = 0; for (int chain = 0; chain < n_chains; ++chain) { n_kept_samples = num_kept_samples(chain); draws[chain] = samples_(chain).col(index).bottomRows(n_kept_samples).data(); sizes[chain] = n_kept_samples; } return analyze::compute_effective_sample_size(draws, sizes); } double effective_sample_size(const std::string& name) const { return effective_sample_size(index(name)); } double split_effective_sample_size(const int index) const { int n_chains = num_chains(); std::vector draws(n_chains); std::vector sizes(n_chains); int n_kept_samples = 0; for (int chain = 0; chain < n_chains; ++chain) { n_kept_samples = num_kept_samples(chain); draws[chain] = samples_(chain).col(index).bottomRows(n_kept_samples).data(); sizes[chain] = n_kept_samples; } return analyze::compute_split_effective_sample_size(draws, sizes); } double split_effective_sample_size(const std::string& name) const { return split_effective_sample_size(index(name)); } double split_potential_scale_reduction(const int index) const { int n_chains = num_chains(); std::vector draws(n_chains); std::vector sizes(n_chains); int n_kept_samples = 0; for (int chain = 0; chain < n_chains; ++chain) { n_kept_samples = num_kept_samples(chain); draws[chain] = samples_(chain).col(index).bottomRows(n_kept_samples).data(); sizes[chain] = n_kept_samples; } return analyze::compute_split_potential_scale_reduction(draws, sizes); } double split_potential_scale_reduction(const std::string& name) const { return split_potential_scale_reduction(index(name)); } }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/base_adapter.hpp0000644000176200001440000000065613766554456022705 0ustar liggesusers#ifndef STAN_MCMC_BASE_ADAPTER_HPP #define STAN_MCMC_BASE_ADAPTER_HPP namespace stan { namespace mcmc { class base_adapter { public: base_adapter() : adapt_flag_(false) {} virtual void engage_adaptation() { adapt_flag_ = true; } virtual void disengage_adaptation() { adapt_flag_ = false; } bool adapting() { return adapt_flag_; } protected: bool adapt_flag_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/mcmc/stepsize_covar_adapter.hpp0000644000176200001440000000207413766554456025027 0ustar liggesusers#ifndef STAN_MCMC_STEPSIZE_COVAR_ADAPTER_HPP #define STAN_MCMC_STEPSIZE_COVAR_ADAPTER_HPP #include #include #include #include namespace stan { namespace mcmc { class stepsize_covar_adapter : public base_adapter { public: explicit stepsize_covar_adapter(int n) : covar_adaptation_(n) {} stepsize_adaptation& get_stepsize_adaptation() { return stepsize_adaptation_; } covar_adaptation& get_covar_adaptation() { return covar_adaptation_; } void set_window_params(unsigned int num_warmup, unsigned int init_buffer, unsigned int term_buffer, unsigned int base_window, callbacks::logger& logger) { covar_adaptation_.set_window_params(num_warmup, init_buffer, term_buffer, base_window, logger); } protected: stepsize_adaptation stepsize_adaptation_; covar_adaptation covar_adaptation_; }; } // namespace mcmc } // namespace stan #endif StanHeaders/inst/include/src/stan/command/0000755000176200001440000000000013766554456020252 5ustar liggesusersStanHeaders/inst/include/src/stan/command/stanc_helper.hpp0000644000176200001440000002640113766554456023435 0ustar liggesusers#ifndef STAN_COMMAND_STANC_HELPER_HPP #define STAN_COMMAND_STANC_HELPER_HPP #include #include #include #include #include #include #include #include #include #include #include /** * Print the version of stanc with major, minor and patch. * * @param[in,out] out_stream stream to which version is written. */ inline void print_version(std::ostream* out_stream) { if (!out_stream) return; *out_stream << "stanc version " << stan::MAJOR_VERSION << "." << stan::MINOR_VERSION << "." << stan::PATCH_VERSION << std::endl; } /** * Prints the Stan compiler (stanc) help. * * @param[in,out] out_stream stream to which help is written */ inline void print_stanc_help(std::ostream* out_stream) { using stan::io::print_help_option; if (!out_stream) return; *out_stream << std::endl; print_version(out_stream); *out_stream << std::endl; *out_stream << "USAGE: " << "stanc [options] " << std::endl; *out_stream << std::endl; *out_stream << "OPTIONS:" << std::endl; *out_stream << std::endl; print_help_option(out_stream, "help", "", "Display this information"); print_help_option(out_stream, "version", "", "Display stanc version number"); print_help_option(out_stream, "name", "string", "Model name", "default = \"$model_filename_model\""); print_help_option(out_stream, "o", "file", "Output file for generated C++ code", "default = \"$name.cpp\""); print_help_option(out_stream, "allow_undefined", "", "Do not fail if a function is declared but not defined"); print_help_option(out_stream, "include_paths", "comma-separated list", "Comma-separated list of directories that may contain a " "file in an #include directive"); // TODO(martincerny) help for standalone function compilation } /** * Delte the file at the specified path, writing messages to error * stream if not possible. Do nothing on zero size file name input. * Only write to error stream if it is non-null. * * @param[in,out] err_stream stream to which error messages are * written * @param[in] file_name path of file */ inline void delete_file(std::ostream* err_stream, const std::string& file_name) { if (file_name.size() == 0) return; int return_code = std::remove(file_name.c_str()); if (return_code != 0) if (err_stream) *err_stream << "Could not remove output file=" << file_name << std::endl; } /** * Transform a provided input file name into a valid C++ identifier * @param[in] in_file_name the name of the input file * @return a valid C++ identifier based on the file name. */ inline std::string identifier_from_file_name(const std::string& in_file_name) { size_t slashInd = in_file_name.rfind('/'); size_t ptInd = in_file_name.rfind('.'); if (ptInd == std::string::npos) ptInd = in_file_name.length(); if (slashInd == std::string::npos) { slashInd = in_file_name.rfind('\\'); } if (slashInd == std::string::npos) { slashInd = 0; } else { slashInd++; } std::string result = in_file_name.substr(slashInd, ptInd - slashInd); for (std::string::iterator strIt = result.begin(); strIt != result.end(); strIt++) { if (!isalnum(*strIt) && *strIt != '_') { *strIt = '_'; } } return result; } /** * Check whether a given file has the specified extension. * * @param[in] file_name The name of the file * @param[in] extension The extension (WITHOUT dot)- e.g. "stan". * @return true if the file has the extension */ inline bool has_extension(const std::string& file_name, const std::string& extension) { if (file_name.length() >= extension.length() + 1) { // +1 for the dot if (0 == file_name.compare(file_name.length() - extension.length(), extension.length(), extension) && file_name[file_name.length() - extension.length() - 1] == '.') return true; else return false; } else { return false; } } /** * Test whether a given string is a valid C++ identifier and throw * an exception when it is not. * @param[in] identifier the identifier to be checked * @param[in] identifier_type the type of the identifier to be reported * in error messages */ inline void check_identifier(const std::string& identifier, const std::string& identifier_type) { if (!isalpha(identifier[0]) && identifier[0] != '_') { std::string msg(identifier_type + " must not start with a " "number or symbol other than _"); throw std::invalid_argument(msg); } for (std::string::const_iterator strIt = identifier.begin(); strIt != identifier.end(); strIt++) { if (!isalnum(*strIt) && *strIt != '_') { std::string msg(identifier_type + " must contain only letters, numbers and _"); throw std::invalid_argument(msg); } } } /** * Invoke the stanc command on the specified argument list, writing * output and error messages to the specified streams, return a return * code. * *

The return codes are: 0 for success, -1 for an exception, * -2 is parsing failed, and -3 if there are invalid arguments. * * @param[in] argc number of arguments * @param[in] argv arguments * @param[in,out] out_stream stream to which output is written * @param[in,out] err_stream stream to which error messages are * written * @return return code */ inline int stanc_helper(int argc, const char* argv[], std::ostream* out_stream, std::ostream* err_stream) { enum CompilationType { kModel, kStandaloneFunctions }; static const int SUCCESS_RC = 0; static const int EXCEPTION_RC = -1; static const int PARSE_FAIL_RC = -2; static const int INVALID_ARGUMENT_RC = -3; std::string out_file_name; // declare outside of try to delete in catch try { stan::io::cmd_line cmd(argc, argv); if (cmd.has_flag("help")) { print_stanc_help(out_stream); return SUCCESS_RC; } if (cmd.has_flag("version")) { print_version(out_stream); return SUCCESS_RC; } if (cmd.bare_size() != 1) { std::string msg("Require model file as argument. "); throw std::invalid_argument(msg); } std::string in_file_name; cmd.bare(0, in_file_name); CompilationType compilation_type; if (has_extension(in_file_name, "stanfuncs")) { compilation_type = kStandaloneFunctions; } else { compilation_type = kModel; } std::ifstream in(in_file_name.c_str()); if (!in.is_open()) { std::stringstream msg; msg << "Failed to open model file " << in_file_name.c_str(); throw std::invalid_argument(msg.str()); } std::vector include_paths; include_paths.push_back(""); if (cmd.has_key("include_paths")) { std::string extra_path_str; cmd.val("include_paths", extra_path_str); // extra_path_els is given explicitly so that multiple quote // characters (in this case single and double quotes) can be // used. boost::escaped_list_separator extra_path_els("\\", ",", "\"'"); boost::tokenizer > extra_path_tokenizer(extra_path_str, extra_path_els); for (const auto& inc_path : extra_path_tokenizer) { if (!inc_path.empty()) { include_paths.push_back(inc_path); } } } bool allow_undefined = cmd.has_flag("allow_undefined"); bool valid_input = false; switch (compilation_type) { case kModel: { std::string model_name; if (cmd.has_key("name")) { cmd.val("name", model_name); } else { model_name = identifier_from_file_name(in_file_name) + "_model"; } // TODO(martincerny) Check that the -namespace flag is not set if (cmd.has_key("o")) { cmd.val("o", out_file_name); } else { out_file_name = model_name; // TODO(carpenter): shouldn't this be .hpp without a main()? out_file_name += ".cpp"; } check_identifier(model_name, "model_name"); std::fstream out(out_file_name.c_str(), std::fstream::out); if (out_stream) { *out_stream << "Model name=" << model_name << std::endl; *out_stream << "Input file=" << in_file_name << std::endl; *out_stream << "Output file=" << out_file_name << std::endl; } if (!out.is_open()) { std::stringstream msg; msg << "Failed to open output file " << out_file_name.c_str(); throw std::invalid_argument(msg.str()); } valid_input = stan::lang::compile(err_stream, in, out, model_name, allow_undefined, in_file_name, include_paths); out.close(); break; } case kStandaloneFunctions: { if (cmd.has_key("o")) { cmd.val("o", out_file_name); } else { out_file_name = identifier_from_file_name(in_file_name); out_file_name += ".hpp"; } // TODO(martincerny) Allow multiple namespaces // (split namespace argument by "::") std::vector namespaces; if (cmd.has_key("namespace")) { std::string ns; cmd.val("namespace", ns); namespaces.push_back(ns); } else { namespaces.push_back(identifier_from_file_name(in_file_name) + "_functions"); } // TODO(martincerny) Check that the -name flag is not set for (size_t namespace_i = 0; namespace_i < namespaces.size(); ++namespace_i) { check_identifier(namespaces[namespace_i], "namespace"); } std::fstream out(out_file_name.c_str(), std::fstream::out); if (out_stream) { *out_stream << "Parsing a fuctions-only file" << std::endl; *out_stream << "Target namespace= "; for (size_t namespace_i = 0; namespace_i < namespaces.size(); ++namespace_i) { *out_stream << "::" << namespaces[namespace_i]; } *out_stream << std::endl; *out_stream << "Input file=" << in_file_name << std::endl; *out_stream << "Output file=" << out_file_name << std::endl; } valid_input = stan::lang::compile_functions( err_stream, in, out, namespaces, allow_undefined); out.close(); break; } default: { assert(false); } } if (!valid_input) { if (err_stream) *err_stream << "PARSING FAILED." << std::endl; // FIXME: how to remove triple cut-and-paste? delete_file(out_stream, out_file_name); return PARSE_FAIL_RC; } } catch (const std::invalid_argument& e) { if (err_stream) { *err_stream << std::endl << e.what() << std::endl; delete_file(out_stream, out_file_name); } return INVALID_ARGUMENT_RC; } catch (const std::exception& e) { if (err_stream) { *err_stream << std::endl << e.what() << std::endl; } delete_file(out_stream, out_file_name); return EXCEPTION_RC; } return SUCCESS_RC; } #endif StanHeaders/inst/include/src/stan/analyze/0000755000176200001440000000000013766554456020277 5ustar liggesusersStanHeaders/inst/include/src/stan/analyze/mcmc/0000755000176200001440000000000013766554456021216 5ustar liggesusersStanHeaders/inst/include/src/stan/analyze/mcmc/autocovariance.hpp0000644000176200001440000001101113766554456024724 0ustar liggesusers#ifndef STAN_ANALYZE_MCMC_AUTOCOVARIANCE_HPP #define STAN_ANALYZE_MCMC_AUTOCOVARIANCE_HPP #include #include #include #include #include #include #include #include namespace stan { namespace analyze { /** * Write autocorrelation estimates for every lag for the specified * input sequence into the specified result using the specified FFT * engine. Normalizes lag-k autocorrelation estimators by N instead * of (N - k), yielding biased but more stable estimators as * discussed in Geyer (1992); see * https://projecteuclid.org/euclid.ss/1177011137. The return vector * will be resized to the same length as the input sequence with * lags given by array index. * *

The implementation involves a fast Fourier transform, * followed by a normalization, followed by an inverse transform. * *

An FFT engine can be created for reuse for type double with: * * 

 *     Eigen::FFT fft;
 *
* * @tparam T Scalar type. * @param y Input sequence. * @param ac Autocorrelations. * @param fft FFT engine instance. */ template void autocorrelation(const Eigen::MatrixBase& y, Eigen::MatrixBase& ac, Eigen::FFT& fft) { size_t N = y.size(); size_t M = math::internal::fft_next_good_size(N); size_t Mt2 = 2 * M; // centered_signal = y-mean(y) followed by N zeros Eigen::Matrix centered_signal(Mt2); centered_signal.setZero(); centered_signal.head(N) = y.array() - y.mean(); Eigen::Matrix, Eigen::Dynamic, 1> freqvec(Mt2); fft.fwd(freqvec, centered_signal); // cwiseAbs2 == norm freqvec = freqvec.cwiseAbs2(); Eigen::Matrix, Eigen::Dynamic, 1> ac_tmp(Mt2); fft.inv(ac_tmp, freqvec); // use "biased" estimate as recommended by Geyer (1992) ac = ac_tmp.head(N).real().array() / (N * N * 2); ac /= ac(0); } /** * Write autocovariance estimates for every lag for the specified * input sequence into the specified result using the specified FFT * engine. Normalizes lag-k autocovariance estimators by N instead * of (N - k), yielding biased but more stable estimators as * discussed in Geyer (1992); see * https://projecteuclid.org/euclid.ss/1177011137. The return vector * will be resized to the same length as the input sequence with * lags given by array index. * *

The implementation involves a fast Fourier transform, * followed by a normalization, followed by an inverse transform. * *

This method is just a light wrapper around the three-argument * autocovariance function * * @tparam T Scalar type. * @param y Input sequence. * @param acov Autocovariances. */ template void autocovariance(const Eigen::MatrixBase& y, Eigen::MatrixBase& acov) { Eigen::FFT fft; autocorrelation(y, acov, fft); using boost::accumulators::accumulator_set; using boost::accumulators::stats; using boost::accumulators::tag::variance; accumulator_set> acc; for (int n = 0; n < y.size(); ++n) { acc(y(n)); } acov = acov.array() * boost::accumulators::variance(acc); } /** * Write autocovariance estimates for every lag for the specified * input sequence into the specified result using the specified FFT * engine. Normalizes lag-k autocovariance estimators by N instead * of (N - k), yielding biased but more stable estimators as * discussed in Geyer (1992); see * https://projecteuclid.org/euclid.ss/1177011137. The return vector * will be resized to the same length as the input sequence with * lags given by array index. * *

The implementation involves a fast Fourier transform, * followed by a normalization, followed by an inverse transform. * *

This method is just a light wrapper around the three-argument * autocovariance function * * @tparam T Scalar type. * @param y Input sequence. * @param acov Autocovariances. */ template void autocovariance(const std::vector& y, std::vector& acov) { size_t N = y.size(); acov.resize(N); const Eigen::Map> y_map(&y[0], N); Eigen::Map> acov_map(&acov[0], N); autocovariance(y_map, acov_map); } } // namespace analyze } // namespace stan #endif StanHeaders/inst/include/src/stan/analyze/mcmc/compute_effective_sample_size.hpp0000644000176200001440000002100713766554456030016 0ustar liggesusers#ifndef STAN_ANALYZE_MCMC_COMPUTE_EFFECTIVE_SAMPLE_SIZE_HPP #define STAN_ANALYZE_MCMC_COMPUTE_EFFECTIVE_SAMPLE_SIZE_HPP #include #include #include #include #include #include #include #include namespace stan { namespace analyze { /** * Computes the effective sample size (ESS) for the specified * parameter across all kept samples. The value returned is the * minimum of ESS and the number_total_draws * * log10(number_total_draws). * * See more details in Stan reference manual section "Effective * Sample Size". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. Note that the effective sample size * can not be estimated with less than four draws. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return effective sample size for the specified parameter */ inline double compute_effective_sample_size(std::vector draws, std::vector sizes) { int num_chains = sizes.size(); size_t num_draws = sizes[0]; for (int chain = 1; chain < num_chains; ++chain) { num_draws = std::min(num_draws, sizes[chain]); } if (num_draws < 4) { return std::numeric_limits::quiet_NaN(); } // check if chains are constant; all equal to first draw's value bool are_all_const = false; Eigen::VectorXd init_draw = Eigen::VectorXd::Zero(num_chains); for (int chain_idx = 0; chain_idx < num_chains; chain_idx++) { Eigen::Map> draw( draws[chain_idx], sizes[chain_idx]); for (int n = 0; n < num_draws; n++) { if (!boost::math::isfinite(draw(n))) { return std::numeric_limits::quiet_NaN(); } } init_draw(chain_idx) = draw(0); if (draw.isApproxToConstant(draw(0))) { are_all_const |= true; } } if (are_all_const) { // If all chains are constant then return NaN // if they all equal the same constant value if (init_draw.isApproxToConstant(init_draw(0))) { return std::numeric_limits::quiet_NaN(); } } Eigen::Matrix acov(num_chains); Eigen::VectorXd chain_mean(num_chains); Eigen::VectorXd chain_var(num_chains); for (int chain = 0; chain < num_chains; ++chain) { Eigen::Map> draw( draws[chain], sizes[chain]); autocovariance(draw, acov(chain)); chain_mean(chain) = draw.mean(); chain_var(chain) = acov(chain)(0) * num_draws / (num_draws - 1); } double mean_var = chain_var.mean(); double var_plus = mean_var * (num_draws - 1) / num_draws; if (num_chains > 1) var_plus += math::variance(chain_mean); Eigen::VectorXd rho_hat_s(num_draws); rho_hat_s.setZero(); Eigen::VectorXd acov_s(num_chains); for (int chain = 0; chain < num_chains; ++chain) acov_s(chain) = acov(chain)(1); double rho_hat_even = 1.0; rho_hat_s(0) = rho_hat_even; double rho_hat_odd = 1 - (mean_var - acov_s.mean()) / var_plus; rho_hat_s(1) = rho_hat_odd; // Convert raw autocovariance estimators into Geyer's initial // positive sequence. Loop only until num_draws - 4 to // leave the last pair of autocorrelations as a bias term that // reduces variance in the case of antithetical chains. size_t s = 1; while (s < (num_draws - 4) && (rho_hat_even + rho_hat_odd) > 0) { for (int chain = 0; chain < num_chains; ++chain) acov_s(chain) = acov(chain)(s + 1); rho_hat_even = 1 - (mean_var - acov_s.mean()) / var_plus; for (int chain = 0; chain < num_chains; ++chain) acov_s(chain) = acov(chain)(s + 2); rho_hat_odd = 1 - (mean_var - acov_s.mean()) / var_plus; if ((rho_hat_even + rho_hat_odd) >= 0) { rho_hat_s(s + 1) = rho_hat_even; rho_hat_s(s + 2) = rho_hat_odd; } s += 2; } int max_s = s; // this is used in the improved estimate, which reduces variance // in antithetic case -- see tau_hat below if (rho_hat_even > 0) rho_hat_s(max_s + 1) = rho_hat_even; // Convert Geyer's initial positive sequence into an initial // monotone sequence for (int s = 1; s <= max_s - 3; s += 2) { if (rho_hat_s(s + 1) + rho_hat_s(s + 2) > rho_hat_s(s - 1) + rho_hat_s(s)) { rho_hat_s(s + 1) = (rho_hat_s(s - 1) + rho_hat_s(s)) / 2; rho_hat_s(s + 2) = rho_hat_s(s + 1); } } double num_total_draws = num_chains * num_draws; // Geyer's truncated estimator for the asymptotic variance // Improved estimate reduces variance in antithetic case double tau_hat = -1 + 2 * rho_hat_s.head(max_s).sum() + rho_hat_s(max_s + 1); return std::min(num_total_draws / tau_hat, num_total_draws * std::log10(num_total_draws)); } /** * Computes the effective sample size (ESS) for the specified * parameter across all kept samples. The value returned is the * minimum of ESS and the number_total_draws * * log10(number_total_draws). * * See more details in Stan reference manual section "Effective * Sample Size". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. Note that the effective sample size * can not be estimated with less than four draws. Argument size * will be broadcast to same length as draws. * * @param draws stores pointers to arrays of chains * @param size size of chains * @return effective sample size for the specified parameter */ inline double compute_effective_sample_size(std::vector draws, size_t size) { int num_chains = draws.size(); std::vector sizes(num_chains, size); return compute_effective_sample_size(draws, sizes); } /** * Computes the split effective sample size (ESS) for the specified * parameter across all kept samples. The value returned is the * minimum of ESS and the number_total_draws * * log10(number_total_draws). When the number of total draws N is * odd, the (N+1)/2th draw is ignored. * * See more details in Stan reference manual section "Effective * Sample Size". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. Note that the effective sample size * can not be estimated with less than four draws. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return effective sample size for the specified parameter */ inline double compute_split_effective_sample_size( std::vector draws, std::vector sizes) { int num_chains = sizes.size(); size_t num_draws = sizes[0]; for (int chain = 1; chain < num_chains; ++chain) { num_draws = std::min(num_draws, sizes[chain]); } std::vector split_draws = split_chains(draws, sizes); double half = num_draws / 2.0; std::vector half_sizes(2 * num_chains, std::floor(half)); return compute_effective_sample_size(split_draws, half_sizes); } /** * Computes the split effective sample size (ESS) for the specified * parameter across all kept samples. The value returned is the * minimum of ESS and the number_total_draws * * log10(number_total_draws). When the number of total draws N is * odd, the (N+1)/2th draw is ignored. * * See more details in Stan reference manual section "Effective * Sample Size". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. Note that the effective sample size * can not be estimated with less than four draws. Argument size * will be broadcast to same length as draws. * * @param draws stores pointers to arrays of chains * @param size size of chains * @return effective sample size for the specified parameter */ inline double compute_split_effective_sample_size( std::vector draws, size_t size) { int num_chains = draws.size(); std::vector sizes(num_chains, size); return compute_split_effective_sample_size(draws, sizes); } } // namespace analyze } // namespace stan #endif StanHeaders/inst/include/src/stan/analyze/mcmc/split_chains.hpp0000644000176200001440000000430313766554456024407 0ustar liggesusers#ifndef STAN_ANALYZE_MCMC_SPLIT_CHAINS_HPP #define STAN_ANALYZE_MCMC_SPLIT_CHAINS_HPP #include #include #include namespace stan { namespace analyze { /** * Splits each chain into two chains of equal length. When the * number of total draws N is odd, the (N+1)/2th draw is ignored. * * See more details in Stan reference manual section "Effective * Sample Size". http://mc-stan.org/users/documentation * * Current implementation assumes chains are all of equal size and * draws are stored in contiguous blocks of memory. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return std::vector of pointers to twice as many arrays of half chains */ inline std::vector split_chains( const std::vector& draws, const std::vector& sizes) { int num_chains = sizes.size(); size_t num_draws = sizes[0]; for (int chain = 1; chain < num_chains; ++chain) { num_draws = std::min(num_draws, sizes[chain]); } double half = num_draws / 2.0; int half_draws = std::ceil(half); std::vector split_draws(2 * num_chains); for (int n = 0; n < num_chains; ++n) { split_draws[2 * n] = &draws[n][0]; split_draws[2 * n + 1] = &draws[n][half_draws]; } return split_draws; } /** * Splits each chain into two chains of equal length. When the * number of total draws N is odd, the (N+1)/2th draw is ignored. * * See more details in Stan reference manual section "Effective * Sample Size". http://mc-stan.org/users/documentation * * Current implementation assumes chains are all of equal size and * draws are stored in contiguous blocks of memory. Argument size * will be broadcast to same length as draws. * * @param draws stores pointers to arrays of chains * @param size size of chains * @return std::vector of pointers to twice as many arrays of half chains */ inline std::vector split_chains(std::vector draws, size_t size) { int num_chains = draws.size(); std::vector sizes(num_chains, size); return split_chains(draws, sizes); } } // namespace analyze } // namespace stan #endif StanHeaders/inst/include/src/stan/analyze/mcmc/compute_potential_scale_reduction.hpp0000644000176200001440000001451113766554456030707 0ustar liggesusers#ifndef STAN_ANALYZE_MCMC_COMPUTE_POTENTIAL_SCALE_REDUCTION_HPP #define STAN_ANALYZE_MCMC_COMPUTE_POTENTIAL_SCALE_REDUCTION_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace analyze { /** * Computes the potential scale reduction (Rhat) for the specified * parameter across all kept samples. * * See more details in Stan reference manual section "Potential * Scale Reduction". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return potential scale reduction for the specified parameter */ inline double compute_potential_scale_reduction( std::vector draws, std::vector sizes) { int num_chains = sizes.size(); size_t num_draws = sizes[0]; for (int chain = 1; chain < num_chains; ++chain) { num_draws = std::min(num_draws, sizes[chain]); } // check if chains are constant; all equal to first draw's value bool are_all_const = false; Eigen::VectorXd init_draw = Eigen::VectorXd::Zero(num_chains); for (int chain = 0; chain < num_chains; chain++) { Eigen::Map> draw( draws[chain], sizes[chain]); for (int n = 0; n < num_draws; n++) { if (!boost::math::isfinite(draw(n))) { return std::numeric_limits::quiet_NaN(); } } init_draw(chain) = draw(0); if (draw.isApproxToConstant(draw(0))) { are_all_const |= true; } } if (are_all_const) { // If all chains are constant then return NaN // if they all equal the same constant value if (init_draw.isApproxToConstant(init_draw(0))) { return std::numeric_limits::quiet_NaN(); } } using boost::accumulators::accumulator_set; using boost::accumulators::stats; using boost::accumulators::tag::mean; using boost::accumulators::tag::variance; Eigen::VectorXd chain_mean(num_chains); accumulator_set> acc_chain_mean; Eigen::VectorXd chain_var(num_chains); double unbiased_var_scale = num_draws / (num_draws - 1.0); for (int chain = 0; chain < num_chains; ++chain) { accumulator_set> acc_draw; for (int n = 0; n < num_draws; ++n) { acc_draw(draws[chain][n]); } chain_mean(chain) = boost::accumulators::mean(acc_draw); acc_chain_mean(chain_mean(chain)); chain_var(chain) = boost::accumulators::variance(acc_draw) * unbiased_var_scale; } double var_between = num_draws * boost::accumulators::variance(acc_chain_mean) * num_chains / (num_chains - 1); double var_within = chain_var.mean(); // rewrote [(n-1)*W/n + B/n]/W as (n-1+ B/W)/n return sqrt((var_between / var_within + num_draws - 1) / num_draws); } /** * Computes the potential scale reduction (Rhat) for the specified * parameter across all kept samples. * * See more details in Stan reference manual section "Potential * Scale Reduction". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. Argument size will be broadcast to * same length as draws. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return potential scale reduction for the specified parameter */ inline double compute_potential_scale_reduction( std::vector draws, size_t size) { int num_chains = draws.size(); std::vector sizes(num_chains, size); return compute_potential_scale_reduction(draws, sizes); } /** * Computes the split potential scale reduction (Rhat) for the * specified parameter across all kept samples. When the number of * total draws N is odd, the (N+1)/2th draw is ignored. * * See more details in Stan reference manual section "Potential * Scale Reduction". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return potential scale reduction for the specified parameter */ inline double compute_split_potential_scale_reduction( std::vector draws, std::vector sizes) { int num_chains = sizes.size(); size_t num_draws = sizes[0]; for (int chain = 1; chain < num_chains; ++chain) { num_draws = std::min(num_draws, sizes[chain]); } std::vector split_draws = split_chains(draws, sizes); double half = num_draws / 2.0; std::vector half_sizes(2 * num_chains, std::floor(half)); return compute_potential_scale_reduction(split_draws, half_sizes); } /** * Computes the split potential scale reduction (Rhat) for the * specified parameter across all kept samples. When the number of * total draws N is odd, the (N+1)/2th draw is ignored. * * See more details in Stan reference manual section "Potential * Scale Reduction". http://mc-stan.org/users/documentation * * Current implementation assumes draws are stored in contiguous * blocks of memory. Chains are trimmed from the back to match the * length of the shortest chain. Argument size will be broadcast to * same length as draws. * * @param draws stores pointers to arrays of chains * @param sizes stores sizes of chains * @return potential scale reduction for the specified parameter */ inline double compute_split_potential_scale_reduction( std::vector draws, size_t size) { int num_chains = draws.size(); std::vector sizes(num_chains, size); return compute_split_potential_scale_reduction(draws, sizes); } } // namespace analyze } // namespace stan #endif StanHeaders/inst/include/src/stan/model/0000755000176200001440000000000013766554456017734 5ustar liggesusersStanHeaders/inst/include/src/stan/model/grad_tr_mat_times_hessian.hpp0000644000176200001440000000130313766554456025640 0ustar liggesusers#ifndef STAN_MODEL_GRAD_TR_MAT_TIMES_HESSIAN_HPP #define STAN_MODEL_GRAD_TR_MAT_TIMES_HESSIAN_HPP #include #include #include namespace stan { namespace model { template void grad_tr_mat_times_hessian( const M& model, const Eigen::Matrix& x, const Eigen::Matrix& X, Eigen::Matrix& grad_tr_X_hess_f, std::ostream* msgs = 0) { stan::math::grad_tr_mat_times_hessian(model_functional(model, msgs), x, X, grad_tr_X_hess_f); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/0000755000176200001440000000000013766604372021532 5ustar liggesusersStanHeaders/inst/include/src/stan/model/indexing/rvalue.hpp0000644000176200001440000003254013766554456023554 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_RVALUE_HPP #define STAN_MODEL_INDEXING_RVALUE_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace model { // all indexing from 1 /** * Return the result of indexing a specified value with * a nil index list, which just returns the value. * * Types: T[] : T * * @tparam T Scalar type. * @param[in] c Value to index. * @return Input value. */ template inline T rvalue(const T& c, const nil_index_list& /*idx*/, const char* /*name*/ = "", int /*depth*/ = 0) { return c; } /** * Return the result of indexing the specified Eigen vector with a * sequence containing one single index, returning a scalar. * * Types: vec[single] : scal * * @tparam T Scalar type. * @param[in] v Vector being indexed. * @param[in] idx One single index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing vector. */ template inline T rvalue(const Eigen::Matrix& v, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int ones_idx = idx.head_.n_; math::check_range("vector[single] indexing", name, v.size(), ones_idx); return v.coeff(ones_idx - 1); } /** * Return the result of indexing the specified Eigen row vector * with a sequence containing one single index, returning a * scalar. * * Types: rowvec[single] : scal * * @tparam T Scalar type. * @param[in] rv Row vector being indexed. * @param[in] idx One single index in list. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing row vector. */ template inline T rvalue(const Eigen::Matrix& rv, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int n = idx.head_.n_; math::check_range("row_vector[single] indexing", name, rv.size(), n); return rv.coeff(n - 1); } /** * Return the result of indexing the specified Eigen vector with a * sequence containing one multiple index, returning a vector. * * Types: vec[multiple] : vec * * @tparam T Scalar type. * @tparam I Multi-index type. * @param[in] v Eigen vector. * @param[in] idx Index consisting of one multi-index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing vector. */ template inline typename boost::disable_if, Eigen::Matrix >::type rvalue(const Eigen::Matrix& v, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int size = rvalue_index_size(idx.head_, v.size()); Eigen::Matrix a(size); for (int i = 0; i < size; ++i) { int n = rvalue_at(i, idx.head_); math::check_range("vector[multi] indexing", name, v.size(), n); a(i) = v.coeff(n - 1); } return a; } /** * Return the result of indexing the specified Eigen row vector * with a sequence containing one multiple index, returning a row * vector. * * Types: row_vec[multiple] : rowvec * * @tparam T Scalar type. * @tparam I Multi-index type. * @param[in] rv Eigen row vector. * @param[in] idx Index consisting of one multi-index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing vector. */ template inline typename boost::disable_if, Eigen::Matrix >::type rvalue(const Eigen::Matrix& rv, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int size = rvalue_index_size(idx.head_, rv.size()); Eigen::Matrix a(size); for (int i = 0; i < size; ++i) { int n = rvalue_at(i, idx.head_); math::check_range("row_vector[multi] indexing", name, rv.size(), n); a(i) = rv.coeff(n - 1); } return a; } /** * Return the result of indexing the specified Eigen matrix with a * sequence consisting of one single index, returning a row vector. * * Types: mat[single] : rowvec * * @tparam T Scalar type. * @param[in] a Eigen matrix. * @param[in] idx Index consisting of one uni-index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing matrix. */ template inline Eigen::Matrix rvalue( const Eigen::Matrix& a, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int n = idx.head_.n_; math::check_range("matrix[uni] indexing", name, a.rows(), n); return a.row(n - 1); } /** * Return the result of indexing the specified Eigen matrix with a * sequence consisting of a one multiple index, returning a matrix. * * Types: mat[multiple] : mat * * @tparam T Scalar type. * @tparam I Type of multiple index. * @param[in] a Matrix to index. * @param[in] idx Index consisting of single multiple index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing matrix. */ template inline typename boost::disable_if< boost::is_same, Eigen::Matrix >::type rvalue(const Eigen::Matrix& a, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int n_rows = rvalue_index_size(idx.head_, a.rows()); Eigen::Matrix b(n_rows, a.cols()); for (int i = 0; i < n_rows; ++i) { int n = rvalue_at(i, idx.head_); math::check_range("matrix[multi] indexing", name, a.rows(), n); b.row(i) = a.row(n - 1); } return b; } /** * Return the result of indexing the specified Eigen matrix with a * sequence consisting of two single indexes, returning a scalar. * * Types: mat[single,single] : scalar * * @tparam T Scalar type. * @param[in] a Matrix to index. * @param[in] idx Pair of single indexes. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing matrix. */ template inline T rvalue( const Eigen::Matrix& a, const cons_index_list >& idx, const char* name = "ANON", int depth = 0) { int m = idx.head_.n_; int n = idx.tail_.head_.n_; math::check_range("matrix[uni,uni] indexing, row", name, a.rows(), m); math::check_range("matrix[uni,uni] indexing, col", name, a.cols(), n); return a.coeff(m - 1, n - 1); } /** * Return the result of indexing the specified Eigen matrix with a * sequence consisting of a single index and multiple index, * returning a row vector. * * Types: mat[single,multiple] : row vector * * @tparam T Scalar type. * @tparam I Type of multiple index. * @param[in] a Matrix to index. * @param[in] idx Pair of single index and multiple index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing matrix. */ template inline typename boost::disable_if, Eigen::Matrix >::type rvalue( const Eigen::Matrix& a, const cons_index_list >& idx, const char* name = "ANON", int depth = 0) { int m = idx.head_.n_; math::check_range("matrix[uni,multi] indexing, row", name, a.rows(), m); Eigen::Matrix r = a.row(m - 1); return rvalue(r, idx.tail_); } /** * Return the result of indexing the specified Eigen matrix with a * sequence consisting of a multiple index and a single index, * returning a vector. * * Types: mat[multiple,single] : vector * * @tparam T Scalar type. * @tparam I Type of multiple index. * @param[in] a Matrix to index. * @param[in] idx Pair multiple index and single index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing matrix. */ template inline typename boost::disable_if, Eigen::Matrix >::type rvalue( const Eigen::Matrix& a, const cons_index_list >& idx, const char* name = "ANON", int depth = 0) { int rows = rvalue_index_size(idx.head_, a.rows()); Eigen::Matrix c(rows); for (int i = 0; i < rows; ++i) { int m = rvalue_at(i, idx.head_); int n = idx.tail_.head_.n_; math::check_range("matrix[multi,uni] index row", name, a.rows(), m); math::check_range("matrix[multi,uni] index col", name, a.cols(), n); c(i) = a.coeff(m - 1, n - 1); } return c; } /** * Return the result of indexing the specified Eigen matrix with a * sequence consisting of a pair o multiple indexes, returning a * a matrix. * * Types: mat[multiple,multiple] : mat * * @tparam T Scalar type. * @tparam I Type of multiple index. * @param[in] a Matrix to index. * @param[in] idx Pair of multiple indexes. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing matrix. */ template inline typename boost::disable_if_c< boost::is_same::value || boost::is_same::value, Eigen::Matrix >::type rvalue(const Eigen::Matrix& a, const cons_index_list >& idx, const char* name = "ANON", int depth = 0) { int rows = rvalue_index_size(idx.head_, a.rows()); int cols = rvalue_index_size(idx.tail_.head_, a.cols()); Eigen::Matrix c(rows, cols); for (int j = 0; j < cols; ++j) { for (int i = 0; i < rows; ++i) { int m = rvalue_at(i, idx.head_); int n = rvalue_at(j, idx.tail_.head_); math::check_range("matrix[multi,multi] row index", name, a.rows(), m); math::check_range("matrix[multi,multi] col index", name, a.cols(), n); c(i, j) = a.coeff(m - 1, n - 1); } } return c; } /** * Return the result of indexing the specified array with * a list of indexes beginning with a single index; the result is * determined recursively. Note that arrays are represented as * standard library vectors. * * Types: std::vector[single | L] : T[L] * * @tparam T Type of list elements. * @tparam L Index list type for indexes after first index. * @param[in] c Container of list elements. * @param[in] idx Index list beginning with single index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing array. */ template inline typename rvalue_return, cons_index_list >::type rvalue(const std::vector& c, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { int n = idx.head_.n_; math::check_range("array[uni,...] index", name, c.size(), n); return rvalue(c[n - 1], idx.tail_, name, depth + 1); } /** * Return the result of indexing the specified array with * a list of indexes beginning with a multiple index; the result is * determined recursively. Note that arrays are represented as * standard library vectors. * * Types: std::vector[multiple | L] : std::vector * * @tparam T Type of list elements. * @tparam L Index list type for indexes after first index. * @param[in] c Container of list elements. * @param[in] idx Index list beginning with multiple index. * @param[in] name String form of expression being evaluated. * @param[in] depth Depth of indexing dimension. * @return Result of indexing array. */ template inline typename rvalue_return, cons_index_list >::type rvalue(const std::vector& c, const cons_index_list& idx, const char* name = "ANON", int depth = 0) { typename rvalue_return, cons_index_list >::type result; for (int i = 0; i < rvalue_index_size(idx.head_, c.size()); ++i) { int n = rvalue_at(i, idx.head_); math::check_range("array[multi,...] index", name, c.size(), n); result.push_back(rvalue(c[n - 1], idx.tail_, name, depth + 1)); } return result; } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/rvalue_at.hpp0000644000176200001440000000406013766554456024234 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_RVALUE_AT_HPP #define STAN_MODEL_INDEXING_RVALUE_AT_HPP #include namespace stan { namespace model { // relative indexing from 0; multi-indexing and return from 1 // no error checking from these methods, just indexing /** * Return the index in the underlying array corresponding to the * specified position in the specified multi-index. * * @param[in] n Relative index position (from 0). * @param[in] idx Index (from 1). * @return Underlying index position (from 1). */ inline int rvalue_at(int n, const index_multi& idx) { return idx.ns_[n]; } /** * Return the index in the underlying array corresponding to the * specified position in the specified omni-index. * * @param[in] n Relative index position (from 0). * @param[in] idx Index (from 1). * @return Underlying index position (from 1). */ inline int rvalue_at(int n, const index_omni& idx) { return n + 1; } /** * Return the index in the underlying array corresponding to the * specified position in the specified min-index. * * All indexing begins from 1. * * @param[in] n Relative index position (from 0). * @param[in] idx Index (from 1) * @return Underlying index position (from 1). */ inline int rvalue_at(int n, const index_min& idx) { return idx.min_ + n; } /** * Return the index in the underlying array corresponding to the * specified position in the specified max-index. * * All indexing begins from 1. * * @param[in] n Relative index position (from 0). * @param[in] idx Index (from 1). * @return Underlying index position (from 1). */ inline int rvalue_at(int n, const index_max& idx) { return n + 1; } /** * Return the index in the underlying array corresponding to the * specified position in the specified min-max-index. * * All indexing begins from 1. * * @param[in] n Relative index position (from 0). * @param[in] idx Index (from 1). * @return Underlying index position (from 1). */ inline int rvalue_at(int n, const index_min_max& idx) { return idx.min_ + n; } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/index_list.hpp0000644000176200001440000000327113766554456024417 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_INDEX_LIST_HPP #define STAN_MODEL_INDEXING_INDEX_LIST_HPP namespace stan { namespace model { /** * Structure for an empty (size zero) index list. */ struct nil_index_list {}; /** * Template structure for an index list consisting of a head and * tail index. * * @tparam H type of index stored as the head of the list. * @tparam T type of index list stored as the tail of the list. */ template struct cons_index_list { const H head_; const T tail_; /** * Construct a non-empty index list with the specified index for * a head and specified index list for a tail. * * @param head Index for head. * @param tail Index list for tail. */ explicit cons_index_list(const H& head, const T& tail) : head_(head), tail_(tail) {} }; // factory-like function does type inference for I and T template inline cons_index_list cons_list(const I& idx1, const T& t) { return cons_index_list(idx1, t); } inline nil_index_list index_list() { return nil_index_list(); } template inline cons_index_list index_list(const I& idx) { return cons_list(idx, index_list()); } template inline cons_index_list > index_list( const I1& idx1, const I2& idx2) { return cons_list(idx1, index_list(idx2)); } template inline cons_index_list< I1, cons_index_list > > index_list(const I1& idx1, const I2& idx2, const I3& idx3) { return cons_list(idx1, index_list(idx2, idx3)); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/rvalue_return.hpp0000644000176200001440000001327713766554456025161 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_RVALUE_RETURN_HPP #define STAN_MODEL_INDEXING_RVALUE_RETURN_HPP #include #include #include #include namespace stan { namespace model { /** * Primary template class for metaprogram to calculate return * value for model::rvalue() for the container or * scalar type and index list type specified in the template * parameters. * *

Specializations of this class will define a typedef * type for the return type. * * @tparam C Type of container or scalar. * @tparam L Type of index list. */ template struct rvalue_return {}; /** * Template class specialization for nil indexes, which provide * the container type as the return type. The container type may * be a scalar type or a container. * * @tparam C Container or scalar type. */ template struct rvalue_return { /** * Return type is the container or scalar type. */ typedef C type; }; // SINGLE INDEX /** * Template class specialization for an Eigen matrix, vector or * rwo vector and one multiple index. * * @tparam T Type of scalar in matrix. * @tparam I Type of first index (only instantiated to multi * indexes). * @tparam R Rows for matrix. * @tparam C Columns for matrix. */ template struct rvalue_return, cons_index_list > { /** * Return type is the matrix container type. */ typedef Eigen::Matrix type; }; /** * Template class specialization for an Eigen matrix and one single * index. * * @tparam T Type of scalar in matrix. */ template struct rvalue_return, cons_index_list > { /** * Return type is row vector. */ typedef Eigen::Matrix type; }; /** * Template class specialization for an Eigen vector and one single * index. * * @tparam T Type of scalar in vector. */ template struct rvalue_return, cons_index_list > { /** * Return type is scalar type of vector. */ typedef T type; }; /** * Template class specialization for an Eigen row vector and one * single index. * * @tparam T Type of scalar in row vector. */ template struct rvalue_return, cons_index_list > { /** * Return type is scalar type of row vector. */ typedef T type; }; /** * Template specialization for an Eigen matrix and two multiple * indexes. * * @tparam T Type of scalar in matrix. * @tparam I1 Type of first multiple index. * @tparam I2 Type of second multiple index. */ template struct rvalue_return< Eigen::Matrix, cons_index_list > > { /** * Return type is matrix container type. */ typedef Eigen::Matrix type; }; /** * Template specialization for an Eigen matrix with one multiple * index followed by one single index. * * @tparam T Type of scalar in matrix. * @tparam I Type of multiple index. */ template struct rvalue_return< Eigen::Matrix, cons_index_list > > { /** * Return type is vector with same scalar type as matrix container. */ typedef Eigen::Matrix type; }; /** * Template specialization for an Eigen matrix with one single * index followed by one multiple index. * * @tparam T Type of scalar in matrix. * @tparam I Type of multiple index. */ template struct rvalue_return< Eigen::Matrix, cons_index_list > > { /** * Return type is row vector with same scalar type as matrix container. */ typedef Eigen::Matrix type; }; /** * Template specialization for an Eigen matrix with two single * indexes. * * @tparam T Type of scalar in matrix. */ template struct rvalue_return< Eigen::Matrix, cons_index_list > > { /** * Return type is scalar type of matrix. */ typedef T type; }; /** * Template specialization for a standard vector whose index list * starts with a multiple index. * * @tparam C Element type for standard vector (container or * scalar). * @tparam I Multiple index type. * @tparam L Following index types. */ template struct rvalue_return, cons_index_list > { /** * Return type is calculated recursively as a standard vector of * the rvalue return for the element type C and following index * types L. */ typedef std::vector::type> type; }; /** * Template specialization for a standard vector whose index list * starts with a single index. * * @tparam C Element type for standard vector (container or * scalar). * @tparam L Following index types. */ template struct rvalue_return, cons_index_list > { /** * Return type is calculated recursively as the rvalue return * for the element type C and following index types L. */ typedef typename rvalue_return::type type; }; } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/deep_copy.hpp0000644000176200001440000000345413766554456024227 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_DEEP_COPY_HPP #define STAN_MODEL_INDEXING_DEEP_COPY_HPP #include #include namespace stan { namespace model { /** * Return the specified argument as a constant reference. * *

Warning: because of the usage pattern of this class, this * function only needs to return value references, not actual * copies. The functions that call this overload recursively will * be doing the actual copies with assignment. * * @tparam T Type of scalar. * @param x Input value. * @return Constant reference to input. */ template inline const T& deep_copy(const T& x) { return x; } /** * Return a copy of the specified matrix, vector, or row * vector. The return value is a copy in the sense that modifying * its contents will not affect the original matrix. * *

Warning: This function assumes that the elements of the * matrix deep copy under assignment. * * @tparam T Scalar type. * @tparam R Row type specificiation. * @tparam C Column type specificiation. * @param a Input matrix, vector, or row vector. * @return Deep copy of input. */ template inline Eigen::Matrix deep_copy(const Eigen::Matrix& a) { Eigen::Matrix result(a); return result; } /** * Return a deep copy of the specified standard vector. The * return value is a copy in the sense that modifying its contents * will not affect the original vector. * *

Warning: This function assumes that the elements of the * vector deep copy under assignment. * * @tparam T Scalar type. * @param v Input vector. * @return Deep copy of input. */ template inline std::vector deep_copy(const std::vector& v) { std::vector result(v); return result; } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/index.hpp0000644000176200001440000000427313766554456023367 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_INDEX_HPP #define STAN_MODEL_INDEXING_INDEX_HPP #include namespace stan { namespace model { // SINGLE INDEXING (reduces dimensionality) /** * Structure for an indexing consisting of a single index. * Applying this index reduces the dimensionality of the container * to which it is applied by one. */ struct index_uni { int n_; /** * Construct a single indexing from the specified index. * * @param n single index. */ explicit index_uni(int n) : n_(n) {} }; // MULTIPLE INDEXING (does not reduce dimensionality) /** * Structure for an indexing consisting of multiple indexes. The * indexes do not need to be unique or in order. */ struct index_multi { std::vector ns_; /** * Construct a multiple indexing from the specified indexes. * * @param ns multiple indexes. */ explicit index_multi(const std::vector& ns) : ns_(ns) {} }; /** * Structure for an indexing that consists of all indexes for a * container. Applying this index is a no-op. */ struct index_omni {}; /** * Structure for an indexing from a minimum index (inclusive) to * the end of a container. */ struct index_min { int min_; /** * Construct an indexing from the specified minimum index (inclusive). * * @param min minimum index (inclusive). */ explicit index_min(int min) : min_(min) {} }; /** * Structure for an indexing from the start of a container to a * specified maximum index (inclusive). */ struct index_max { int max_; /** * Construct an indexing from the start of the container up to * the specified maximum index (inclusive). * * @param max maximum index (inclusive). */ explicit index_max(int max) : max_(max) {} }; /** * Structure for an indexing from a minimum index (inclusive) to a * maximum index (inclusive). */ struct index_min_max { int min_; int max_; /** * Construct an indexing from the specified minimum index * (inclusive) and maximum index (inclusive). * * @param min minimum index (inclusive). * @param max maximum index (inclusive). */ explicit index_min_max(int min, int max) : min_(min), max_(max) {} }; } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/rvalue_index_size.hpp0000644000176200001440000000325313766554456025774 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_RVALUE_INDEX_SIZE_HPP #define STAN_MODEL_INDEXING_RVALUE_INDEX_SIZE_HPP #include namespace stan { namespace model { // no error checking /** * Return size of specified multi-index. * * @param[in] idx Input index (from 1). * @param[in] size Size of container (ignored here). * @return Size of result. */ inline int rvalue_index_size(const index_multi& idx, int size) { return idx.ns_.size(); } /** * Return size of specified omni-index for specified size of * input. * * @param[in] idx Input index (from 1). * @param[in] size Size of container. * @return Size of result. */ inline int rvalue_index_size(const index_omni& idx, int size) { return size; } /** * Return size of specified min index for specified size of * input. * * @param[in] idx Input index (from 1). * @param[in] size Size of container. * @return Size of result. */ inline int rvalue_index_size(const index_min& idx, int size) { return size - idx.min_ + 1; } /** * Return size of specified max index. * * @param[in] idx Input index (from 1). * @param[in] size Size of container (ignored). * @return Size of result. */ inline int rvalue_index_size(const index_max& idx, int size) { return idx.max_; } /** * Return size of specified min - max index. If the maximum value * index is less than the minimun index, the size will be zero. * * @param[in] idx Input index (from 1). * @param[in] size Size of container (ignored). * @return Size of result. */ inline int rvalue_index_size(const index_min_max& idx, int size) { return (idx.max_ < idx.min_) ? 0 : (idx.max_ - idx.min_ + 1); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing/lvalue.hpp0000644000176200001440000004373213766554456023553 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_LVALUE_HPP #define STAN_MODEL_INDEXING_LVALUE_HPP #include #include #include #include #include #include #include #include namespace stan { namespace model { /** * Assign the specified rvalue to the specified lvalue. The index * list's type must be `nil_index_list`, but its value will be * ignored. The last two arguments are also ignored. * * @tparam T lvalue variable type * @tparam U rvalue variable type, which must be assignable to `T` * @param[in,out] x lvalue * @param[in] y rvalue * @param[in] name Name of lvalue variable (default "ANON"); ignored * @param[in] depth Indexing depth (default 0; ignored */ template inline void assign(T& x, const nil_index_list& /* idxs */, const U& y, const char* name = "ANON", int depth = 0) { x = y; } /** * Assign the specified standard vector rvalue to the specified * standard vector lvalue. * * @tparam T lvalue container element type * @tparam U rvalue container element type, which must be assignable to `T` * @param[in] x lvalue variable * @param[in] y rvalue variable * @param[in] name name of lvalue variable (default "ANON"). * @param[in] depth indexing depth (default 0). */ template inline void assign(std::vector& x, const nil_index_list& /* idxs */, const std::vector& y, const char* name = "ANON", int depth = 0) { x.resize(y.size()); for (size_t i = 0; i < y.size(); ++i) assign(x[i], nil_index_list(), y[i], name, depth + 1); } /** * Assign the specified Eigen vector at the specified single index * to the specified value. * * Types: vec[uni] <- scalar * * @tparam T Type of assigned vector scalar. * @tparam U Type of value (must be assignable to T). * @param[in] x Vector variable to be assigned. * @param[in] idxs Sequence of one single index (from 1). * @param[in] y Value scalar. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If the index is out of bounds. */ template inline void assign(Eigen::Matrix& x, const cons_index_list& idxs, const U& y, const char* name = "ANON", int depth = 0) { int i = idxs.head_.n_; math::check_range("vector[uni] assign range", name, x.size(), i); x(i - 1) = y; } /** * Assign the specified Eigen vector at the specified single index * to the specified value. * * Types: row_vec[uni] <- scalar * * @tparam T Type of assigned row vector scalar. * @tparam U Type of value (must be assignable to T). * @param[in] x Row vector variable to be assigned. * @param[in] idxs Sequence of one single index (from 1). * @param[in] y Value scalar. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range Index is out of bounds. */ template inline void assign(Eigen::Matrix& x, const cons_index_list& idxs, const U& y, const char* name = "ANON", int depth = 0) { int i = idxs.head_.n_; math::check_range("row_vector[uni] assign range", name, x.size(), i); x(i - 1) = y; } /** * Assign the specified Eigen vector at the specified multiple * index to the specified value. * * Types: vec[multi] <- vec * * @tparam T Type of assigned vector scalar. * @tparam I Type of multiple index. * @tparam U Type of vector value scalar (must be assignable to T). * @param[in] x Row vector variable to be assigned. * @param[in] idxs Sequence of one single index (from 1). * @param[in] y Value vector. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the value size isn't the same as * the indexed size. */ template inline typename boost::disable_if, void>::type assign(Eigen::Matrix& x, const cons_index_list& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { math::check_size_match("vector[multi] assign sizes", "lhs", rvalue_index_size(idxs.head_, x.size()), name, y.size()); for (int n = 0; n < y.size(); ++n) { int i = rvalue_at(n, idxs.head_); math::check_range("vector[multi] assign range", name, x.size(), i); x(i - 1) = y(n); } } /** * Assign the specified Eigen row vector at the specified multiple * index to the specified value. * * Types: row_vec[multi] <- row_vec * * @tparam T Scalar type for assigned row vector. * @tparam I Type of multiple index. * @tparam U Type of value row vector scalar (must be assignable * to T). * @param[in] x Row vector variable to be assigned. * @param[in] idxs Sequence of one multiple index (from 1). * @param[in] y Value vector. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the value size isn't the same as * the indexed size. */ template inline typename boost::disable_if, void>::type assign(Eigen::Matrix& x, const cons_index_list& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { math::check_size_match("row_vector[multi] assign sizes", "lhs", rvalue_index_size(idxs.head_, x.size()), name, y.size()); for (int n = 0; n < y.size(); ++n) { int i = rvalue_at(n, idxs.head_); math::check_range("row_vector[multi] assign range", name, x.size(), i); x(i - 1) = y(n); } } /** * Assign the specified Eigen matrix at the specified single index * to the specified row vector value. * * Types: mat[uni] = rowvec * * @tparam T Assigned matrix scalar type. * @tparam U Type of value scalar for row vector (must be * assignable to T). * @param[in] x Matrix variable to be assigned. * @param[in] idxs Sequence of one single index (from 1). * @param[in] y Value row vector. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the number of columns in the row * vector and matrix do not match. */ template void assign(Eigen::Matrix& x, const cons_index_list& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { math::check_size_match("matrix[uni] assign sizes", "lhs", x.cols(), name, y.cols()); int i = idxs.head_.n_; math::check_range("matrix[uni] assign range", name, x.rows(), i); for (int j = 0; j < x.cols(); ++j) // loop allows double to var assgn x(i - 1, j) = y(j); } /** * Assign the specified Eigen matrix at the specified multiple * index to the specified matrix value. * * Types: mat[multi] = mat * * @tparam T Assigned matrix scalar type. * @tparam I Multiple index type. * @tparam U Value matrix scalar type (must be assignable to T). * @param[in] x Matrix variable to be assigned. * @param[in] idxs Sequence of one multiple index (from 1). * @param[in] y Value matrix. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the dimensions of the indexed * matrix and right-hand side matrix do not match. */ template inline typename boost::disable_if, void>::type assign(Eigen::Matrix& x, const cons_index_list& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { int x_idx_rows = rvalue_index_size(idxs.head_, x.rows()); math::check_size_match("matrix[multi] assign row sizes", "lhs", x_idx_rows, name, y.rows()); math::check_size_match("matrix[multi] assign col sizes", "lhs", x.cols(), name, y.cols()); for (int i = 0; i < y.rows(); ++i) { int m = rvalue_at(i, idxs.head_); math::check_range("matrix[multi] assign range", name, x.rows(), m); // recurse to allow double to var assign for (int j = 0; j < x.cols(); ++j) x(m - 1, j) = y(i, j); } } /** * Assign the specified Eigen matrix at the specified pair of * single indexes to the specified scalar value. * * Types: mat[single, single] = scalar * * @tparam T Matrix scalar type. * @tparam U Scalar type. * @param[in] x Matrix variable to be assigned. * @param[in] idxs Sequence of two single indexes (from 1). * @param[in] y Value scalar. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If either of the indices are out of bounds. */ template void assign(Eigen::Matrix& x, const cons_index_list< index_uni, cons_index_list >& idxs, const U& y, const char* name = "ANON", int depth = 0) { int m = idxs.head_.n_; int n = idxs.tail_.head_.n_; math::check_range("matrix[uni,uni] assign range", name, x.rows(), m); math::check_range("matrix[uni,uni] assign range", name, x.cols(), n); x(m - 1, n - 1) = y; } /** * Assign the specified Eigen matrix at the specified single and * multiple index to the specified row vector. * * Types: mat[uni, multi] = rowvec * * @tparam T Assigned matrix scalar type. * @tparam I Multi-index type. * @tparam U Value row vector scalar type (must be assignable to * T). * @param[in] x Matrix variable to be assigned. * @param[in] idxs Sequence of single and multiple index (from 1). * @param[in] y Value row vector. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the dimensions of the indexed * matrix and right-hand side row vector do not match. */ template inline typename boost::disable_if, void>::type assign( Eigen::Matrix& x, const cons_index_list >& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { int x_idxs_cols = rvalue_index_size(idxs.tail_.head_, x.cols()); math::check_size_match("matrix[uni,multi] assign sizes", "lhs", x_idxs_cols, name, y.cols()); int m = idxs.head_.n_; math::check_range("matrix[uni,multi] assign range", name, x.rows(), m); for (int i = 0; i < y.size(); ++i) { int n = rvalue_at(i, idxs.tail_.head_); math::check_range("matrix[uni,multi] assign range", name, x.cols(), n); x(m - 1, n - 1) = y(i); } } /** * Assign the specified Eigen matrix at the specified multiple and * single index to the specified vector. * * Types: mat[multi, uni] = vec * * @tparam T Assigned matrix scalar type. * @tparam I Multi-index type. * @tparam U Value vector scalar type (must be assignable to T). * @param[in] x Matrix variable to be assigned. * @param[in] idxs Sequence of multiple and single index (from 1). * @param[in] y Value vector. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the dimensions of the indexed * matrix and right-hand side vector do not match. */ template inline typename boost::disable_if, void>::type assign( Eigen::Matrix& x, const cons_index_list >& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { int x_idxs_rows = rvalue_index_size(idxs.head_, x.rows()); math::check_size_match("matrix[multi,uni] assign sizes", "lhs", x_idxs_rows, name, y.rows()); int n = idxs.tail_.head_.n_; math::check_range("matrix[multi,uni] assign range", name, x.cols(), n); for (int i = 0; i < y.size(); ++i) { int m = rvalue_at(i, idxs.head_); math::check_range("matrix[multi,uni] assign range", name, x.rows(), m); x(m - 1, n - 1) = y(i); } } /** * Assign the specified Eigen matrix at the specified pair of * multiple indexes to the specified matrix. * * Types: mat[multi, multi] = mat * * @tparam T Assigned matrix scalar type. * @tparam I1 First multiple index type. * @tparam I2 Second multiple index type. * @tparam U Value matrix scalar type (must be assignable to T). * @param[in] x Matrix variable to be assigned. * @param[in] idxs Pair of multiple indexes (from 1). * @param[in] y Value matrix. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the dimensions of the indexed * matrix and value matrix do not match. */ template inline typename boost::disable_if_c::value || boost::is_same::value, void>::type assign(Eigen::Matrix& x, const cons_index_list >& idxs, const Eigen::Matrix& y, const char* name = "ANON", int depth = 0) { int x_idxs_rows = rvalue_index_size(idxs.head_, x.rows()); int x_idxs_cols = rvalue_index_size(idxs.tail_.head_, x.cols()); math::check_size_match("matrix[multi,multi] assign sizes", "lhs", x_idxs_rows, name, y.rows()); math::check_size_match("matrix[multi,multi] assign sizes", "lhs", x_idxs_cols, name, y.cols()); for (int j = 0; j < y.cols(); ++j) { int n = rvalue_at(j, idxs.tail_.head_); math::check_range("matrix[multi,multi] assign range", name, x.cols(), n); for (int i = 0; i < y.rows(); ++i) { int m = rvalue_at(i, idxs.head_); math::check_range("matrix[multi,multi] assign range", name, x.rows(), m); x(m - 1, n - 1) = y(i, j); } } } /** * Assign the specified array (standard vector) at the specified * index list beginning with a single index to the specified value. * * This function operates recursively to carry out the tail * indexing. * * Types: x[uni | L] = y * * @tparam T Assigned vector member type. * @tparam L Type of tail of index list. * @tparam U Value scalar type (must be assignable to indexed * variable). * @param[in] x Array variable to be assigned. * @param[in] idxs List of indexes beginning with single index * (from 1). * @param[in] y Value. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the dimensions do not match in the * tail assignment. */ template inline void assign(std::vector& x, const cons_index_list& idxs, const U& y, const char* name = "ANON", int depth = 0) { int i = idxs.head_.n_; math::check_range("vector[uni,...] assign range", name, x.size(), i); assign(x[i - 1], idxs.tail_, y, name, depth + 1); } /** * Assign the specified array (standard vector) at the specified * index list beginning with a multiple index to the specified value. * * This function operates recursively to carry out the tail * indexing. * * Types: x[multi | L] = y * * @tparam T Assigned vector member type. * @tparam I Type of multiple index heading index list. * @tparam L Type of tail of index list. * @tparam U Value scalar type (must be assignable to indexed * variable). * @param[in] x Array variable to be assigned. * @param[in] idxs List of indexes beginning with multiple index * (from 1). * @param[in] y Value. * @param[in] name Name of variable (default "ANON"). * @param[in] depth Indexing depth (default 0). * @throw std::out_of_range If any of the indices are out of bounds. * @throw std::invalid_argument If the size of the multiple indexing * and size of first dimension of value do not match, or any of * the recursive tail assignment dimensions do not match. */ template typename boost::disable_if, void>:: type inline assign(std::vector& x, const cons_index_list& idxs, const std::vector& y, const char* name = "ANON", int depth = 0) { int x_idx_size = rvalue_index_size(idxs.head_, x.size()); math::check_size_match("vector[multi,...] assign sizes", "lhs", x_idx_size, name, y.size()); for (size_t n = 0; n < y.size(); ++n) { int i = rvalue_at(n, idxs.head_); math::check_range("vector[multi,...] assign range", name, x.size(), i); assign(x[i - 1], idxs.tail_, y[n], name, depth + 1); } } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/gradient_dot_vector.hpp0000644000176200001440000000132013766554456024466 0ustar liggesusers#ifndef STAN_MODEL_GRADIENT_DOT_VECTOR_HPP #define STAN_MODEL_GRADIENT_DOT_VECTOR_HPP #include #include #include namespace stan { namespace model { template void gradient_dot_vector(const M& model, const Eigen::Matrix& x, const Eigen::Matrix& v, double& f, double& grad_f_dot_v, std::ostream* msgs = 0) { stan::math::gradient_dot_vector(model_functional(model, msgs), x, v, f, grad_f_dot_v); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/hessian.hpp0000644000176200001440000000125213766554456022077 0ustar liggesusers#ifndef STAN_MODEL_HESSIAN_HPP #define STAN_MODEL_HESSIAN_HPP #include #include #include namespace stan { namespace model { template void hessian(const M& model, const Eigen::Matrix& x, double& f, Eigen::Matrix& grad_f, Eigen::Matrix& hess_f, std::ostream* msgs = 0) { stan::math::hessian >(model_functional(model, msgs), x, f, grad_f, hess_f); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/log_prob_propto.hpp0000644000176200001440000000635513766554456023664 0ustar liggesusers#ifndef STAN_MODEL_LOG_PROB_PROPTO_HPP #define STAN_MODEL_LOG_PROB_PROPTO_HPP #include #include #include namespace stan { namespace model { /** * Helper function to calculate log probability for * double scalars up to a proportion. * * This implementation wraps the double values in * stan::math::var and calls the model's * log_prob() function with propto=true * and the specified parameter for applying the Jacobian * adjustment for transformed parameters. * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to * the log probability. * @tparam M Class of model. * @param[in] model Model. * @param[in] params_r Real-valued parameters. * @param[in] params_i Integer-valued parameters. * @param[in,out] msgs */ template double log_prob_propto(const M& model, std::vector& params_r, std::vector& params_i, std::ostream* msgs = 0) { using stan::math::var; using std::vector; vector ad_params_r; ad_params_r.reserve(model.num_params_r()); for (size_t i = 0; i < model.num_params_r(); ++i) ad_params_r.push_back(params_r[i]); try { double lp = model .template log_prob( ad_params_r, params_i, msgs) .val(); stan::math::recover_memory(); return lp; } catch (std::exception& ex) { stan::math::recover_memory(); throw; } } /** * Helper function to calculate log probability for * double scalars up to a proportion. * * This implementation wraps the double values in * stan::math::var and calls the model's * log_prob() function with propto=true * and the specified parameter for applying the Jacobian * adjustment for transformed parameters. * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to * the log probability. * @tparam M Class of model. * @param[in] model Model. * @param[in] params_r Real-valued parameters. * @param[in,out] msgs */ template double log_prob_propto(const M& model, Eigen::VectorXd& params_r, std::ostream* msgs = 0) { using stan::math::var; using std::vector; vector params_i(0); double lp; try { vector ad_params_r; ad_params_r.reserve(model.num_params_r()); for (size_t i = 0; i < model.num_params_r(); ++i) ad_params_r.push_back(params_r(i)); lp = model .template log_prob(ad_params_r, params_i, msgs) .val(); } catch (std::exception& ex) { stan::math::recover_memory(); throw; } stan::math::recover_memory(); return lp; } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/model_functional.hpp0000644000176200001440000000131313766554456023765 0ustar liggesusers#ifndef STAN_MODEL_MODEL_FUNCTIONAL_HPP #define STAN_MODEL_MODEL_FUNCTIONAL_HPP #include #include namespace stan { namespace model { // Interface for automatic differentiation of models template struct model_functional { const M& model; std::ostream* o; model_functional(const M& m, std::ostream* out) : model(m), o(out) {} template T operator()(const Eigen::Matrix& x) const { // log_prob() requires non-const but doesn't modify its argument return model.template log_prob( const_cast&>(x), o); } }; } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/log_prob_grad.hpp0000644000176200001440000000577413766554456023262 0ustar liggesusers#ifndef STAN_MODEL_LOG_PROB_GRAD_HPP #define STAN_MODEL_LOG_PROB_GRAD_HPP #include #include #include namespace stan { namespace model { /** * Compute the gradient using reverse-mode automatic * differentiation, writing the result into the specified * gradient, using the specified perturbation. * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to * the log probability. * @tparam M Class of model. * @param[in] model Model. * @param[in] params_r Real-valued parameters. * @param[in] params_i Integer-valued parameters. * @param[out] gradient Vector into which gradient is written. * @param[in,out] msgs */ template double log_prob_grad(const M& model, std::vector& params_r, std::vector& params_i, std::vector& gradient, std::ostream* msgs = 0) { using stan::math::var; using std::vector; double lp; try { vector ad_params_r(params_r.size()); for (size_t i = 0; i < model.num_params_r(); ++i) { stan::math::var var_i(params_r[i]); ad_params_r[i] = var_i; } var adLogProb = model.template log_prob( ad_params_r, params_i, msgs); lp = adLogProb.val(); adLogProb.grad(ad_params_r, gradient); } catch (const std::exception& ex) { stan::math::recover_memory(); throw; } stan::math::recover_memory(); return lp; } /** * Compute the gradient using reverse-mode automatic * differentiation, writing the result into the specified * gradient, using the specified perturbation. * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to * the log probability. * @tparam M Class of model. * @param[in] model Model. * @param[in] params_r Real-valued parameters. * @param[out] gradient Vector into which gradient is written. * @param[in,out] msgs */ template double log_prob_grad(const M& model, Eigen::VectorXd& params_r, Eigen::VectorXd& gradient, std::ostream* msgs = 0) { using stan::math::var; using std::vector; Eigen::Matrix ad_params_r(params_r.size()); for (size_t i = 0; i < model.num_params_r(); ++i) { stan::math::var var_i(params_r[i]); ad_params_r[i] = var_i; } try { var adLogProb = model.template log_prob( ad_params_r, msgs); double val = adLogProb.val(); stan::math::grad(adLogProb, ad_params_r, gradient); return val; } catch (std::exception& ex) { stan::math::recover_memory(); throw; } } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/test_gradients.hpp0000644000176200001440000000637713766554456023501 0ustar liggesusers#ifndef STAN_MODEL_TEST_GRADIENTS_HPP #define STAN_MODEL_TEST_GRADIENTS_HPP #include #include #include #include #include #include #include namespace stan { namespace model { /** * Test the log_prob_grad() function's ability to produce * accurate gradients using finite differences. This shouldn't * be necessary when using autodiff, but is useful for finding * bugs in hand-written code (or var). * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to the * log probability. * @tparam Model Class of model. * @param[in] model Model. * @param[in] params_r Real-valued parameter vector. * @param[in] params_i Integer-valued parameter vector. * @param[in] epsilon Real-valued scalar saying how much to perturb. * Reasonable value is 1e-6. * @param[in] error Real-valued scalar saying how much error to allow. * Reasonable value is 1e-6. * @param[in,out] interrupt callback to be called at every iteration * @param[in,out] logger Logger for messages * @param[in,out] parameter_writer Writer callback for file output * @return number of failed gradient comparisons versus allowed * error, so 0 if all gradients pass */ template int test_gradients(const Model& model, std::vector& params_r, std::vector& params_i, double epsilon, double error, stan::callbacks::interrupt& interrupt, stan::callbacks::logger& logger, stan::callbacks::writer& parameter_writer) { std::stringstream msg; std::vector grad; double lp = log_prob_grad( model, params_r, params_i, grad, &msg); if (msg.str().length() > 0) { logger.info(msg); parameter_writer(msg.str()); } std::vector grad_fd; finite_diff_grad(model, interrupt, params_r, params_i, grad_fd, epsilon, &msg); if (msg.str().length() > 0) { logger.info(msg); parameter_writer(msg.str()); } int num_failed = 0; std::stringstream lp_msg; lp_msg << " Log probability=" << lp; parameter_writer(); parameter_writer(lp_msg.str()); parameter_writer(); logger.info(""); logger.info(lp_msg); logger.info(""); std::stringstream header; header << std::setw(10) << "param idx" << std::setw(16) << "value" << std::setw(16) << "model" << std::setw(16) << "finite diff" << std::setw(16) << "error"; parameter_writer(header.str()); logger.info(header); for (size_t k = 0; k < params_r.size(); k++) { std::stringstream line; line << std::setw(10) << k << std::setw(16) << params_r[k] << std::setw(16) << grad[k] << std::setw(16) << grad_fd[k] << std::setw(16) << (grad[k] - grad_fd[k]); parameter_writer(line.str()); logger.info(line); if (std::fabs(grad[k] - grad_fd[k]) > error) num_failed++; } return num_failed; } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/model_base_crtp.hpp0000644000176200001440000002057213766554456023575 0ustar liggesusers#ifndef STAN_MODEL_MODEL_BASE_CRTP_HPP #define STAN_MODEL_MODEL_BASE_CRTP_HPP #include #include #include #include namespace stan { namespace model { /** * Base class employing the curiously recursive template pattern for * static inheritance to adapt templated `log_prob` and `write_array` * methods to their untemplated virtual counterparts declared in * `model_base`. * * The derived class `M` is required to implement the following two * pairs of template functions, * * ``` * template * T log_prob(std::vector& params_r, * std::vector& params_i, * std::ostream* msgs = 0) const; * template * T log_prob(Eigen::Matrix& params_r, * std::ostream* msgs = 0) const; * ``` * * and * * ``` * template * void write_array(RNG& base_rng, * std::vector& params_r, * std::vector& params_i, * std::vector& vars, * bool include_tparams = true, * bool include_gqs = true, * std::ostream* msgs = 0) const; * * template * void write_array(RNG& base_rng, * Eigen::Matrix& params_r, * Eigen::Matrix& vars, * bool include_tparams = true, * bool include_gqs = true, * std::ostream* msgs = 0) const * ``` * *

The derived class `M` must be declared following the curiously * recursive template pattern, for example, if `M` is `foo_model`, * then `foo_model` should be declared as * * ``` * class foo_model : public stan::model::model_base_crtp { ... }; * ``` * * The recursion arises when the type of the declared class appears as * a template parameter in the class it extends. For example, * `foo_model` is declared to extend `model_base_crtp`. In * general, the template parameter `M` for this class is called the * derived class, and must be declared to extend `foo_model`. * * @tparam M type of derived model, which must implemented the * template methods defined in the class documentation */ template class model_base_crtp : public stan::model::model_base { public: /** * Construct a model with the specified number of real unconstrained * parameters. * * @param[in] num_params_r number of real unconstrained parameters */ explicit model_base_crtp(size_t num_params_r) : model_base(num_params_r) {} /** * Destroy this class. This is required to be virtual to allow * subclass references to clean up superclasses, but is otherwise a * no-op. */ virtual ~model_base_crtp() {} inline double log_prob(Eigen::VectorXd& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, msgs); } inline math::var log_prob(Eigen::Matrix& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } inline double log_prob_jacobian(Eigen::VectorXd& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } inline math::var log_prob_jacobian(Eigen::Matrix& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } inline double log_prob_propto(Eigen::VectorXd& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } inline math::var log_prob_propto(Eigen::Matrix& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } inline double log_prob_propto_jacobian(Eigen::VectorXd& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } inline math::var log_prob_propto_jacobian( Eigen::Matrix& theta, std::ostream* msgs) const override { return static_cast(this)->template log_prob(theta, msgs); } void write_array(boost::ecuyer1988& rng, Eigen::VectorXd& theta, Eigen::VectorXd& vars, bool include_tparams = true, bool include_gqs = true, std::ostream* msgs = 0) const override { return static_cast(this)->template write_array( rng, theta, vars, include_tparams, include_gqs, msgs); } // TODO(carpenter): remove redundant std::vector methods below here ===== // ====================================================================== inline double log_prob(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline math::var log_prob(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline double log_prob_jacobian(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline math::var log_prob_jacobian(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline double log_prob_propto(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline math::var log_prob_propto(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline double log_prob_propto_jacobian(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } inline math::var log_prob_propto_jacobian(std::vector& theta, std::vector& theta_i, std::ostream* msgs) const override { return static_cast(this)->template log_prob( theta, theta_i, msgs); } void write_array(boost::ecuyer1988& rng, std::vector& theta, std::vector& theta_i, std::vector& vars, bool include_tparams = true, bool include_gqs = true, std::ostream* msgs = 0) const override { return static_cast(this)->template write_array( rng, theta, theta_i, vars, include_tparams, include_gqs, msgs); } }; } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/prob_grad.hpp0000644000176200001440000000443613766554456022413 0ustar liggesusers#ifndef STAN_MODEL_PROB_GRAD_HPP #define STAN_MODEL_PROB_GRAD_HPP #include #include #include #include #include #include namespace stan { namespace model { /** * Base class for models, holding the basic parameter sizes and * ranges for integer parameters. */ class prob_grad { protected: // TODO(carpenter): roll into model_base; remove int members/vars size_t num_params_r__; std::vector > param_ranges_i__; public: /** * Construct a model base class with the specified number of * unconstrained real parameters. * * @param num_params_r number of unconstrained real parameters */ explicit prob_grad(size_t num_params_r) : num_params_r__(num_params_r), param_ranges_i__(std::vector >(0)) {} /** * Construt a model base class with the specified number of * unconstrained real parameters and integer parameter ranges. * * @param num_params_r number of unconstrained real parameters * @param param_ranges_i integer parameter ranges */ prob_grad(size_t num_params_r, std::vector >& param_ranges_i) : num_params_r__(num_params_r), param_ranges_i__(param_ranges_i) {} /** * Destroy this class. */ virtual ~prob_grad() {} /** * Return number of unconstrained real parameters. * * @return number of unconstrained real parameters */ inline size_t num_params_r() const { return num_params_r__; } /** * Return number of integer parameters. * * @return number of integer parameters */ inline size_t num_params_i() const { return param_ranges_i__.size(); } /** * Return the ordered parameter range for the specified integer * variable. * * @param idx index of integer variable * @throw std::out_of_range if there index is beyond the range * of integer indexes * @return ordered pair of ranges */ inline std::pair param_range_i(size_t idx) const { if (idx <= param_ranges_i__.size()) { std::stringstream ss; ss << "param_range_i(): No integer paramter at index " << idx; std::string msg = ss.str(); throw std::out_of_range(msg); } return param_ranges_i__[idx]; } }; } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/model_header.hpp0000644000176200001440000000135213766554456023056 0ustar liggesusers#ifndef STAN_MODEL_MODEL_HEADER_HPP #define STAN_MODEL_MODEL_HEADER_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/src/stan/model/hessian_times_vector.hpp0000644000176200001440000000124313766554456024662 0ustar liggesusers#ifndef STAN_MODEL_HESSIAN_TIMES_VECTOR_HPP #define STAN_MODEL_HESSIAN_TIMES_VECTOR_HPP #include #include #include namespace stan { namespace model { template void hessian_times_vector( const M& model, const Eigen::Matrix& x, const Eigen::Matrix& v, double& f, Eigen::Matrix& hess_f_dot_v, std::ostream* msgs = 0) { stan::math::hessian_times_vector(model_functional(model, msgs), x, v, f, hess_f_dot_v); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/grad_hess_log_prob.hpp0000644000176200001440000000577513766554456024305 0ustar liggesusers#ifndef STAN_MODEL_GRAD_HESS_LOG_PROB_HPP #define STAN_MODEL_GRAD_HESS_LOG_PROB_HPP #include #include #include namespace stan { namespace model { /** * Evaluate the log-probability, its gradient, and its Hessian * at params_r. This default version computes the Hessian * numerically by finite-differencing the gradient, at a cost of * O(params_r.size()^2). * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to the * log probability. * @tparam M Class of model. * @param[in] model Model. * @param[in] params_r Real-valued parameter vector. * @param[in] params_i Integer-valued parameter vector. * @param[out] gradient Vector to write gradient to. * @param[out] hessian Vector to write gradient to. hessian[i*D + j] * gives the element at the ith row and jth column of the Hessian * (where D=params_r.size()). * @param[in, out] msgs Stream to which print statements in Stan * programs are written, default is 0 */ template double grad_hess_log_prob(const M& model, std::vector& params_r, std::vector& params_i, std::vector& gradient, std::vector& hessian, std::ostream* msgs = 0) { static const double epsilon = 1e-3; static const double half_epsilon = 0.5 * epsilon; static const int order = 4; static const double perturbations[order] = {-2 * epsilon, -1 * epsilon, epsilon, 2 * epsilon}; static const double coefficients[order] = {1.0 / 12.0, -2.0 / 3.0, 2.0 / 3.0, -1.0 / 12.0}; static const double half_epsilon_coeff[order] = {half_epsilon * coefficients[0], half_epsilon * coefficients[1], half_epsilon * coefficients[2], half_epsilon * coefficients[3]}; double result = log_prob_grad( model, params_r, params_i, gradient, msgs); hessian.assign(params_r.size() * params_r.size(), 0); std::vector temp_grad(params_r.size()); std::vector perturbed_params(params_r.begin(), params_r.end()); for (size_t d = 0; d < params_r.size(); ++d) { const int row_iter = d * params_r.size(); for (int i = 0; i < order; ++i) { perturbed_params[d] = params_r[d] + perturbations[i]; log_prob_grad(model, perturbed_params, params_i, temp_grad); for (size_t dd = 0; dd < params_r.size(); ++dd) { const double increment = half_epsilon_coeff[i] * temp_grad[dd]; const int col_iter = dd * params_r.size(); hessian[dd + row_iter] += increment; hessian[d + col_iter] += increment; } } perturbed_params[d] = params_r[d]; } return result; } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/standalone_functions_header.hpp0000644000176200001440000000075513766554456026204 0ustar liggesusers#ifndef STAN_MODEL_STANDALONE_FUNCTIONS_HEADER_HPP #define STAN_MODEL_STANDALONE_FUNCTIONS_HEADER_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/src/stan/model/model_base.hpp0000644000176200001440000006051013766554456022541 0ustar liggesusers#ifndef STAN_MODEL_MODEL_BASE_HPP #define STAN_MODEL_MODEL_BASE_HPP #include #include #include #include #include #include #include #include namespace stan { namespace model { /** * The base class for models defining all virtual methods required for * services. Any class extending this class and defining all of its * virtual methods can be used with any of the Stan services for * sampling, optimization, or variational inference. * *

Implementation Details: The reason there are so many * overloads of the `log_prob` and `write_array` methods is that * template methods cannot be declared virtual. This class extends * `stan::model::prob_grad` in order to define sizing for the number * of unconstrained parameters; thus it is not a pure virtual base * class. * *

The approach to defining models used by the Stan language code * generator is use the curiously recursive template base class defined * in the extension `stan::model::model_base_crtp`. */ class model_base : public prob_grad { public: /** * Construct a model with the specified number of real valued * unconstrained parameters. * * @param[in] num_params_r number of real-valued, unconstrained * parameters */ explicit model_base(size_t num_params_r) : prob_grad(num_params_r) {} /** * Destructor. This class has a no-op destructor. */ virtual ~model_base() {} /** * Return the name of the model. * * @return model name */ virtual std::string model_name() const = 0; /** * Set the specified argument to sequence of parameters, transformed * parameters, and generated quantities in the order in which they * were declared. The input sequence is cleared and resized. * * @param[in,out] names sequence of names parameters, transformed * parameters, and generated quantities */ virtual void get_param_names(std::vector& names) const = 0; /** * Set the dimensionalities of constrained parameters, transformed * parameters, and generated quantities. The input sequence is * cleared and resized. The dimensions of each parameter * dimensionality is represented by a sequence of sizes. Scalar * real and integer parameters are represented as an empty sequence * of dimensions. * *

Indexes are output in the order they are used in indexing. For * example, a 2 x 3 x 4 array will have dimensionality * `std::vector{ 2, 3, 4 }`, whereas a 2-dimensional array * of 3-vectors will have dimensionality `std::vector{ 2, 3 * }`, and a 2-dimensional array of 3 x 4 matrices will have * dimensionality `std::vector{2, 3, 4}`. * * @param[in,out] dimss sequence of dimensions specifications to set */ virtual void get_dims(std::vector >& dimss) const = 0; /** * Set the specified sequence to the indexed, scalar, constrained * parameter names. Each variable is output with a * period-separated list of indexes as a suffix, indexing from 1. * *

A real parmeter `alpha` will produce output `alpha` with no * indexes. * *

A 3-dimensional vector (row vector, simplex, etc.) * `theta` will produce output `theta.1`, `theta.2`, `theta.3`. The * dimensions are the constrained dimensions. * *

Matrices are output column major to match their internal * representation in the Stan math library, so that a 2 x 3 matrix * `X` will produce output `X.1.1, X.2.1, X.1.2, X.2.2, X.1.3, * X.2.3`. * *

Arrays are handled in natural C++ order, 2 x 3 x 4 array `a` * will produce ouptut `a.1.1.1`, `a.1.1.2`, `a.1.1.3`, `a.1.1.4`, * `a.1.2.1`, `a.1.2.2`, `a.1.2.3`, `a.1.2.4`, `a.1.3.1`, `a.1.3.2`, * `a.1.3.3`, `a.1.3.4`, `a.2.1.1`, `a.2.1.2`, `a.2.1.3`, `a.2.1.4`, * `a.2.2.1`, `a.2.2.2`, `a.2.2.3`, `a.2.2.4`, `a.2.3.1`, `a.2.3.2`, * `a.2.3.3`, `a.2.3.4`. * *

Arrays of vectors are handled as expected, so that a * 2-dimensional array of 3-vectors is output as `B.1.1`, `B.2.1`, * `B.1.2`, `B.2.2`, `B.1.3`, `B.2.3`. *

Arrays of matrices are generated in row-major order for the * array components and column-major order for the matrix component. * Thus a 2-dimensional array of 3 by 4 matrices `B` will be of * dimensionality 2 x 3 x 4 (indexes `B[1:2, 1:3, 1:4]`) and will be output * as `B.1.1.1`, `B.2.1.1`, `B.1.2.1`, `B.2.2.1`, `B.1.3.1`, * `B.2.3.1`, `B.1.1.2`, `B.2.1.2`, `B.1.2.2`, `B.2.2.2`, `B.1.3.2`, * `B.2.3.2`, `B.1.1.3`, `B.2.1.3`, `B.1.2.3`, `B.2.2.3`, `B.1.3.3`, * `B.2.3.3`, `B.1.1.4`, `B.2.1.4`, `B.1.2.4`, `B.2.2.4`, `B.1.3.4`, * `B.2.3.4` */ virtual void constrained_param_names(std::vector& param_names, bool include_tparams = true, bool include_gqs = true) const = 0; /** * Set the specified sequence of parameter names to the * unconstrained parameter names. Each unconstrained parameter is * represented as a simple one-dimensional sequence of values. The * actual transforms are documented in the reference manual. * *

The sizes will not be the declared sizes for types such as * simplexes, correlation, and covariance matrices. A simplex of * size `N` has `N - 1` unconstrained parameters, an `N` by `N` * correlation matrix (or Cholesky factor thereof) has `N` choose 2 * unconstrained parameters, and a covariance matrix (or Cholesky * factor thereof) has `N` choose 2 plus `N` unconstrained * parameters. * *

Full details of the transforms and their underlying * representations as sequences are detailed in the Stan reference * manual. This also provides details of the order of each * parameter type. * * @param[in,out] param_names sequence of names to set * @param[in] include_tparams true if transformed parameters should * be included * @param[in] include_gqs true if generated quantities should be * included */ virtual void unconstrained_param_names(std::vector& param_names, bool include_tparams = true, bool include_gqs = true) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian and with normalizing constants for * probability functions. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob(Eigen::VectorXd& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian and with normalizing constants for * probability functions. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob(Eigen::Matrix& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and with * normalizing constants for probability functions. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * * @param[in] params_r unconstrained parmeters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob_jacobian(Eigen::VectorXd& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and with * normalizing constants for probability functions. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob_jacobian(Eigen::Matrix& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian correction for constraints and * dropping normalizing constants. * *

This method is for completeness as `double`-based inputs are * always constant and will thus cause all probability functions to * be dropped from the result. To get the value of this * calculation, use the overload for `math::var`. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob_propto(Eigen::VectorXd& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian correction for constraints and * dropping normalizing constants. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob_propto(Eigen::Matrix& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and dropping * normalizing constants. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * *

This method is for completeness as `double`-based inputs are * always constant and will thus cause all probability functions to * be dropped from the result. To get the value of this * calculation, use the overload for `math::var`. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob_propto_jacobian(Eigen::VectorXd& params_r, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and dropping * normalizing constants. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * * @param[in] params_r unconstrained parameters * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob_propto_jacobian( Eigen::Matrix& params_r, std::ostream* msgs) const = 0; /** * Convenience template function returning the log density for the * specified unconstrained parameters, with Jacobian and normalizing * constant inclusion controlled by the template parameters. * *

This non-virtual template method delegates to the appropriate * overloaded virtual function. This allows external interfaces to * call the convenient template methods rather than the individual * virtual functions. * * @tparam propto `true` if normalizing constants should be dropped * and result returned up to an additive constant * @tparam jacobian `true` if the log Jacobian adjustment is * included for the change of variables from unconstrained to * constrained parameters * @tparam T type of scalars in the vector of parameters * @param[in] params_r unconstrained parameters * @param[in,out] msgs stream to which messages are written * @return log density with normalizing constants and Jacobian * included as specified by the template parameters */ template inline T log_prob(Eigen::Matrix& params_r, std::ostream* msgs) const { if (propto && jacobian) return log_prob_propto_jacobian(params_r, msgs); else if (propto && !jacobian) return log_prob_propto(params_r, msgs); else if (!propto && jacobian) return log_prob_jacobian(params_r, msgs); else // if (!propto && !jacobian) return log_prob(params_r, msgs); } /** * Read constrained parameter values from the specified context, * unconstrain them, then concatenate the unconstrained sequences * into the specified parameter sequence. Output messages go to the * specified stream. * * @param[in] context definitions of variable values * @param[in,out] params_r unconstrained parameter values produced * @param[in,out] msgs stream to which messages are written */ virtual void transform_inits(const io::var_context& context, Eigen::VectorXd& params_r, std::ostream* msgs) const = 0; /** * Convert the specified sequence of unconstrained parameters to a * sequence of constrained parameters, optionally including * transformed parameters and including generated quantities. The * generated quantities may use the random number generator. Any * messages are written to the specified stream. The output * parameter sequence will be resized if necessary to match the * number of constrained scalar parameters. * * @param base_rng RNG to use for generated quantities * @param[in] params_r unconstrained parameters input * @param[in,out] params_constrained_r constrained parameters produced * @param[in] include_tparams true if transformed parameters are * included in output * @param[in] include_gqs true if generated quantities are included * in output * @param[in,out] msgs msgs stream to which messages are written */ virtual void write_array(boost::ecuyer1988& base_rng, Eigen::VectorXd& params_r, Eigen::VectorXd& params_constrained_r, bool include_tparams = true, bool include_gqs = true, std::ostream* msgs = 0) const = 0; // TODO(carpenter): cut redundant std::vector versions from here === /** * Return the log density for the specified unconstrained * parameters, without Jacobian and with normalizing constants for * probability functions. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian and with normalizing constants for * probability functions. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and with * normalizing constants for probability functions. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob_jacobian(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and with * normalizing constants for probability functions. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob_jacobian(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian correction for constraints and * dropping normalizing constants. * *

This method is for completeness as `double`-based inputs are * always constant and will thus cause all probability functions to * be dropped from the result. To get the value of this * calculation, use the overload for `math::var`. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob_propto(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, without Jacobian correction for constraints and * dropping normalizing constants. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob_propto(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and dropping * normalizing constants. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * *

This method is for completeness as `double`-based inputs are * always constant and will thus cause all probability functions to * be dropped from the result. To get the value of this * calculation, use the overload for `math::var`. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual double log_prob_propto_jacobian(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Return the log density for the specified unconstrained * parameters, with Jacobian correction for constraints and dropping * normalizing constants. * *

The Jacobian is of the inverse transform from unconstrained * parameters to constrained parameters; full details for Stan * language types can be found in the language reference manual. * * \deprecated Use Eigen vector versions * * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs message stream * @return log density for specified parameters */ virtual math::var log_prob_propto_jacobian(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const = 0; /** * Convenience template function returning the log density for the * specified unconstrained parameters, with Jacobian and normalizing * constant inclusion controlled by the template parameters. * *

This non-virtual template method delegates to the appropriate * overloaded virtual function. This allows external interfaces to * call the convenient template methods rather than the individual * virtual functions. * * \deprecated Use Eigen vector versions * * @tparam propto `true` if normalizing constants should be dropped * and result returned up to an additive constant * @tparam jacobian `true` if the log Jacobian adjustment is * included for the change of variables from unconstrained to * constrained parameters. * @tparam T type of scalars in the vector of parameters * @param[in] params_r unconstrained parameters * @param[in] params_i integer parameters (ignored) * @param[in,out] msgs stream to which messages are written * @return log density with normalizing constants and Jacobian * included as specified by the template parameters */ template inline T log_prob(std::vector& params_r, std::vector& params_i, std::ostream* msgs) const { if (propto && jacobian) return log_prob_propto_jacobian(params_r, params_i, msgs); else if (propto && !jacobian) return log_prob_propto(params_r, params_i, msgs); else if (!propto && jacobian) return log_prob_jacobian(params_r, params_i, msgs); else // if (!propto && !jacobian) return log_prob(params_r, params_i, msgs); } /** * Read constrained parameter values from the specified context, * unconstrain them, then concatenate the unconstrained sequences * into the specified parameter sequence. Output messages go to the * specified stream. * * \deprecated Use Eigen vector versions * * @param[in] context definitions of variable values * @param[in] params_i integer parameters (ignored) * @param[in,out] params_r unconstrained parameter values produced * @param[in,out] msgs stream to which messages are written */ virtual void transform_inits(const io::var_context& context, std::vector& params_i, std::vector& params_r, std::ostream* msgs) const = 0; /** * Convert the specified sequence of unconstrained parameters to a * sequence of constrained parameters, optionally including * transformed parameters and including generated quantities. The * generated quantities may use the random number generator. Any * messages are written to the specified stream. The output * parameter sequence will be resized if necessary to match the * number of constrained scalar parameters. * * @param base_rng RNG to use for generated quantities * @param[in] params_r unconstrained parameters input * @param[in] params_i integer parameters (ignored) * @param[in,out] params_r_constrained constrained parameters produced * @param[in] include_tparams true if transformed parameters are * included in output * @param[in] include_gqs true if generated quantities are included * in output * @param[in,out] msgs msgs stream to which messages are written */ virtual void write_array(boost::ecuyer1988& base_rng, std::vector& params_r, std::vector& params_i, std::vector& params_r_constrained, bool include_tparams = true, bool include_gqs = true, std::ostream* msgs = 0) const = 0; }; } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/finite_diff_grad.hpp0000644000176200001440000000366213766554456023717 0ustar liggesusers#ifndef STAN_MODEL_FINITE_DIFF_GRAD_HPP #define STAN_MODEL_FINITE_DIFF_GRAD_HPP #include #include #include namespace stan { namespace model { /** * Compute the gradient using finite differences for * the specified parameters, writing the result into the * specified gradient, using the specified perturbation. * * @tparam propto True if calculation is up to proportion * (double-only terms dropped). * @tparam jacobian_adjust_transform True if the log absolute * Jacobian determinant of inverse parameter transforms is added to the * log probability. * @tparam M Class of model. * @param model Model. * @param interrupt interrupt callback to be called before calculating * the finite differences for each parameter. * @param params_r Real-valued parameters. * @param params_i Integer-valued parameters. * @param[out] grad Vector into which gradient is written. * @param epsilon * @param[in,out] msgs */ template void finite_diff_grad(const M& model, stan::callbacks::interrupt& interrupt, std::vector& params_r, std::vector& params_i, std::vector& grad, double epsilon = 1e-6, std::ostream* msgs = 0) { std::vector perturbed(params_r); grad.resize(params_r.size()); for (size_t k = 0; k < params_r.size(); k++) { interrupt(); perturbed[k] += epsilon; double logp_plus = model.template log_prob( perturbed, params_i, msgs); perturbed[k] = params_r[k] - epsilon; double logp_minus = model.template log_prob( perturbed, params_i, msgs); double gradest = (logp_plus - logp_minus) / (2 * epsilon); grad[k] = gradest; perturbed[k] = params_r[k]; } } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/model/indexing.hpp0000644000176200001440000000052213766554456022251 0ustar liggesusers#ifndef STAN_MODEL_INDEXING_HPP #define STAN_MODEL_INDEXING_HPP #include #include #include #include #include #include #endif StanHeaders/inst/include/src/stan/model/gradient.hpp0000644000176200001440000000212513766554456022242 0ustar liggesusers#ifndef STAN_MODEL_GRADIENT_HPP #define STAN_MODEL_GRADIENT_HPP #include #include #include #include #include #include namespace stan { namespace model { template void gradient(const M& model, const Eigen::Matrix& x, double& f, Eigen::Matrix& grad_f, std::ostream* msgs = 0) { stan::math::gradient(model_functional(model, msgs), x, f, grad_f); } template void gradient(const M& model, const Eigen::Matrix& x, double& f, Eigen::Matrix& grad_f, callbacks::logger& logger) { std::stringstream ss; try { stan::math::gradient(model_functional(model, &ss), x, f, grad_f); } catch (std::exception& e) { if (ss.str().length() > 0) logger.info(ss); throw; } if (ss.str().length() > 0) logger.info(ss); } } // namespace model } // namespace stan #endif StanHeaders/inst/include/src/stan/version.hpp0000644000176200001440000000124613766554456021035 0ustar liggesusers#ifndef STAN_VERSION_HPP #define STAN_VERSION_HPP #include #include #ifndef STAN_STRING_EXPAND #define STAN_STRING_EXPAND(s) #s #endif #ifndef STAN_STRING #define STAN_STRING(s) STAN_STRING_EXPAND(s) #endif #define STAN_MAJOR 2 #define STAN_MINOR 21 #define STAN_PATCH 0 namespace stan { /** Major version number for Stan package. */ const std::string MAJOR_VERSION = STAN_STRING(STAN_MAJOR); /** Minor version number for Stan package. */ const std::string MINOR_VERSION = STAN_STRING(STAN_MINOR); /** Patch version for Stan package. */ const std::string PATCH_VERSION = STAN_STRING(STAN_PATCH); } // namespace stan #endif StanHeaders/inst/include/src/stan/io/0000755000176200001440000000000013766554456017243 5ustar liggesusersStanHeaders/inst/include/src/stan/io/starts_with.hpp0000644000176200001440000000072613766554456022334 0ustar liggesusers#ifndef STAN_IO_STARTS_WITH_HPP #define STAN_IO_STARTS_WITH_HPP #include namespace stan { namespace io { /** * Return true if the specified string starts with the specified * prefix. * * @param p prefix * @param s string to test * @return true if s has p as a prefix */ inline bool starts_with(const std::string& p, const std::string& s) { return s.size() >= p.size() && s.substr(0, p.size()) == p; } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/cmd_line.hpp0000644000176200001440000001755013766554456021536 0ustar liggesusers#ifndef STAN_IO_CMD_LINE_HPP #define STAN_IO_CMD_LINE_HPP #include #include #include #include #include #include namespace stan { namespace io { /** * Print help option with padding. * * Print 2 spaces, the specified help option, then pad * to the specified width with spaces. If there is not * room for at least 2 padding spaces, start a new line * and pad out to width. * * @param option Option to print (default to empty string). * @param width Width of option (defaults to 20). * @param o Output stream ptr, default to null */ inline void pad_help_option(std::ostream* o, const std::string& option = "", unsigned int width = 20) { if (!o) return; *o << " " << option; int padding = width - option.size(); if (padding < 2) { *o << std::endl; padding = width + 2; // 2 is } for (int i = 0; i < padding; ++i) *o << ' '; } /** * Prints single print option to output ptr if non-null. * * @param o * @param key_val * @param msg * @param note */ inline void print_help_helper(std::ostream* o, const std::string& key_val, const std::string& msg, const std::string& note = "") { if (!o) return; pad_help_option(o, key_val); *o << msg << std::endl; if (note.size() > 0) { pad_help_option(o, ""); *o << " (" << note << ")" << std::endl; } *o << std::endl; } /** * Prints single print option to output ptr if non-null. * * @param o * @param key * @param value_type * @param msg * @param note */ inline void print_help_option(std::ostream* o, const std::string& key, const std::string& value_type, const std::string& msg, const std::string& note = "") { std::stringstream ss; ss << "--" << key; if (value_type.size() > 0) ss << "=<" << value_type << ">"; print_help_helper(o, ss.str(), msg, note); } /** * Parses and stores command-line arguments. * *

Command-line arguments are organized into four types. * *

Command: The first argument (at index 0) is just the * command itself. There method command() retrieves * the command. * *

Key/Value: The second type of argument is a key-value pair, * which must be in the form --key=val. Two hyphens * are used to separate arguments from negated numbers. The method * has_key(const std::string&) indicates if there is a key * and val(const std::string&,T&) writes its value into * a reference (whose type is templated; any type understand by the * output operator >> is acceptable. * *

Flag: Flags are specified as --flag. The * method has_flag(const std::string&) tests if a flag * is present. * *

Bare Argument: Bare arguments are any arguments that * are not prefixed with two hyphens (--). The * method bare_size() returns the number of bare * arguments and they are retrieved with the generic method * bare(const std::string&,T&). */ class cmd_line { private: std::string cmd_; std::map key_val_; std::set flag_; std::vector bare_; void parse_arg(const std::string& s) { if (s.size() < 2 || s[0] != '-' || s[1] != '-') { bare_.push_back(s); return; } for (size_t i = 2; i < s.size(); ++i) { if (s[i] == '=') { key_val_[s.substr(2, i - 2)] = s.substr(i + 1, s.size() - i - 1); return; } } flag_.insert(s.substr(2, s.size())); } public: /** * Construct a command-line argument object from the specified * command-line arguments. * * @param argc Number of arguments. * @param argv Argument strings. */ cmd_line(int argc, const char* argv[]) : cmd_(argv[0]) { for (int i = 1; i < argc; ++i) parse_arg(argv[i]); } /** * Returns the name of the command itself. The * command is always supplied as the first argument * (at index 0). * * @return Name of command. */ std::string command() { return cmd_; } /** * Return true if the specified key is defined. * * @param key Key to test. * @return true if it has a value. */ bool has_key(const std::string& key) const { return key_val_.find(key) != key_val_.end(); } /** * Returns the value for the key provided. * * If the specified key is defined, write the value of the key * into the specified reference and return true, * otherwise do not modify the reference and return * false. * *

The conversions defined by std::ostream * are used to convert the base string value to the specified * type. Thus this method will work as long as operator>>() * is defined for the specified type. * * @param[in] key Key whose value is returned. * @param[out] x Reference to value. * @return False if the key is not found, and true if * it is found. * @tparam Type of value. */ template inline bool val(const std::string& key, T& x) const { if (!has_key(key)) return false; std::stringstream s(key_val_.find(key)->second); s >> x; return true; } /** * Return true if the specified flag is defined. * * @param flag Flag to test. * @return true if flag is defined. */ bool has_flag(const std::string& flag) const { return flag_.find(flag) != flag_.end(); } /** * Return the number of bare arguments. * * @return Number of bare arguments. */ inline size_t bare_size() const { return bare_.size(); } /** * Returns the bare argument. * * If the specified index is valid for bare arguments, * write the bare argument at the specified index into * the specified reference, and otherwise return false * without modifying the reference. * * @param[in] n Bare argument position. * @param[out] x Reference to result. * @return true if there were enough bare arguments. * @tparam T Type of value returned. */ template inline bool bare(size_t n, T& x) const { if (n >= bare_.size()) return false; std::stringstream s(bare_[n]); s >> x; return true; } /** * Print a human readable parsed form of the command-line * arguments to the specified output stream. * * @param[out] out Output stream. */ void print(std::ostream& out) const { out << "COMMAND=" << cmd_ << '\n'; size_t flag_count = 0; for (std::set::const_iterator it = flag_.begin(); it != flag_.end(); ++it) { out << "FLAG " << flag_count << "=" << (*it) << '\n'; ++flag_count; } size_t key_val_count = 0; for (std::map::const_iterator it = key_val_.begin(); it != key_val_.end(); ++it) { out << "KEY " << key_val_count << "=" << (*it).first; out << " VAL " << key_val_count << "=" << (*it).second << '\n'; ++key_val_count; } size_t bare_count = 0; for (size_t i = 0; i < bare_.size(); ++i) { out << "BARE ARG " << bare_count << "=" << bare_[i] << '\n'; ++bare_count; } } }; // explicit instantation for std::string to allow for spaces // in bare_[n] template <> inline bool cmd_line::bare(size_t n, std::string& x) const { if (n >= bare_.size()) return false; x = bare_[n]; return true; } // explicit instantation for std::string to allow for spaces // in key_val_ template <> inline bool cmd_line::val(const std::string& key, std::string& x) const { if (!has_key(key)) return false; x = key_val_.find(key)->second; return true; } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/validate_zero_buf.hpp0000644000176200001440000000160513766554456023442 0ustar liggesusers#ifndef STAN_IO_VALIDATE_ZERO_BUF_HPP #define STAN_IO_VALIDATE_ZERO_BUF_HPP #include #include namespace stan { namespace io { /** * Throw an bad-cast exception if the specified buffer contains * a digit other than 0 before an e or E. The buffer argument * must implement size_t size() method and char * operator[](size_t). * * @tparam B Character buffer type * @throw boost::bad_lexical_cast if the buffer * contains non-zero characters before an exponentiation symbol. */ template void validate_zero_buf(const B& buf) { for (size_t i = 0; i < buf.size(); ++i) { if (buf[i] == 'e' || buf[i] == 'E') return; if (buf[i] >= '1' && buf[i] <= '9') boost::conversion::detail::throw_bad_cast(); } } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/writer.hpp0000644000176200001440000004325113766554456021275 0ustar liggesusers#ifndef STAN_IO_WRITER_HPP #define STAN_IO_WRITER_HPP #include #include #include namespace stan { namespace io { /** * A stream-based writer for integer, scalar, vector, matrix * and array data types, which transforms from constrained to * a sequence of constrained variables. * *

This class converts constrained values to unconstrained * values with mappings that invert those defined in * stan::io::reader to convert unconstrained values * to constrained values. * * @tparam T Basic scalar type. */ template class writer { private: std::vector data_r_; std::vector data_i_; public: typedef Eigen::Matrix matrix_t; typedef Eigen::Matrix vector_t; typedef Eigen::Matrix row_vector_t; typedef Eigen::Array array_vec_t; /** * This is the tolerance for checking arithmetic bounds * in rank and in simplexes. The current value is 1E-8. */ const double CONSTRAINT_TOLERANCE; /** * Construct a writer that writes to the specified * scalar and integer vectors. * * @param data_r Scalar values. * @param data_i Integer values. */ writer(std::vector &data_r, std::vector &data_i) : data_r_(data_r), data_i_(data_i), CONSTRAINT_TOLERANCE(1E-8) { data_r_.clear(); data_i_.clear(); } /** * Destroy this writer. */ ~writer() {} /** * Return a reference to the underlying vector of real values * that have been written. * * @return Values that have been written. */ std::vector &data_r() { return data_r_; } /** * Return a reference to the underlying vector of integer values * that have been written. * * @return Values that have been written. */ std::vector &data_i() { return data_i_; } /** * Write the specified integer to the sequence of integer values. * * @param n Integer to write. */ void integer(int n) { data_i_.push_back(n); } /** * Write the unconstrained value corresponding to the specified * scalar. Here, the unconstrain operation is a no-op, which * matches reader::scalar_constrain(). * * @param y The value. */ void scalar_unconstrain(T &y) { data_r_.push_back(y); } /** * Write the unconstrained value corresponding to the specified * positive-constrained scalar. The transformation applied is * log(y), which is the inverse of constraining * transform specified in reader::scalar_pos_constrain(). * *

This method will fail if the argument is not non-negative. * * @param y The positive value. * @throw std::runtime_error if y is negative. */ void scalar_pos_unconstrain(T &y) { if (y < 0.0) BOOST_THROW_EXCEPTION(std::runtime_error("y is negative")); data_r_.push_back(log(y)); } /** * Return the unconstrained version of the specified input, * which is constrained to be above the specified lower bound. * The unconstraining transform is log(y - lb), which * inverts the constraining * transform defined in reader::scalar_lb_constrain(double), * * @param lb Lower bound. * @param y Lower-bounded value. * @throw std::runtime_error if y is lower than the lower bound provided. */ void scalar_lb_unconstrain(double lb, T &y) { data_r_.push_back(stan::math::lb_free(y, lb)); } /** * Write the unconstrained value corresponding to the specified * lower-bounded value. The unconstraining transform is * log(ub - y), which reverses the constraining * transform defined in reader::scalar_ub_constrain(double). * * @param ub Upper bound. * @param y Constrained value. * @throw std::runtime_error if y is higher than the upper bound provided. */ void scalar_ub_unconstrain(double ub, T &y) { data_r_.push_back(stan::math::ub_free(y, ub)); } /** * Write the unconstrained value corresponding to the specified * value with the specified bounds. The unconstraining * transform is given by reader::logit((y-L)/(U-L)), which * inverts the constraining transform defined in * scalar_lub_constrain(double,double). * * @param lb Lower bound. * @param ub Upper bound. * @param y Bounded value. * @throw std::runtime_error if y is not between the lower and upper bounds */ void scalar_lub_unconstrain(double lb, double ub, T &y) { data_r_.push_back(stan::math::lub_free(y, lb, ub)); } /** * Write the unconstrained value corresponding to the specified * value with the specified offset and multiplier. The unconstraining * transform is given by (y-offset)/multiplier, which * inverts the constraining transform defined in * scalar_offset_multiplier_constrain(double,double). * * @param offset offset. * @param multiplier multiplier. * @param y Bounded value. */ void scalar_offset_multiplier_unconstrain(double offset, double multiplier, T &y) { data_r_.push_back( stan::math::offset_multiplier_free(y, offset, multiplier)); } /** * Write the unconstrained value corresponding to the specified * correlation-constrained variable. * *

The unconstraining transform is atanh(y), which * reverses the transfrom in corr_constrain(). * * @param y Correlation value. * @throw std::runtime_error if y is not between -1.0 and 1.0 */ void corr_unconstrain(T &y) { data_r_.push_back(stan::math::corr_free(y)); } /** * Write the unconstrained value corresponding to the * specified probability value. * *

The unconstraining transform is logit(y), * which inverts the constraining transform defined in * prob_constrain(). * * @param y Probability value. * @throw std::runtime_error if y is not between 0.0 and 1.0 */ void prob_unconstrain(T &y) { data_r_.push_back(stan::math::prob_free(y)); } /** * Write the unconstrained vector that corresponds to the specified * ascendingly ordered vector. * *

The unconstraining transform is defined for input vector y * to produce an output vector x of the same size, defined * by x[0] = log(y[0]) and by * x[k] = log(y[k] - y[k-1]) for k > 0. This * unconstraining transform inverts the constraining transform specified * in ordered_constrain(size_t). * * @param y Ascendingly ordered vector. * @return Unconstrained vector corresponding to the specified vector. * @throw std::runtime_error if vector is not in ascending order. */ void ordered_unconstrain(vector_t &y) { typedef typename stan::math::index_type::type idx_t; if (y.size() == 0) return; stan::math::check_ordered("stan::io::ordered_unconstrain", "Vector", y); data_r_.push_back(y[0]); for (idx_t i = 1; i < y.size(); ++i) { data_r_.push_back(log(y[i] - y[i - 1])); } } /** * Write the unconstrained vector that corresponds to the specified * postiive ascendingly ordered vector. * *

The unconstraining transform is defined for input vector * y to produce an output vector x of * the same size, defined by x[0] = log(y[0]) and * by x[k] = log(y[k] - y[k-1]) for k > * 0. This unconstraining transform inverts the * constraining transform specified in * positive_ordered_constrain(size_t). * * @param y Positive ascendingly ordered vector. * @return Unconstrained vector corresponding to the specified vector. * @throw std::runtime_error if vector is not in ascending order. */ void positive_ordered_unconstrain(vector_t &y) { typedef typename stan::math::index_type::type idx_t; // reimplements pos_ordered_free in prob to avoid malloc if (y.size() == 0) return; stan::math::check_positive_ordered("stan::io::positive_ordered_unconstrain", "Vector", y); data_r_.push_back(log(y[0])); for (idx_t i = 1; i < y.size(); ++i) { data_r_.push_back(log(y[i] - y[i - 1])); } } /** * Write the specified unconstrained vector. * * @param y Vector to write. */ void vector_unconstrain(const vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) data_r_.push_back(y[i]); } /** * Write the specified unconstrained vector. * * @param y Vector to write. */ void row_vector_unconstrain(const vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) data_r_.push_back(y[i]); } /** * Write the specified unconstrained matrix. * * @param y Matrix to write. */ void matrix_unconstrain(const matrix_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t j = 0; j < y.cols(); ++j) for (idx_t i = 0; i < y.rows(); ++i) data_r_.push_back(y(i, j)); } void vector_lb_unconstrain(double lb, vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_lb_unconstrain(lb, y(i)); } void row_vector_lb_unconstrain(double lb, row_vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_lb_unconstrain(lb, y(i)); } void matrix_lb_unconstrain(double lb, matrix_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t j = 0; j < y.cols(); ++j) for (idx_t i = 0; i < y.rows(); ++i) scalar_lb_unconstrain(lb, y(i, j)); } void vector_ub_unconstrain(double ub, vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_ub_unconstrain(ub, y(i)); } void row_vector_ub_unconstrain(double ub, row_vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_ub_unconstrain(ub, y(i)); } void matrix_ub_unconstrain(double ub, matrix_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t j = 0; j < y.cols(); ++j) for (idx_t i = 0; i < y.rows(); ++i) scalar_ub_unconstrain(ub, y(i, j)); } void vector_lub_unconstrain(double lb, double ub, vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_lub_unconstrain(lb, ub, y(i)); } void row_vector_lub_unconstrain(double lb, double ub, row_vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_lub_unconstrain(lb, ub, y(i)); } void matrix_lub_unconstrain(double lb, double ub, matrix_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t j = 0; j < y.cols(); ++j) for (idx_t i = 0; i < y.rows(); ++i) scalar_lub_unconstrain(lb, ub, y(i, j)); } void vector_offset_multiplier_unconstrain(double offset, double multiplier, vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_offset_multiplier_unconstrain(offset, multiplier, y(i)); } void row_vector_offset_multiplier_unconstrain(double offset, double multiplier, row_vector_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t i = 0; i < y.size(); ++i) scalar_offset_multiplier_unconstrain(offset, multiplier, y(i)); } void matrix_offset_multiplier_unconstrain(double offset, double multiplier, matrix_t &y) { typedef typename stan::math::index_type::type idx_t; for (idx_t j = 0; j < y.cols(); ++j) for (idx_t i = 0; i < y.rows(); ++i) scalar_offset_multiplier_unconstrain(offset, multiplier, y(i, j)); } /** * Write the unconstrained vector corresponding to the specified * unit_vector value. If the specified constrained unit_vector * is of size K, the returned unconstrained vector * is of size K-1. * *

The transform takes y = y[1],...,y[K] and * produces the unconstrained vector. This inverts * the constraining transform of * unit_vector_constrain(size_t). * * @param y Simplex constrained value. * @return Unconstrained value. * @throw std::runtime_error if the vector is not a unit_vector. */ void unit_vector_unconstrain(vector_t &y) { stan::math::check_unit_vector("stan::io::unit_vector_unconstrain", "Vector", y); typedef typename stan::math::index_type::type idx_t; vector_t uy = stan::math::unit_vector_free(y); for (idx_t i = 0; i < uy.size(); ++i) data_r_.push_back(uy[i]); } /** * Write the unconstrained vector corresponding to the specified simplex * value. If the specified constrained simplex is of size K, * the returned unconstrained vector is of size K-1. * *

The transform takes y = y[1],...,y[K] and * produces the unconstrained vector. This inverts * the constraining transform of * simplex_constrain(size_t). * * @param y Simplex constrained value. * @return Unconstrained value. * @throw std::runtime_error if the vector is not a simplex. */ void simplex_unconstrain(vector_t &y) { typedef typename stan::math::index_type::type idx_t; stan::math::check_simplex("stan::io::simplex_unconstrain", "Vector", y); vector_t uy = stan::math::simplex_free(y); for (idx_t i = 0; i < uy.size(); ++i) data_r_.push_back(uy[i]); } /** * Writes the unconstrained Cholesky factor corresponding to the * specified constrained matrix. * *

The unconstraining operation is the inverse of the * constraining operation in * cholesky_factor_cov_constrain(Matrix. * * @param y Constrained covariance matrix. * @throw std::runtime_error if y has no elements or if it is not square */ void cholesky_factor_cov_unconstrain(matrix_t &y) { typedef typename stan::math::index_type::type idx_t; // FIXME: optimize by unrolling cholesky_factor_free Eigen::Matrix y_free = stan::math::cholesky_factor_free(y); for (idx_t i = 0; i < y_free.size(); ++i) data_r_.push_back(y_free[i]); } /** * Writes the unconstrained Cholesky factor for a correlation * matrix corresponding to the specified constrained matrix. * *

The unconstraining operation is the inverse of the * constraining operation in * cholesky_factor_corr_constrain(Matrix. * * @param y Constrained correlation matrix. * @throw std::runtime_error if y has no elements or if it is not square */ void cholesky_factor_corr_unconstrain(matrix_t &y) { typedef typename stan::math::index_type::type idx_t; // FIXME: optimize by unrolling cholesky_factor_free Eigen::Matrix y_free = stan::math::cholesky_corr_free(y); for (idx_t i = 0; i < y_free.size(); ++i) data_r_.push_back(y_free[i]); } void cholesky_corr_unconstrain(matrix_t& y) { return cholesky_factor_corr_unconstrain(y); } /** * Writes the unconstrained covariance matrix corresponding * to the specified constrained correlation matrix. * *

The unconstraining operation is the inverse of the * constraining operation in * cov_matrix_constrain(Matrix. * * @param y Constrained covariance matrix. * @throw std::runtime_error if y has no elements or if it is not square */ void cov_matrix_unconstrain(matrix_t &y) { typedef typename stan::math::index_type::type idx_t; idx_t k = y.rows(); if (k == 0 || y.cols() != k) BOOST_THROW_EXCEPTION( std::runtime_error("y must have elements and" " y must be a square matrix")); vector_t L_vec = stan::math::cov_matrix_free(y); int i = 0; for (idx_t m = 0; m < k; ++m) { for (idx_t n = 0; n <= m; ++n) data_r_.push_back(L_vec.coeff(i++)); } } /** * Writes the unconstrained correlation matrix corresponding * to the specified constrained correlation matrix. * *

The unconstraining operation is the inverse of the * constraining operation in * corr_matrix_constrain(Matrix. * * @param y Constrained correlation matrix. * @throw std::runtime_error if the correlation matrix has no elements or * is not a square matrix. * @throw std::runtime_error if the correlation matrix is non-symmetric, * diagonals not near 1, not positive definite, or any of the * elements nan. */ void corr_matrix_unconstrain(matrix_t &y) { typedef typename stan::math::index_type::type idx_t; stan::math::check_corr_matrix("stan::io::corr_matrix_unconstrain", "Matrix", y); idx_t k = y.rows(); idx_t k_choose_2 = (k * (k - 1)) / 2; vector_t cpcs = stan::math::corr_matrix_free(y); for (idx_t i = 0; i < k_choose_2; ++i) data_r_.push_back(cpcs[i]); } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/reader.hpp0000644000176200001440000013700413766554456021223 0ustar liggesusers#ifndef STAN_IO_READER_HPP #define STAN_IO_READER_HPP #include #include #include #include #include namespace stan { namespace io { /** * A stream-based reader for integer, scalar, vector, matrix * and array data types, with Jacobian calculations. * * The template parameter T represents the type of * scalars and the values in vectors and matrices. The only * requirement on the template type T is that a * double can be copied into it, as in * * T t = 0.0; * * This includes double itself and the reverse-mode * algorithmic differentiation class stan::math::var. * *

For transformed values, the scalar type parameter T * must support the transforming operations, such as exp(x) * for positive-bounded variables. It must also support equality and * inequality tests with double values. * * @tparam T Basic scalar type. */ template class reader { private: std::vector &data_r_; std::vector &data_i_; size_t pos_{0}; size_t int_pos_{0}; inline T &scalar_ptr() { return data_r_[pos_]; } inline T &scalar_ptr_increment(size_t m) { pos_ += m; return data_r_[pos_ - m]; } inline int &int_ptr() { return data_i_[int_pos_]; } inline int &int_ptr_increment(size_t m) { int_pos_ += m; return data_i_[int_pos_ - m]; } public: typedef Eigen::Matrix matrix_t; typedef Eigen::Matrix vector_t; typedef Eigen::Matrix row_vector_t; typedef Eigen::Map map_matrix_t; typedef Eigen::Map map_vector_t; typedef Eigen::Map map_row_vector_t; /** * Construct a variable reader using the specified vectors * as the source of scalar and integer values for data. This * class holds a reference to the specified data vectors. * * Attempting to read beyond the end of the data or integer * value sequences raises a runtime exception. * * @param data_r Sequence of scalar values. * @param data_i Sequence of integer values. */ reader(std::vector &data_r, std::vector &data_i) : data_r_(data_r), data_i_(data_i) {} /** * Destroy this variable reader. */ ~reader() {} /** * Return the number of scalars remaining to be read. * * @return Number of scalars left to read. */ inline size_t available() { return data_r_.size() - pos_; } /** * Return the number of integers remaining to be read. * * @return Number of integers left to read. */ inline size_t available_i() { return data_i_.size() - int_pos_; } /** * Return the next integer in the integer sequence. * * @return Next integer value. */ inline int integer() { if (int_pos_ >= data_i_.size()) BOOST_THROW_EXCEPTION(std::runtime_error("no more integers to read.")); return data_i_[int_pos_++]; } /** * Return the next integer in the integer sequence. * This form is a convenience method to make compiling * easier; its behavior is the same as int() * * @return Next integer value. */ inline int integer_constrain() { return integer(); } /** * Return the next integer in the integer sequence. * This form is a convenience method to make compiling * easier; its behavior is the same as integer() * * @return Next integer value. */ inline int integer_constrain(T & /*log_prob*/) { return integer(); } /** * Return the next scalar in the sequence. * * @return Next scalar value. */ inline T scalar() { if (pos_ >= data_r_.size()) BOOST_THROW_EXCEPTION(std::runtime_error("no more scalars to read")); return data_r_[pos_++]; } /** * Return the next scalar. For arbitrary scalars, * constraint is a no-op. * * @return Next scalar. */ inline T scalar_constrain() { return scalar(); } /** * Return the next scalar in the sequence, incrementing * the specified reference with the log absolute Jacobian determinant. * *

With no transformation, the Jacobian increment is a no-op. * *

See scalar_constrain(). * * log_prob Reference to log probability variable to increment. * @return Next scalar. */ T scalar_constrain(T & /*log_prob*/) { return scalar(); } /** * Return a standard library vector of the specified * dimensionality made up of the next scalars. * * @param m Size of vector. * @return Vector made up of the next scalars. */ inline std::vector std_vector(size_t m) { if (m == 0) return std::vector(); std::vector vec(&this->data_r_[this->pos_], &this->data_r_[this->pos_ + m]); this->pos_ += m; return vec; } /** * Return a column vector of specified dimensionality made up of * the next scalars. * * @param m Number of rows in the vector to read. * @return Column vector made up of the next scalars. */ inline vector_t vector(size_t m) { if (m == 0) return vector_t(); return map_vector_t(&scalar_ptr_increment(m), m); } /** * Return a column vector of specified dimensionality made up of * the next scalars. The constraint is a no-op. * * @param m Number of rows in the vector to read. * @return Column vector made up of the next scalars. */ inline vector_t vector_constrain(size_t m) { if (m == 0) return vector_t(); return map_vector_t(&scalar_ptr_increment(m), m); } /** * Return a column vector of specified dimensionality made up of * the next scalars. The constraint and hence Jacobian are no-ops. * * @param m Number of rows in the vector to read. * lp Log probability to increment. * @return Column vector made up of the next scalars. */ inline vector_t vector_constrain(size_t m, T & /*lp*/) { if (m == 0) return vector_t(); return map_vector_t(&scalar_ptr_increment(m), m); } /** * Return a row vector of specified dimensionality made up of * the next scalars. * * @param m Number of rows in the vector to read. * @return Column vector made up of the next scalars. */ inline row_vector_t row_vector(size_t m) { if (m == 0) return row_vector_t(); return map_row_vector_t(&scalar_ptr_increment(m), m); } /** * Return a row vector of specified dimensionality made up of * the next scalars. The constraint is a no-op. * * @param m Number of rows in the vector to read. * @return Column vector made up of the next scalars. */ inline row_vector_t row_vector_constrain(size_t m) { if (m == 0) return row_vector_t(); return map_row_vector_t(&scalar_ptr_increment(m), m); } /** * Return a row vector of specified dimensionality made up of * the next scalars. The constraint is a no-op, so the log * probability is not incremented. * * @param m Number of rows in the vector to read. * lp Log probability to increment. * @return Column vector made up of the next scalars. */ inline row_vector_t row_vector_constrain(size_t m, T & /*lp*/) { if (m == 0) return row_vector_t(); return map_row_vector_t(&scalar_ptr_increment(m), m); } /** * Return a matrix of the specified dimensionality made up of * the next scalars arranged in column-major order. * * Row-major reading means that if a matrix of m=2 * rows and n=3 columns is reada and the next * scalar values are 1,2,3,4,5,6, the result is * * 

   * a = 1 4
   *     2 5
   *     3 6
* * @param m Number of rows. * @param n Number of columns. * @return Eigen::Matrix made up of the next scalars. */ inline matrix_t matrix(size_t m, size_t n) { if (m == 0 || n == 0) return matrix_t(m, n); return map_matrix_t(&scalar_ptr_increment(m * n), m, n); } /** * Return a matrix of the specified dimensionality made up of * the next scalars arranged in column-major order. The * constraint is a no-op. See matrix(size_t, * size_t) for more information. * * @param m Number of rows. * @param n Number of columns. * @return Matrix made up of the next scalars. */ inline matrix_t matrix_constrain(size_t m, size_t n) { if (m == 0 || n == 0) return matrix_t(m, n); return map_matrix_t(&scalar_ptr_increment(m * n), m, n); } /** * Return a matrix of the specified dimensionality made up of * the next scalars arranged in column-major order. The * constraint is a no-op, hence the log probability is not * incremented. See matrix(size_t, size_t) * for more information. * * @param m Number of rows. * @param n Number of columns. * lp Log probability to increment. * @return Matrix made up of the next scalars. */ inline matrix_t matrix_constrain(size_t m, size_t n, T & /*lp*/) { if (m == 0 || n == 0) return matrix_t(m, n); return map_matrix_t(&scalar_ptr_increment(m * n), m, n); } /** * Return the next integer, checking that it is greater than * or equal to the specified lower bound. * * @param lb Lower bound. * @return Next integer read. * @throw std::runtime_error If the next integer read is not * greater than or equal to the lower bound. */ inline int integer_lb(int lb) { int i = integer(); if (!(i >= lb)) BOOST_THROW_EXCEPTION( std::runtime_error("required value greater than or equal to lb")); return i; } /** * Return the next integer, checking that it is greater than * or equal to the specified lower bound. * * @param lb Lower bound. * @return Next integer read. * @throw std::runtime_error If the next integer read is not * greater than or equal to the lower bound. */ inline int integer_lb_constrain(int lb) { return integer_lb(lb); } /** * Return the next integer, checking that it is greater than * or equal to the specified lower bound. * * @param lb Lower bound. * lp Log probability (ignored because no Jacobian) * @return Next integer read. * @throw std::runtime_error If the next integer read is not * greater than or equal to the lower bound. */ inline int integer_lb_constrain(int lb, T & /*lp*/) { return integer_lb(lb); } /** * Return the next integer, checking that it is less than * or equal to the specified upper bound. * * @param ub Upper bound. * @return Next integer read. * @throw std::runtime_error If the next integer read is not * less than or equal to the upper bound. */ inline int integer_ub(int ub) { int i = integer(); if (!(i <= ub)) BOOST_THROW_EXCEPTION( std::runtime_error("required value less than or equal to ub")); return i; } /** * Return the next integer, checking that it is less than * or equal to the specified upper bound. * * @param ub Upper bound. * @return Next integer read. * @throw std::runtime_error If the next integer read is not * less than or equal to the upper bound. */ inline int integer_ub_constrain(int ub) { return integer_ub(ub); } /** * Return the next integer, checking that it is less than * or equal to the specified upper bound. * * @param ub Upper bound. * lp Log probability (ignored because no Jacobian) * @return Next integer read. * @throw std::runtime_error If the next integer read is not * less than or equal to the upper bound. */ int integer_ub_constrain(int ub, T & /*lp*/) { return integer_ub(ub); } /** * Return the next integer, checking that it is less than * or equal to the specified upper bound. Even if the upper * bounds and lower bounds are not consistent, the next integer * value will be consumed. * * @param lb Lower bound. * @param ub Upper bound. * @return Next integer read. * @throw std::runtime_error If the next integer read is not * less than or equal to the upper bound. */ inline int integer_lub(int lb, int ub) { // read first to make position deterministic [arbitrary choice] int i = integer(); if (lb > ub) BOOST_THROW_EXCEPTION( std::runtime_error("lower bound must be less than or equal to ub")); if (!(i >= lb)) BOOST_THROW_EXCEPTION( std::runtime_error("required value greater than or equal to lb")); if (!(i <= ub)) BOOST_THROW_EXCEPTION( std::runtime_error("required value less than or equal to ub")); return i; } /** * Return the next integer, checking that it is less than * or equal to the specified upper bound. * * @param lb Lower bound. * @param ub Upper bound. * @return Next integer read. * @throw std::runtime_error If the next integer read is not * less than or equal to the upper bound. */ inline int integer_lub_constrain(int lb, int ub) { return integer_lub(lb, ub); } /** * Return the next integer, checking that it is less than * or equal to the specified upper bound. * * @param lb Lower bound. * @param ub Upper bound. * lp Log probability (ignored because no Jacobian) * @return Next integer read. * @throw std::runtime_error If the next integer read is not * less than or equal to the upper bound. */ inline int integer_lub_constrain(int lb, int ub, T & /*lp*/) { return integer_lub(lb, ub); } /** * Return the next scalar, checking that it is * positive. * *

See stan::math::check_positive(T). * * @return Next positive scalar. * @throw std::runtime_error if x is not positive */ inline T scalar_pos() { T x(scalar()); stan::math::check_positive("stan::io::scalar_pos", "Constrained scalar", x); return x; } /** * Return the next scalar, transformed to be positive. * *

See stan::math::positive_constrain(T). * * @return The next scalar transformed to be positive. */ inline T scalar_pos_constrain() { return stan::math::positive_constrain(scalar()); } /** * Return the next scalar transformed to be positive, * incrementing the specified reference with the log absolute * determinant of the Jacobian. * *

See stan::math::positive_constrain(T,T&). * * @param lp Reference to log probability variable to increment. * @return The next scalar transformed to be positive. */ inline T scalar_pos_constrain(T &lp) { return stan::math::positive_constrain(scalar(), lp); } /** * Return the next scalar, checking that it is * greater than or equal to the specified lower bound. * *

See stan::math::check_greater_or_equal(T,double). * * @param lb Lower bound. * @return Next scalar value. * @tparam TL Type of lower bound. * @throw std::runtime_error if the scalar is less than the * specified lower bound */ template inline T scalar_lb(const TL lb) { T x(scalar()); stan::math::check_greater_or_equal("stan::io::scalar_lb", "Constrained scalar", x, lb); return x; } /** * Return the next scalar transformed to have the * specified lower bound. * *

See stan::math::lb_constrain(T,double). * * @tparam TL Type of lower bound. * @param lb Lower bound on values. * @return Next scalar transformed to have the specified * lower bound. */ template inline T scalar_lb_constrain(const TL lb) { return stan::math::lb_constrain(scalar(), lb); } /** * Return the next scalar transformed to have the specified * lower bound, incrementing the specified reference with the * log of the absolute Jacobian determinant of the transform. * *

See stan::math::lb_constrain(T,double,T&). * * @tparam TL Type of lower bound. * @param lb Lower bound on result. * @param lp Reference to log probability variable to increment. */ template inline T scalar_lb_constrain(const TL lb, T &lp) { return stan::math::lb_constrain(scalar(), lb, lp); } /** * Return the next scalar, checking that it is * less than or equal to the specified upper bound. * *

See stan::math::check_less_or_equal(T,double). * * @tparam TU Type of upper bound. * @param ub Upper bound. * @return Next scalar value. * @throw std::runtime_error if the scalar is greater than the * specified upper bound */ template inline T scalar_ub(TU ub) { T x(scalar()); stan::math::check_less_or_equal("stan::io::scalar_ub", "Constrained scalar", x, ub); return x; } /** * Return the next scalar transformed to have the * specified upper bound. * *

See stan::math::ub_constrain(T,double). * * @tparam TU Type of upper bound. * @param ub Upper bound on values. * @return Next scalar transformed to have the specified * upper bound. */ template inline T scalar_ub_constrain(const TU ub) { return stan::math::ub_constrain(scalar(), ub); } /** * Return the next scalar transformed to have the specified * upper bound, incrementing the specified reference with the * log of the absolute Jacobian determinant of the transform. * *

See stan::math::ub_constrain(T,double,T&). * * @tparam TU Type of upper bound. * @param ub Upper bound on result. * @param lp Reference to log probability variable to increment. */ template inline T scalar_ub_constrain(const TU ub, T &lp) { return stan::math::ub_constrain(scalar(), ub, lp); } /** * Return the next scalar, checking that it is between * the specified lower and upper bound. * *

See stan::math::check_bounded(T, double, double). * * @tparam TL Type of lower bound. * @tparam TU Type of upper bound. * @param lb Lower bound. * @param ub Upper bound. * @return Next scalar value. * @throw std::runtime_error if the scalar is not between the specified * lower and upper bounds. */ template inline T scalar_lub(const TL lb, const TU ub) { T x(scalar()); stan::math::check_bounded("stan::io::scalar_lub", "Constrained scalar", x, lb, ub); return x; } /** * Return the next scalar transformed to be between * the specified lower and upper bounds. * *

See stan::math::lub_constrain(T, double, double). * * @tparam TL Type of lower bound. * @tparam TU Type of upper bound. * @param lb Lower bound. * @param ub Upper bound. * @return Next scalar transformed to fall between the specified * bounds. */ template inline T scalar_lub_constrain(const TL lb, const TU ub) { return stan::math::lub_constrain(scalar(), lb, ub); } /** * Return the next scalar transformed to be between the * the specified lower and upper bounds. * *

See stan::math::lub_constrain(T, double, double, T&). * * @param lb Lower bound. * @param ub Upper bound. * @param lp Reference to log probability variable to increment. * @tparam T Type of scalar. * @tparam TL Type of lower bound. * @tparam TU Type of upper bound. */ template inline T scalar_lub_constrain(TL lb, TU ub, T &lp) { return stan::math::lub_constrain(scalar(), lb, ub, lp); } /** * Return the next scalar. * * @tparam TL type of offset * @tparam TS type of multiplier * @param offset offset * @param multiplier multiplier * @return next scalar value */ template inline T scalar_offset_multiplier(const TL offset, const TS multiplier) { T x(scalar()); return x; } /** * Return the next scalar transformed to have the specified offset and * multiplier. * *

See stan::math::offset_multiplier_constrain(T, double, * double). * * @tparam TL Type of offset. * @tparam TS Type of multiplier. * @param offset Offset. * @param multiplier Multiplier. * @return Next scalar transformed to fall between the specified * bounds. */ template inline T scalar_offset_multiplier_constrain(const TL offset, const TS multiplier) { return stan::math::offset_multiplier_constrain(scalar(), offset, multiplier); } /** * Return the next scalar transformed to have the specified offset and * multiplier. * *

See stan::math::offset_multiplier_constrain(T, double, double, * T&). * * @param offset Offset. * @param multiplier Multiplier. * @param lp Reference to log probability variable to increment. * @tparam T Type of scalar. * @tparam TL Type of offset. * @tparam TS Type of multiplier. */ template inline T scalar_offset_multiplier_constrain(TL offset, TS multiplier, T &lp) { return stan::math::offset_multiplier_constrain(scalar(), offset, multiplier, lp); } /** * Return the next scalar, checking that it is a valid value for * a probability, between 0 (inclusive) and 1 (inclusive). * *

See stan::math::check_bounded(T). * * @return Next probability value. */ inline T prob() { T x(scalar()); stan::math::check_bounded( "stan::io::prob", "Constrained probability", x, 0, 1); return x; } /** * Return the next scalar transformed to be a probability * between 0 and 1. * *

See stan::math::prob_constrain(T). * * @return The next scalar transformed to a probability. */ inline T prob_constrain() { return stan::math::prob_constrain(scalar()); } /** * Return the next scalar transformed to be a probability * between 0 and 1, incrementing the specified reference with * the log of the absolute Jacobian determinant. * *

See stan::math::prob_constrain(T). * * @param lp Reference to log probability variable to increment. * @return The next scalar transformed to a probability. */ inline T prob_constrain(T &lp) { return stan::math::prob_constrain(scalar(), lp); } /** * Return the next scalar, checking that it is a valid * value for a correlation, between -1 (inclusive) and * 1 (inclusive). * *

See stan::math::check_bounded(T). * * @return Next correlation value. * @throw std::runtime_error if the value is not valid * for a correlation */ inline T corr() { T x(scalar()); stan::math::check_bounded("stan::io::corr", "Correlation value", x, -1, 1); return x; } /** * Return the next scalar transformed to be a correlation * between -1 and 1. * *

See stan::math::corr_constrain(T). * * @return The next scalar transformed to a correlation. */ inline T corr_constrain() { return stan::math::corr_constrain(scalar()); } /** * Return the next scalar transformed to be a (partial) * correlation between -1 and 1, incrementing the specified * reference with the log of the absolute Jacobian determinant. * *

See stan::math::corr_constrain(T,T&). * * @param lp The reference to the variable holding the log * probability to increment. * @return The next scalar transformed to a correlation. */ inline T corr_constrain(T &lp) { return stan::math::corr_constrain(scalar(), lp); } /** * Return a unit_vector of the specified size made up of the * next scalars. * *

See stan::math::check_unit_vector. * * @param k Size of returned unit_vector * @return unit_vector read from the specified size number of scalars * @throw std::runtime_error if the next k values is not a unit_vector * @throw std::invalid_argument if k is zero */ inline vector_t unit_vector(size_t k) { if (k == 0) { std::string msg = "io::unit_vector: unit vectors cannot be size 0."; throw std::invalid_argument(msg); } vector_t theta(vector(k)); stan::math::check_unit_vector("stan::io::unit_vector", "Constrained vector", theta); return theta; } /** * Return the next unit_vector transformed vector of the specified * length. This operation consumes one less than the specified * length number of scalars. * *

See stan::math::unit_vector_constrain(Eigen::Matrix). * * @param k Number of dimensions in resulting unit_vector. * @return unit_vector derived from next k scalars. * @throw std::invalid_argument if k is zero */ inline Eigen::Matrix unit_vector_constrain(size_t k) { if (k == 0) { std::string msg = "io::unit_vector_constrain:" " unit vectors cannot be size 0."; throw std::invalid_argument(msg); } return stan::math::unit_vector_constrain(vector(k)); } /** * Return the next unit_vector of the specified size (using one fewer * unconstrained scalars), incrementing the specified reference with the * log absolute Jacobian determinant. * *

See stan::math::unit_vector_constrain(Eigen::Matrix,T&). * * @param k Size of unit_vector. * @param lp Log probability to increment with log absolute * Jacobian determinant. * @return The next unit_vector of the specified size. * @throw std::invalid_argument if k is zero */ inline vector_t unit_vector_constrain(size_t k, T &lp) { if (k == 0) { std::string msg = "io::unit_vector_constrain:" " unit vectors cannot be size 0."; throw std::invalid_argument(msg); } return stan::math::unit_vector_constrain(vector(k), lp); } /** * Return a simplex of the specified size made up of the * next scalars. * *

See stan::math::check_simplex. * * @param k Size of returned simplex. * @return Simplex read from the specified size number of scalars. * @throw std::runtime_error if the k values is not a simplex. * @throw std::invalid_argument if k is zero */ inline vector_t simplex(size_t k) { if (k == 0) { std::string msg = "io::simplex: simplexes cannot be size 0."; throw std::invalid_argument(msg); } vector_t theta(vector(k)); stan::math::check_simplex("stan::io::simplex", "Constrained vector", theta); return theta; } /** * Return the next simplex transformed vector of the specified * length. This operation consumes one less than the specified * length number of scalars. * *

See stan::math::simplex_constrain(Eigen::Matrix). * * @param k number of dimensions in resulting simplex * @return simplex derived from next `k - 1` scalars * @throws std::invalid_argument if number of dimensions (`k`) is zero */ inline Eigen::Matrix simplex_constrain(size_t k) { if (k == 0) { std::string msg = "io::simplex_constrain: simplexes cannot be size 0."; throw std::invalid_argument(msg); } return stan::math::simplex_constrain(vector(k - 1)); } /** * Return the next simplex of the specified size (using one fewer * unconstrained scalars), incrementing the specified reference with the * log absolute Jacobian determinant. * *

See stan::math::simplex_constrain(Eigen::Matrix,T&). * * @param k Size of simplex. * @param lp Log probability to increment with log absolute * Jacobian determinant. * @return The next simplex of the specified size. * @throws std::invalid_argument if number of dimensions (`k`) is zero */ inline vector_t simplex_constrain(size_t k, T &lp) { if (k == 0) { std::string msg = "io::simplex_constrain: simplexes cannot be size 0."; throw std::invalid_argument(msg); } return stan::math::simplex_constrain(vector(k - 1), lp); } /** * Return the next vector of specified size containing * values in ascending order. * *

See stan::math::check_ordered(T) for * behavior on failure. * * @param k Size of returned vector. * @return Vector of positive values in ascending order. */ inline vector_t ordered(size_t k) { vector_t x(vector(k)); stan::math::check_ordered("stan::io::ordered", "Constrained vector", x); return x; } /** * Return the next ordered vector of the specified length. * *

See stan::math::ordered_constrain(Matrix). * * @param k Length of returned vector. * @return Next ordered vector of the specified * length. */ inline vector_t ordered_constrain(size_t k) { return stan::math::ordered_constrain(vector(k)); } /** * Return the next ordered vector of the specified * size, incrementing the specified reference with the log * absolute Jacobian of the determinant. * *

See stan::math::ordered_constrain(Matrix,T&). * * @param k Size of vector. * @param lp Log probability reference to increment. * @return Next ordered vector of the specified size. */ inline vector_t ordered_constrain(size_t k, T &lp) { return stan::math::ordered_constrain(vector(k), lp); } /** * Return the next vector of specified size containing * positive values in ascending order. * *

See stan::math::check_positive_ordered(T) for * behavior on failure. * * @param k Size of returned vector. * @return Vector of positive values in ascending order. */ inline vector_t positive_ordered(size_t k) { vector_t x(vector(k)); stan::math::check_positive_ordered("stan::io::positive_ordered", "Constrained vector", x); return x; } /** * Return the next positive ordered vector of the specified length. * *

See stan::math::positive_ordered_constrain(Matrix). * * @param k Length of returned vector. * @return Next positive_ordered vector of the specified * length. */ inline vector_t positive_ordered_constrain(size_t k) { return stan::math::positive_ordered_constrain(vector(k)); } /** * Return the next positive_ordered vector of the specified * size, incrementing the specified reference with the log * absolute Jacobian of the determinant. * *

See stan::math::positive_ordered_constrain(Matrix,T&). * * @param k Size of vector. * @param lp Log probability reference to increment. * @return Next positive_ordered vector of the specified size. */ inline vector_t positive_ordered_constrain(size_t k, T &lp) { return stan::math::positive_ordered_constrain(vector(k), lp); } /** * Return the next Cholesky factor with the specified * dimensionality, reading it directly without transforms. * * @param M Rows of Cholesky factor * @param N Columns of Cholesky factor * @return Next Cholesky factor. * @throw std::domain_error if the matrix is not a valid * Cholesky factor. */ inline matrix_t cholesky_factor_cov(size_t M, size_t N) { matrix_t y(matrix(M, N)); stan::math::check_cholesky_factor("stan::io::cholesky_factor_cov", "Constrained matrix", y); return y; } /** * Return the next Cholesky factor with the specified * dimensionality, reading from an unconstrained vector of the * appropriate size. * * @param M Rows of Cholesky factor * @param N Columns of Cholesky factor * @return Next Cholesky factor. * @throw std::domain_error if the matrix is not a valid * Cholesky factor. */ inline matrix_t cholesky_factor_cov_constrain(size_t M, size_t N) { return stan::math::cholesky_factor_constrain( vector((N * (N + 1)) / 2 + (M - N) * N), M, N); } /** * Return the next Cholesky factor with the specified * dimensionality, reading from an unconstrained vector of the * appropriate size, and increment the log probability reference * with the log Jacobian adjustment for the transform. * * @param M Rows of Cholesky factor * @param N Columns of Cholesky factor * @param[in,out] lp log probability * @return Next Cholesky factor. * @throw std::domain_error if the matrix is not a valid * Cholesky factor. */ inline matrix_t cholesky_factor_cov_constrain(size_t M, size_t N, T &lp) { return stan::math::cholesky_factor_constrain( vector((N * (N + 1)) / 2 + (M - N) * N), M, N, lp); } /** * Return the next Cholesky factor for a correlation matrix with * the specified dimensionality, reading it directly without * transforms. * * @param K Rows and columns of Cholesky factor * @return Next Cholesky factor for a correlation matrix. * @throw std::domain_error if the matrix is not a valid * Cholesky factor for a correlation matrix. */ inline matrix_t cholesky_factor_corr(size_t K) { using stan::math::check_cholesky_factor_corr; matrix_t y(matrix(K, K)); check_cholesky_factor_corr("stan::io::cholesky_factor_corr", "Constrained matrix", y); return y; } /** * Return the next Cholesky factor for a correlation matrix with * the specified dimensionality, reading from an unconstrained * vector of the appropriate size. * * @param K Rows and columns of Cholesky factor. * @return Next Cholesky factor for a correlation matrix. * @throw std::domain_error if the matrix is not a valid * Cholesky factor for a correlation matrix. */ inline matrix_t cholesky_factor_corr_constrain(size_t K) { return stan::math::cholesky_corr_constrain(vector((K * (K - 1)) / 2), K); } inline matrix_t cholesky_corr_constrain(size_t K) { return stan::math::cholesky_corr_constrain(vector((K * (K - 1)) / 2), K); } /** * Return the next Cholesky factor for a correlation matrix with * the specified dimensionality, reading from an unconstrained * vector of the appropriate size, and increment the log * probability reference with the log Jacobian adjustment for * the transform. * * @param K Rows and columns of Cholesky factor * @param lp Log probability reference to increment. * @return Next Cholesky factor for a correlation matrix. * @throw std::domain_error if the matrix is not a valid * Cholesky factor for a correlation matrix. */ inline matrix_t cholesky_factor_corr_constrain(size_t K, T &lp) { return stan::math::cholesky_corr_constrain(vector((K * (K - 1)) / 2), K, lp); } inline matrix_t cholesky_corr_constrain(size_t K, T &lp) { return stan::math::cholesky_corr_constrain(vector((K * (K - 1)) / 2), K, lp); } /** * Return the next covariance matrix with the specified * dimensionality. * *

See stan::math::check_cov_matrix(Matrix). * * @param k Dimensionality of covariance matrix. * @return Next covariance matrix of the specified dimensionality. * @throw std::runtime_error if the matrix is not a valid * covariance matrix */ inline matrix_t cov_matrix(size_t k) { matrix_t y(matrix(k, k)); stan::math::check_cov_matrix("stan::io::cov_matrix", "Constrained matrix", y); return y; } /** * Return the next covariance matrix of the specified dimensionality. * *

See stan::math::cov_matrix_constrain(Matrix). * * @param k Dimensionality of covariance matrix. * @return Next covariance matrix of the specified dimensionality. */ inline matrix_t cov_matrix_constrain(size_t k) { return stan::math::cov_matrix_constrain(vector(k + (k * (k - 1)) / 2), k); } /** * Return the next covariance matrix of the specified dimensionality, * incrementing the specified reference with the log absolute Jacobian * determinant. * *

See stan::math::cov_matrix_constrain(Matrix,T&). * * @param k Dimensionality of the (square) covariance matrix. * @param lp Log probability reference to increment. * @return The next covariance matrix of the specified dimensionality. */ inline matrix_t cov_matrix_constrain(size_t k, T &lp) { return stan::math::cov_matrix_constrain(vector(k + (k * (k - 1)) / 2), k, lp); } /** * Returns the next correlation matrix of the specified dimensionality. * *

See stan::math::check_corr_matrix(Matrix). * * @param k Dimensionality of correlation matrix. * @return Next correlation matrix of the specified dimensionality. * @throw std::runtime_error if the matrix is not a correlation matrix */ inline matrix_t corr_matrix(size_t k) { matrix_t x(matrix(k, k)); stan::math::check_corr_matrix("stan::math::corr_matrix", "Constrained matrix", x); return x; } /** * Return the next correlation matrix of the specified dimensionality. * *

See stan::math::corr_matrix_constrain(Matrix). * * @param k Dimensionality of correlation matrix. * @return Next correlation matrix of the specified dimensionality. */ inline matrix_t corr_matrix_constrain(size_t k) { return stan::math::corr_matrix_constrain(vector((k * (k - 1)) / 2), k); } /** * Return the next correlation matrix of the specified dimensionality, * incrementing the specified reference with the log absolute Jacobian * determinant. * *

See stan::math::corr_matrix_constrain(Matrix,T&). * * @param k Dimensionality of the (square) correlation matrix. * @param lp Log probability reference to increment. * @return The next correlation matrix of the specified dimensionality. */ inline matrix_t corr_matrix_constrain(size_t k, T &lp) { return stan::math::corr_matrix_constrain(vector((k * (k - 1)) / 2), k, lp); } template inline vector_t vector_lb(const TL lb, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lb(lb); return v; } template inline vector_t vector_lb_constrain(const TL lb, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lb_constrain(lb); return v; } template inline vector_t vector_lb_constrain(const TL lb, size_t m, T &lp) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lb_constrain(lb, lp); return v; } template inline row_vector_t row_vector_lb(const TL lb, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lb(lb); return v; } template inline row_vector_t row_vector_lb_constrain(const TL lb, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lb_constrain(lb); return v; } template inline row_vector_t row_vector_lb_constrain(const TL lb, size_t m, T &lp) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lb_constrain(lb, lp); return v; } template inline matrix_t matrix_lb(const TL lb, const size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_lb(lb); return v; } template inline matrix_t matrix_lb_constrain(const TL lb, size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_lb_constrain(lb); return v; } template inline matrix_t matrix_lb_constrain(const TL lb, size_t m, size_t n, T &lp) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_lb_constrain(lb, lp); return v; } template inline vector_t vector_ub(const TU ub, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_ub(ub); return v; } template inline vector_t vector_ub_constrain(const TU ub, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_ub_constrain(ub); return v; } template inline vector_t vector_ub_constrain(const TU ub, size_t m, T &lp) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_ub_constrain(ub, lp); return v; } template inline row_vector_t row_vector_ub(const TU ub, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_ub(ub); return v; } template inline row_vector_t row_vector_ub_constrain(const TU ub, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_ub_constrain(ub); return v; } template inline row_vector_t row_vector_ub_constrain(const TU ub, size_t m, T &lp) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_ub_constrain(ub, lp); return v; } template inline matrix_t matrix_ub(const TU ub, size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_ub(ub); return v; } template inline matrix_t matrix_ub_constrain(const TU ub, const size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_ub_constrain(ub); return v; } template inline matrix_t matrix_ub_constrain(const TU ub, const size_t m, size_t n, T &lp) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_ub_constrain(ub, lp); return v; } template inline vector_t vector_lub(const TL lb, const TU ub, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lub(lb, ub); return v; } template inline vector_t vector_lub_constrain(const TL lb, const TU ub, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lub_constrain(lb, ub); return v; } template inline vector_t vector_lub_constrain(const TL lb, const TU ub, size_t m, T &lp) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lub_constrain(lb, ub, lp); return v; } template inline row_vector_t row_vector_lub(const TL lb, const TU ub, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lub(lb, ub); return v; } template inline row_vector_t row_vector_lub_constrain(const TL lb, const TU ub, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lub_constrain(lb, ub); return v; } template inline row_vector_t row_vector_lub_constrain(const TL lb, const TU ub, size_t m, T &lp) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_lub_constrain(lb, ub, lp); return v; } template inline matrix_t matrix_lub(const TL lb, const TU ub, size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_lub(lb, ub); return v; } template inline matrix_t matrix_lub_constrain(const TL lb, const TU ub, size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_lub_constrain(lb, ub); return v; } template inline matrix_t matrix_lub_constrain(const TL lb, const TU ub, size_t m, size_t n, T &lp) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_lub_constrain(lb, ub, lp); return v; } template inline vector_t vector_offset_multiplier(const TL offset, const TS multiplier, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_offset_multiplier(offset, multiplier); return v; } template inline vector_t vector_offset_multiplier_constrain(const TL offset, const TS multiplier, size_t m) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_offset_multiplier_constrain(offset, multiplier); return v; } template inline vector_t vector_offset_multiplier_constrain(const TL offset, const TS multiplier, size_t m, T &lp) { vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_offset_multiplier_constrain(offset, multiplier, lp); return v; } template inline row_vector_t row_vector_offset_multiplier(const TL offset, const TS multiplier, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_offset_multiplier(offset, multiplier); return v; } template inline row_vector_t row_vector_offset_multiplier_constrain( const TL offset, const TS multiplier, size_t m) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_offset_multiplier_constrain(offset, multiplier); return v; } template inline row_vector_t row_vector_offset_multiplier_constrain( const TL offset, const TS multiplier, size_t m, T &lp) { row_vector_t v(m); for (size_t i = 0; i < m; ++i) v(i) = scalar_offset_multiplier_constrain(offset, multiplier, lp); return v; } template inline matrix_t matrix_offset_multiplier(const TL offset, const TS multiplier, size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_offset_multiplier(offset, multiplier); return v; } template inline matrix_t matrix_offset_multiplier_constrain(const TL offset, const TS multiplier, size_t m, size_t n) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_offset_multiplier_constrain(offset, multiplier); return v; } template inline matrix_t matrix_offset_multiplier_constrain(const TL offset, const TS multiplier, size_t m, size_t n, T &lp) { matrix_t v(m, n); for (size_t j = 0; j < n; ++j) for (size_t i = 0; i < m; ++i) v(i, j) = scalar_offset_multiplier_constrain(offset, multiplier, lp); return v; } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/is_whitespace.hpp0000644000176200001440000000077313766554456022612 0ustar liggesusers#ifndef STAN_IO_IS_WHITESPACE_HPP #define STAN_IO_IS_WHITESPACE_HPP #include namespace stan { namespace io { /** * Returns true if the specified character is an ASCII space character. * The space characters are the space, newline, carriage return, and tab. * * @param c character to test * @return true if it is an ASCII whitespace character */ inline bool is_whitespace(char c) { return c == ' ' || c == '\n' || c == '\r' || c == '\t'; } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/dump.hpp0000644000176200001440000005101113766554456020717 0ustar liggesusers#ifndef STAN_IO_DUMP_HPP #define STAN_IO_DUMP_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace io { using Eigen::Dynamic; /** * Reads data from S-plus dump format. * * A dump_reader parses data from the S-plus dump * format, a human-readable ASCII representation of arbitrarily * dimensioned arrays of integers and arrays of floating point * values. * *

Stan's dump reader is limited to reading * integers, scalars and arrays of arbitrary dimensionality of * integers and scalars. It is able to read from a file * consisting of a sequence of dumped variables. * *

There cannot be any NA * (i.e., undefined) values, because these cannot be * represented as double values. * *

The dump reader class follows a standard scanner pattern. * The method next() is called to scan the next * input. The type, dimensions, and values of the input is then * available through method calls. Here, the type is either * double or integer, and the values are the name of the variable * and its array of values. If there is a single value, the * dimension array is empty. For a list, the dimension * array contains a single entry for the number of values. * For an array, the dimensions are the dimensions of the array. * *

Reads are performed in an "S-compatible" mode whereby * a string such as "1" or "-127" denotes and integer, whereas * a string such as "1." or "0.9e-5" represents a floating * point value. * *

The dump reader treats "integer(x)" as an array of zeros * (type being integer and length x), where x any non-negative * integers and x can be omitted to indicate zero-length. * So the following are all legitimate: * "x <- integer()", * "x <- integer(0) ", and "x <- integer(3)". For array of zeros * of type double, we can replace the above "integer" with "double". * This is mainly for the purpose of supporting zero-size arrays * such as "x <- structure(integer(0), .Dim = c(2, 0))". * *

For dumping, arrays are indexed in last-index major fashion, * which corresponds to column-major order for matrices * represented as two-dimensional arrays. As a result, the first * indices change fastest. For instance, if there is an * three-dimensional array x with dimensions * [2,2,2], then there are 8 values, provided in the * order * *

[0,0,0], * [1,0,0], * [0,1,0], * [1,1,0], * [0,0,1], * [1,0,1], * [0,1,1], * [1,1,1]. * * definitions ::= definition+ * * definition ::= name ("<-" | '=') value optional_semicolon * * name ::= char* * | ''' char* ''' * | '"' char* '"' * * value ::= value | value * * value ::= T * | seq * | zero_array * | "structure" '(' seq ',' ".Dim" '=' seq ')' * | "structure" '(' zero_array ',' ".Dim" '=' seq ')' * * seq ::= int ':' int * | cseq * * seq ::= cseq * * cseq ::= 'c' '(' vseq ')' * * vseq ::= T * | T ',' vseq * * zero_array ::= "integer" * * zero_array ::= "double" * */ class dump_reader { private: std::string buf_; std::string name_; std::vector stack_i_; std::vector stack_r_; std::vector dims_; std::istream& in_; bool scan_single_char(char c_expected) { int c = in_.peek(); if (in_.fail()) return false; if (c != c_expected) return false; char c_skip; in_.get(c_skip); return true; } bool scan_optional_long() { if (scan_single_char('l')) return true; else if (scan_single_char('L')) return true; else return false; } bool scan_char(char c_expected) { char c; in_ >> c; if (in_.fail()) return false; if (c != c_expected) { in_.putback(c); return false; } return true; } bool scan_name_unquoted() { char c; in_ >> c; if (in_.fail()) return false; if (!std::isalpha(c)) return false; name_.push_back(c); while (in_.get(c)) { // get turns off auto space skip if (std::isalpha(c) || std::isdigit(c) || c == '_' || c == '.') { name_.push_back(c); } else { in_.putback(c); return true; } } return true; // but hit eos } bool scan_name() { if (scan_char('"')) { if (!scan_name_unquoted()) return false; if (!scan_char('"')) return false; } else if (scan_char('\'')) { if (!scan_name_unquoted()) return false; if (!scan_char('\'')) return false; } else { if (!scan_name_unquoted()) return false; } return true; } bool scan_chars(const char* s, bool case_sensitive = true) { for (size_t i = 0; s[i]; ++i) { char c; if (!(in_ >> c)) { for (size_t j = 1; j < i; ++j) in_.putback(s[i - j]); return false; } // all ASCII, so toupper is OK if ((case_sensitive && c != s[i]) || (!case_sensitive && ::toupper(c) != ::toupper(s[i]))) { in_.putback(c); for (size_t j = 1; j < i; ++j) in_.putback(s[i - j]); return false; } } return true; } bool scan_chars(std::string s, bool case_sensitive = true) { for (size_t i = 0; i < s.size(); ++i) { char c; if (!(in_ >> c)) { for (size_t j = 1; j < i; ++j) in_.putback(s[i - j]); return false; } // all ASCII, so toupper is OK if ((case_sensitive && c != s[i]) || (!case_sensitive && ::toupper(c) != ::toupper(s[i]))) { in_.putback(c); for (size_t j = 1; j < i; ++j) in_.putback(s[i - j]); return false; } } return true; } size_t scan_dim() { char c; buf_.clear(); while (in_.get(c)) { if (std::isspace(c)) continue; if (std::isdigit(c)) { buf_.push_back(c); } else { in_.putback(c); break; } } scan_optional_long(); size_t d = 0; try { d = boost::lexical_cast(buf_); } catch (const boost::bad_lexical_cast& exc) { std::string msg = "value " + buf_ + " beyond array dimension range"; BOOST_THROW_EXCEPTION(std::invalid_argument(msg)); } return d; } int scan_int() { char c; buf_.clear(); while (in_.get(c)) { if (std::isspace(c)) continue; if (std::isdigit(c)) { buf_.push_back(c); } else { in_.putback(c); break; } } return (get_int()); } int get_int() { int n = 0; try { n = boost::lexical_cast(buf_); } catch (const boost::bad_lexical_cast& exc) { std::string msg = "value " + buf_ + " beyond int range"; BOOST_THROW_EXCEPTION(std::invalid_argument(msg)); } return n; } double scan_double() { double x = 0; try { x = boost::lexical_cast(buf_); if (x == 0) validate_zero_buf(buf_); } catch (const boost::bad_lexical_cast& exc) { std::string msg = "value " + buf_ + " beyond numeric range"; BOOST_THROW_EXCEPTION(std::invalid_argument(msg)); } return x; } // scan number stores number or throws bad lexical cast exception void scan_number(bool negate_val) { // must take longest first! if (scan_chars("Inf")) { scan_chars("inity"); // read past if there stack_r_.push_back(negate_val ? -std::numeric_limits::infinity() : std::numeric_limits::infinity()); return; } if (scan_chars("NaN", false)) { stack_r_.push_back(std::numeric_limits::quiet_NaN()); return; } char c; bool is_double = false; buf_.clear(); while (in_.get(c)) { if (std::isdigit(c)) { // before pre-scan || c == '-' || c == '+') { buf_.push_back(c); } else if (c == '.' || c == 'e' || c == 'E' || c == '-' || c == '+') { is_double = true; buf_.push_back(c); } else { in_.putback(c); break; } } if (!is_double && stack_r_.size() == 0) { int n = get_int(); stack_i_.push_back(negate_val ? -n : n); scan_optional_long(); } else { for (size_t j = 0; j < stack_i_.size(); ++j) stack_r_.push_back(static_cast(stack_i_[j])); stack_i_.clear(); double x = scan_double(); stack_r_.push_back(negate_val ? -x : x); } } void scan_number() { char c; while (in_.get(c)) { if (std::isspace(c)) continue; in_.putback(c); break; } bool negate_val = scan_char('-'); if (!negate_val) scan_char('+'); // flush leading + return scan_number(negate_val); } bool scan_zero_integers() { if (!scan_char('(')) return false; if (scan_char(')')) { dims_.push_back(0U); return true; } int s = scan_int(); if (s < 0) return false; for (int i = 0; i < s; ++i) { stack_i_.push_back(0); } if (!scan_char(')')) return false; dims_.push_back(s); return true; } bool scan_zero_doubles() { if (!scan_char('(')) return false; if (scan_char(')')) { dims_.push_back(0U); return true; } int s = scan_int(); if (s < 0) return false; for (int i = 0; i < s; ++i) { stack_r_.push_back(0); } if (!scan_char(')')) return false; dims_.push_back(s); return true; } bool scan_seq_value() { if (!scan_char('(')) return false; if (scan_char(')')) { dims_.push_back(0U); return true; } scan_number(); // first entry while (scan_char(',')) { scan_number(); } dims_.push_back(stack_r_.size() + stack_i_.size()); return scan_char(')'); } bool scan_struct_value() { if (!scan_char('(')) return false; if (scan_chars("integer")) { scan_zero_integers(); } else if (scan_chars("double")) { scan_zero_doubles(); } else if (scan_char('c')) { scan_seq_value(); } else { int start = scan_int(); if (!scan_char(':')) return false; int end = scan_int(); if (start <= end) { for (int i = start; i <= end; ++i) stack_i_.push_back(i); } else { for (int i = start; i >= end; --i) stack_i_.push_back(i); } } dims_.clear(); if (!scan_char(',')) return false; if (!scan_char('.')) return false; if (!scan_chars("Dim")) return false; if (!scan_char('=')) return false; if (scan_char('c')) { if (!scan_char('(')) return false; size_t dim = scan_dim(); dims_.push_back(dim); while (scan_char(',')) { dim = scan_dim(); dims_.push_back(dim); } if (!scan_char(')')) return false; } else { size_t start = scan_dim(); if (!scan_char(':')) return false; size_t end = scan_dim(); if (start < end) { for (size_t i = start; i <= end; ++i) dims_.push_back(i); } else { for (size_t i = start; i >= end; --i) dims_.push_back(i); } } if (!scan_char(')')) return false; return true; } bool scan_value() { if (scan_char('c')) return scan_seq_value(); if (scan_chars("integer")) return scan_zero_integers(); if (scan_chars("double")) return scan_zero_doubles(); if (scan_chars("structure")) return scan_struct_value(); scan_number(); if (!scan_char(':')) return true; if (stack_i_.size() != 1) return false; scan_number(); if (stack_i_.size() != 2) return false; int start = stack_i_[0]; int end = stack_i_[1]; stack_i_.clear(); if (start <= end) { for (int i = start; i <= end; ++i) stack_i_.push_back(i); } else { for (int i = start; i >= end; --i) stack_i_.push_back(i); } dims_.push_back(stack_i_.size()); return true; } public: /** * Construct a reader for the specified input stream. * * @param in Input stream reference from which to read. */ explicit dump_reader(std::istream& in) : in_(in) {} /** * Destroy this reader. */ ~dump_reader() {} /** * Return the name of the most recently read variable. * * @return Name of most recently read variable. */ std::string name() { return name_; } /** * Return the dimensions of the most recently * read variable. * * @return Last dimensions. */ std::vector dims() { return dims_; } /** * Checks if the last item read is integer. * * Return true if the value(s) in the most recently * read item are integer values and false if * they are floating point. */ bool is_int() { // return stack_i_.size() > 0; return stack_r_.size() == 0; } /** * Returns the integer values from the last item if the * last item read was an integer and the empty vector otherwise. * * @return Integer values of last item. */ std::vector int_values() { return stack_i_; } /** * Returns the floating point values from the last item if the * last item read contained floating point values and the empty * vector otherwise. * * @return Floating point values of last item. */ std::vector double_values() { return stack_r_; } /** * Read the next value from the input stream, returning * true if successful and false if no * further input may be read. * * @return Return true if a fresh variable was read. * @throws bad_cast if bad number values encountered. */ bool next() { stack_r_.clear(); stack_i_.clear(); dims_.clear(); name_.erase(); if (!scan_name()) // set name return false; if (!scan_char('<')) // set <- return false; if (!scan_char('-')) return false; try { bool okSyntax = scan_value(); // set stack_r_, stack_i_, dims_ if (!okSyntax) { std::string msg = "syntax error"; BOOST_THROW_EXCEPTION(std::invalid_argument(msg)); } } catch (const std::invalid_argument& e) { std::string msg = "data " + name_ + " " + e.what(); BOOST_THROW_EXCEPTION(std::invalid_argument(msg)); } return true; } }; /** * Represents named arrays with dimensions. * * A dump object represents a dump of named arrays with dimensions. * The arrays may have any dimensionality. The values for an array * are typed to double or int. * *

See dump_reader for more information on the format. * *

Dump objects are created from reading dump files from an * input stream. * *

The dimensions and values of variables * may be accessed by name. */ class dump : public stan::io::var_context { private: std::map, std::vector > > vars_r_; std::map, std::vector > > vars_i_; std::vector const empty_vec_r_; std::vector const empty_vec_i_; std::vector const empty_vec_ui_; /** * Return true if this dump contains the specified * variable name is defined in the real values. This method * returns false if the values are all integers. * * @param name Variable name to test. * @return true if the variable exists in the * real values of the dump. */ bool contains_r_only(const std::string& name) const { return vars_r_.find(name) != vars_r_.end(); } public: /** * Construct a dump object from the specified input stream. * * Warning: This method does not close the input stream. * * @param in Input stream from which to read. */ explicit dump(std::istream& in) { dump_reader reader(in); while (reader.next()) { if (reader.is_int()) { vars_i_[reader.name()] = std::pair, std::vector >( reader.int_values(), reader.dims()); } else { vars_r_[reader.name()] = std::pair, std::vector >( reader.double_values(), reader.dims()); } } } /** * Return true if this dump contains the specified * variable name is defined. This method returns true * even if the values are all integers. * * @param name Variable name to test. * @return true if the variable exists. */ bool contains_r(const std::string& name) const { return contains_r_only(name) || contains_i(name); } /** * Return true if this dump contains an integer * valued array with the specified name. * * @param name Variable name to test. * @return true if the variable name has an integer * array value. */ bool contains_i(const std::string& name) const { return vars_i_.find(name) != vars_i_.end(); } /** * Return the double values for the variable with the specified * name or null. * * @param name Name of variable. * @return Values of variable. */ std::vector vals_r(const std::string& name) const { if (contains_r_only(name)) { return (vars_r_.find(name)->second).first; } else if (contains_i(name)) { std::vector vec_int = (vars_i_.find(name)->second).first; std::vector vec_r(vec_int.size()); for (size_t ii = 0; ii < vec_int.size(); ii++) { vec_r[ii] = vec_int[ii]; } return vec_r; } return empty_vec_r_; } /** * Return the dimensions for the double variable with the specified * name. * * @param name Name of variable. * @return Dimensions of variable. */ std::vector dims_r(const std::string& name) const { if (contains_r_only(name)) { return (vars_r_.find(name)->second).second; } else if (contains_i(name)) { return (vars_i_.find(name)->second).second; } return empty_vec_ui_; } /** * Return the integer values for the variable with the specified * name. * * @param name Name of variable. * @return Values. */ std::vector vals_i(const std::string& name) const { if (contains_i(name)) { return (vars_i_.find(name)->second).first; } return empty_vec_i_; } /** * Return the dimensions for the integer variable with the specified * name. * * @param name Name of variable. * @return Dimensions of variable. */ std::vector dims_i(const std::string& name) const { if (contains_i(name)) { return (vars_i_.find(name)->second).second; } return empty_vec_ui_; } /** * Return a list of the names of the floating point variables in * the dump. * * @param names Vector to store the list of names in. */ virtual void names_r(std::vector& names) const { names.resize(0); for (std::map, std::vector > >::const_iterator it = vars_r_.begin(); it != vars_r_.end(); ++it) names.push_back((*it).first); } /** * Return a list of the names of the integer variables in * the dump. * * @param names Vector to store the list of names in. */ virtual void names_i(std::vector& names) const { names.resize(0); for (std::map, std::vector > >::const_iterator it = vars_i_.begin(); it != vars_i_.end(); ++it) names.push_back((*it).first); } /** * Remove variable from the object. * * @param name Name of the variable to remove. * @return If variable is removed returns true, else * returns false. */ bool remove(const std::string& name) { return (vars_i_.erase(name) > 0) || (vars_r_.erase(name) > 0); } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/array_var_context.hpp0000644000176200001440000003237613766554456023521 0ustar liggesusers#ifndef STAN_IO_ARRAY_VAR_CONTEXT_HPP #define STAN_IO_ARRAY_VAR_CONTEXT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace io { /** * An array_var_context object represents a named arrays * with dimensions constructed from an array, a vector * of names, and a vector of all dimensions for each element. */ class array_var_context : public var_context { private: // Pair used in data maps template using data_pair_t = std::pair, std::vector>; std::map> vars_r_; // Holds data for reals std::map> vars_i_; // Holds data for doubles // When search for variable name fails, return one these const std::vector empty_vec_r_; const std::vector empty_vec_i_; const std::vector empty_vec_ui_; /** * Search over the real variables to check if a name is in the map * @param name The name of the variable to search for * @return logical indiciating if the variable was found in the map of reals. */ bool contains_r_only(const std::string& name) const { return vars_r_.find(name) != vars_r_.end(); } /** * Check (1) if the vector size of dimensions is no smaller * than the name vector size; (2) if the size of the input * array is large enough for what is needed. * * @param names The names for each variable * @param array_size The total size of the vector holding the values we want * to access. * @param dims Vector holding the dimensions for each variable. * @return If the array size is equal to the number of dimensions, * a vector of the cumulative sum of the dimensions of each inner element of * dims. The return of this function is used in the add_* methods to get the * sequence of values For each variable. * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ template inline std::vector validate_dims( const std::vector& names, const T array_size, const std::vector>& dims) { const size_t num_par = names.size(); stan::math::check_less_or_equal("validate_dims", "array_var_context", dims.size(), num_par); std::vector elem_dims_total(dims.size() + 1); for (int i = 0; i < dims.size(); i++) { elem_dims_total[i + 1] = std::accumulate(dims[i].begin(), dims[i].end(), 1, std::multiplies()) + elem_dims_total[i]; } stan::math::check_less_or_equal("validate_dims", "array_var_context", elem_dims_total[dims.size()], array_size); return elem_dims_total; } /** * Adds a set of floating point variables to the floating point map. * @param names Names of each variable. * @param values The real values of variable in a contiguous * column major order container. * @param dims the dimensions for each variable. * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ void add_r(const std::vector& names, const std::vector& values, const std::vector>& dims) { std::vector dim_vec = validate_dims(names, values.size(), dims); for (size_t i = 0; i < names.size(); i++) { vars_r_.emplace(names[i], data_pair_t{{values.data() + dim_vec[i], values.data() + dim_vec[i + 1]}, dims[i]}); } } /** * Adds a set of floating point variables to the floating point map. * @param names Names of each variable. * @param values The real values of variable in an Eigen column vector. * @param dims the dimensions for each variable. * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ void add_r(const std::vector& names, const Eigen::VectorXd& values, const std::vector>& dims) { std::vector dim_vec = validate_dims(names, values.size(), dims); for (size_t i = 0; i < names.size(); i++) { vars_r_.emplace(names[i], data_pair_t{{values.data() + dim_vec[i], values.data() + dim_vec[i + 1]}, dims[i]}); } } /** * Adds a set of integer variables to the integer map. * @param names Names of each variable. * @param values The integer values of variable in a vector. * @param dims the dimensions for each variable. * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ void add_i(const std::vector& names, const std::vector& values, const std::vector>& dims) { std::vector dim_vec = validate_dims(names, values.size(), dims); for (size_t i = 0; i < names.size(); i++) { vars_i_.emplace(names[i], data_pair_t{{values.data() + dim_vec[i], values.data() + dim_vec[i + 1]}, dims[i]}); } } public: /** * Construct an array_var_context from only real value arrays. * * @param names_r names for each element * @param values_r a vector of double values for all elements * @param dim_r a vector of dimensions * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ array_var_context(const std::vector& names_r, const std::vector& values_r, const std::vector>& dim_r) { add_r(names_r, values_r, dim_r); } /** * Construct an array_var_context from an Eigen column vector. * * @param names_r names for each element * @param values_r a vector of double values for all elements * @param dim_r a vector of dimensions * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ array_var_context(const std::vector& names_r, const Eigen::VectorXd& values_r, const std::vector>& dim_r) { add_r(names_r, values_r, dim_r); } /** * Construct an array_var_context from only integer value arrays. * * @param names_i names for each element * @param values_i a vector of integer values for all elements * @param dim_i a vector of dimensions * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ array_var_context(const std::vector& names_i, const std::vector& values_i, const std::vector>& dim_i) { add_i(names_i, values_i, dim_i); } /** * Construct an array_var_context from arrays of both double * and integer separately * * @param names_r names for each element * @param values_r a vector of double values for all elements * @param dim_r a vector of dimensions * @param names_i names for each element * @param values_i a vector of integer values for all elements * @param dim_i a vector of dimensions * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ array_var_context(const std::vector& names_r, const std::vector& values_r, const std::vector>& dim_r, const std::vector& names_i, const std::vector& values_i, const std::vector>& dim_i) { add_i(names_i, values_i, dim_i); add_r(names_r, values_r, dim_r); } /** * Construct an array_var_context from arrays of both double * and integer separately * * @param names_r names for each element * @param values_r Eigen column vector of double elements. * @param dim_r a vector of dimensions * @param names_i names for each element * @param values_i a vector of integer values for all elements * @param dim_i a vector of dimensions * @throw std::invalid_argument when size of dimensions is less * then array size or array is not long enough to hold * the dimensions of the data. */ array_var_context(const std::vector& names_r, const Eigen::VectorXd& values_r, const std::vector>& dim_r, const std::vector& names_i, const std::vector& values_i, const std::vector>& dim_i) { add_i(names_i, values_i, dim_i); add_r(names_r, values_r, dim_r); } /** * Return true if this dump contains the specified * variable name is defined. This method returns true * even if the values are all integers. * * @param name Variable name to test. * @return true if the variable exists. */ bool contains_r(const std::string& name) const { return contains_r_only(name) || contains_i(name); } /** * Return true if this dump contains an integer * valued array with the specified name. * * @param name Variable name to test. * @return true if the variable name has an integer * array value. */ bool contains_i(const std::string& name) const { return vars_i_.find(name) != vars_i_.end(); } /** * Return the double values for the variable with the specified * name or null. * * @param name Name of variable. * @return Values of variable. * */ std::vector vals_r(const std::string& name) const { const auto ret_val_r = vars_r_.find(name); if (ret_val_r != vars_r_.end()) { return ret_val_r->second.first; } else { const auto ret_val_i = vars_i_.find(name); if (ret_val_i != vars_i_.end()) { return {ret_val_i->second.first.begin(), ret_val_i->second.first.end()}; } } return empty_vec_r_; } /** * Return the dimensions for the double variable with the specified * name. * * @param name Name of variable. * @return Dimensions of variable. */ std::vector dims_r(const std::string& name) const { const auto ret_val_r = vars_r_.find(name); if (ret_val_r != vars_r_.end()) { return ret_val_r->second.second; } else { const auto ret_val_i = vars_i_.find(name); if (ret_val_i != vars_i_.end()) { return ret_val_i->second.second; } } return empty_vec_ui_; } /** * Return the integer values for the variable with the specified * name. * * @param name Name of variable. * @return Values. */ std::vector vals_i(const std::string& name) const { auto ret_val_i = vars_i_.find(name); if (ret_val_i != vars_i_.end()) { return ret_val_i->second.first; } return empty_vec_i_; } /** * Return the dimensions for the integer variable with the specified * name. * * @param name Name of variable. * @return Dimensions of variable. */ std::vector dims_i(const std::string& name) const { auto ret_val_i = vars_i_.find(name); if (ret_val_i != vars_i_.end()) { return ret_val_i->second.second; } return empty_vec_ui_; } /** * Return a list of the names of the floating point variables in * the dump. * * @param names Vector to store the list of names in. */ virtual void names_r(std::vector& names) const { names.clear(); names.reserve(vars_r_.size()); for (const auto& vars_r_iter : vars_r_) { names.push_back(vars_r_iter.first); } } /** * Return a list of the names of the integer variables in * the dump. * * @param names Vector to store the list of names in. */ virtual void names_i(std::vector& names) const { names.clear(); names.reserve(vars_i_.size()); for (const auto& vars_i_iter : vars_r_) { names.push_back(vars_i_iter.first); } } /** * Remove variable from the object. * * @param name Name of the variable to remove. * @return If variable is removed returns true, else * returns false. */ bool remove(const std::string& name) { return (vars_i_.erase(name) > 0) || (vars_r_.erase(name) > 0); } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/random_var_context.hpp0000644000176200001440000001661713766554456023663 0ustar liggesusers#ifndef STAN_IO_RANDOM_VAR_CONTEXT_HPP #define STAN_IO_RANDOM_VAR_CONTEXT_HPP #include #include #include #include #include #include namespace stan { namespace io { /** * This is an implementation of a var_context that initializes * the unconstrained values randomly. This is used for initialization. */ class random_var_context : public var_context { public: /** * Constructs a random var_context. * * On construction, this var_context will generate random * numbers on the unconstrained scale for the model provided. * Once generated, the class is immutable. * * This class only generates values for the parameters in the * Stan program and does not generate values for transformed parameters * or generated quantities. * * @tparam Model Model class * @tparam RNG Random number generator type * @param[in] model instantiated model to generate variables for * @param[in,out] rng pseudo-random number generator * @param[in] init_radius the unconstrained variables are uniform draws * from -init_radius to init_radius. * @param[in] init_zero indicates whether all unconstrained variables * should be initialized at 0. When init_zero is false, init_radius * must be greater than 0. */ template random_var_context(Model& model, RNG& rng, double init_radius, bool init_zero) : unconstrained_params_(model.num_params_r()) { size_t num_unconstrained_ = model.num_params_r(); model.get_param_names(names_); model.get_dims(dims_); // cutting names_ and dims_ down to just the constrained parameters std::vector constrained_params_names; model.constrained_param_names(constrained_params_names, false, false); size_t keep = constrained_params_names.size(); size_t i = 0; size_t num = 0; for (i = 0; i < dims_.size(); ++i) { size_t size = 1; for (size_t n = 0; n < dims_[i].size(); ++n) size *= dims_[i][n]; num += size; if (num > keep) break; } dims_.erase(dims_.begin() + i, dims_.end()); names_.erase(names_.begin() + i, names_.end()); if (init_zero) { for (size_t n = 0; n < num_unconstrained_; ++n) unconstrained_params_[n] = 0.0; } else { boost::random::uniform_real_distribution unif(-init_radius, init_radius); for (size_t n = 0; n < num_unconstrained_; ++n) unconstrained_params_[n] = unif(rng); } std::vector constrained_params; std::vector int_params; model.write_array(rng, unconstrained_params_, int_params, constrained_params, false, false, 0); vals_r_ = constrained_to_vals_r(constrained_params, dims_); } /** * Destructor. */ ~random_var_context() {} /** * Return true if the specified variable name is * defined. Will return true if the name matches * a parameter in the model. * * @param name Name of variable. * @return true if the name is a parameter in the * model. */ bool contains_r(const std::string& name) const { return std::find(names_.begin(), names_.end(), name) != names_.end(); } /** * Returns the values of the constrained variables. * * @param name Name of variable. * * @return the constrained values if the variable is in the * var_context; an empty vector is returned otherwise */ std::vector vals_r(const std::string& name) const { std::vector::const_iterator loc = std::find(names_.begin(), names_.end(), name); if (loc == names_.end()) return std::vector(); return vals_r_[loc - names_.begin()]; } /** * Returns the dimensions of the variable * * @param name Name of variable. * @return the dimensions of the variable if it exists; an empty vector * is returned otherwise */ std::vector dims_r(const std::string& name) const { std::vector::const_iterator loc = std::find(names_.begin(), names_.end(), name); if (loc == names_.end()) return std::vector(); return dims_[loc - names_.begin()]; } /** * Return true if the specified variable name has * integer values. Always returns false. * * @param name Name of variable. * @return false */ bool contains_i(const std::string& name) const { return false; } /** * Returns an empty vector. * * @param name Name of variable. * @return empty vector */ std::vector vals_i(const std::string& name) const { std::vector empty_vals_i; return empty_vals_i; } /** * Return the dimensions of the specified floating point variable. * Returns an empty vector. * * @param name Name of variable. * @return empty vector */ std::vector dims_i(const std::string& name) const { std::vector empty_dims_i; return empty_dims_i; } /** * Fill a list of the names of the floating point variables in * the context. This will return the names of the parameters in * the model. * * @param names Vector to store the list of names in. */ void names_r(std::vector& names) const { names = names_; } /** * Fill a list of the names of the integer variables in * the context. This context has no variables. * * @param names Vector to store the list of names in. */ void names_i(std::vector& names) const { names.clear(); } /** * Return the random initialization on the unconstrained scale. * * @return the unconstrained parameters */ std::vector get_unconstrained() const { return unconstrained_params_; } private: /** * Parameter names in the model */ std::vector names_; /** * Dimensions of parameters in the model */ std::vector > dims_; /** * Random parameter values of the model in the * unconstrained space */ std::vector unconstrained_params_; /** * Random parameter values of the model in the * constrained space */ std::vector > vals_r_; /** * Computes the size of a variable based on the dim provided. * * @param dim dimension of the variable * @return total size of the variable */ size_t dim_size(const std::vector& dim) { size_t size = 1; for (size_t j = 0; j < dim.size(); ++j) size *= dim[j]; return size; } /** * Returns a vector of constrained values in the format expected * out of the vals_r() function. * * @param[in] constrained constrained parameter values * @param[in] dims dimensions of each of the parameter values * @return constrained values reshaped to be returned in the vals_r * function */ std::vector > constrained_to_vals_r( const std::vector& constrained, const std::vector >& dims) { std::vector > vals_r(dims.size()); std::vector::const_iterator start = constrained.begin(); for (size_t i = 0; i < dims.size(); ++i) { size_t size = dim_size(dims[i]); vals_r[i] = std::vector(start, start + size); start += size; } return vals_r; } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/program_reader.hpp0000644000176200001440000002466013766554456022755 0ustar liggesusers#ifndef STAN_IO_PROGRAM_READER_HPP #define STAN_IO_PROGRAM_READER_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace io { /** * Structure to hold preprocessing events, which consist of (a) * line number in concatenated program after includes, (b) line * number in the stream from which the text is read, (c) a * string-based action, and (d) a path to the current file. */ struct preproc_event { int concat_line_num_; int line_num_; std::string action_; std::string path_; preproc_event(int concat_line_num, int line_num, const std::string& action, const std::string& path) : concat_line_num_(concat_line_num), line_num_(line_num), action_(action), path_(path) {} void print(std::ostream& out) { out << "(" << concat_line_num_ << ", " << line_num_ << ", " << action_ << ", " << path_ << ")"; } }; /** * A program_reader reads a Stan program and unpacks * the include statements relative to a search path in such a way * that error messages can reproduce the include path. */ class program_reader { public: /** * A pair for holding a path and a line number. */ typedef std::pair path_line_t; /** * Ordered sequence of path and line number pairs. */ typedef std::vector trace_t; /** * Construct a program reader from the specified stream derived * from the specified name or path, and a sequence of paths to * search for include files. The paths should be directories. * *

Calling this method does not close the specified input stream. * * @param[in] in stream from which to start reading * @param[in] name name path or name attached to stream * @param[in] search_path ordered sequence of directory names to * search for included files */ program_reader(std::istream& in, const std::string& name, const std::vector& search_path) { int concat_line_num = 0; read(in, name, search_path, concat_line_num); } static std::string trim_comment(const std::string& line) { for (std::size_t i = 0; i < line.size(); ++i) if (starts_with("//", line.substr(i))) return line.substr(0, i); return line; // no comments } /** * Construct a copy of the specified reader. Both the * underlying program string and history will be copied. * * @param r reader to copy */ program_reader(const program_reader& r) : program_(r.program_.str()), history_(r.history_) {} /** * Construct a program reader with an empty program and * history. */ program_reader() : program_(""), history_() {} /** * Return a string representing the concatenated program. This * string may be wrapped in a std::stringstream for * reading. * * @return stream for program */ std::string program() const { return program_.str(); } /** * Return the include trace of the path and line numbers leading * to the specified line of text in the concatenated program. * The top of the stack is the most recently read path. * * @param[in] target line number in concatenated program file * @return sequence of files and positions for includes */ trace_t trace(int target) const { if (target < 1) throw std::runtime_error( "trace() argument target must be" " greater than 1"); trace_t result; std::string file = "ERROR: UNINITIALIZED"; int file_start = -1; int concat_start = -1; for (size_t i = 0; i < history_.size(); ++i) { if (target <= history_[i].concat_line_num_) { int line = file_start + target - concat_start; result.push_back(path_line_t(file, line)); return result; } else if (history_[i].action_ == "start" || history_[i].action_ == "restart") { file = history_[i].path_; file_start = history_[i].line_num_; concat_start = history_[i].concat_line_num_; } else if (history_[i].action_ == "end") { if (result.size() == 0) break; result.pop_back(); } else if (history_[i].action_ == "include") { result.push_back(path_line_t(file, history_[i].line_num_ + 1)); } } throw std::runtime_error("ran beyond end of program in trace()"); } /** * Return the record of the files and includes used to build up * this program. * * @return I/O history of the program */ const std::vector& history() const { return history_; } /** * Adds preprocessing event with specified components to the * back of the history sequence. * * @param[in] concat_line_num position in concatenated program * @param[in] line_num position in current file * @param[in] action purpose of preprocessing event * @param[in] path location of current file */ void add_event(int concat_line_num, int line_num, const std::string& action, const std::string& path) { preproc_event e(concat_line_num, line_num, action, path); history_.push_back(e); } private: std::stringstream program_; std::vector history_; /** * Returns the include path from a line that begins with * #include after whitespace. A path may be a single * token or it must be quoted with double quote characters. Line or * block comments are allowed after the include. * * Does not yet support included file names with double quotes in * the name. * * @param line line of text beginning with #include * @return text after #include with whitespace * trimmed */ static std::string include_path(const std::string& line) { // trim out the initial spaces, #include, and spaces after and advance std::string trimmed_line = trim_comment(trim_spaces(line)); std::size_t start = std::string("#include").size(); while (is_whitespace(line[start]) && start < trimmed_line.size()) ++start; std::string rest = trimmed_line.substr(start); // deal with case where there is nothing left if (rest.size() == 0) { throw std::runtime_error("***nothing after #include***"); } // extract include path and line position after path std::string path; std::size_t pos = 0; if (rest[pos] == '"') { // quoted case ++pos; while (pos < rest.size() && rest[pos] != '"') ++pos; return rest.substr(1, pos - 1); } while (pos < rest.size() && !is_whitespace(rest[pos])) ++pos; return rest.substr(0, pos); // pos past last char } void read(std::istream& in, const std::string& path, const std::vector& search_path, int& concat_line_num, bool is_nested, std::set& visited_paths) { if (visited_paths.find(path) != visited_paths.end()) return; // avoids recursive visitation visited_paths.insert(path); history_.push_back(preproc_event(concat_line_num, 0, "start", path)); for (int line_num = 1;; ++line_num) { std::string line = read_line(in); if (line.empty()) { // ends initial out of loop start event if (!is_nested) { // pad end concat_line_num of outermost file in order to properly // report end-of-file parse error - else trace throws exception history_.push_back( preproc_event(concat_line_num + 2, line_num - 1, "end", path)); } else { history_.push_back( preproc_event(concat_line_num, line_num - 1, "end", path)); } break; } else if (starts_with("#include ", trim_spaces(line))) { std::string incl_path = include_path(line); history_.push_back( preproc_event(concat_line_num, line_num - 1, "include", incl_path)); bool found_path = false; for (size_t i = 0; i < search_path.size(); ++i) { std::string f = (search_path[i].size() != 0 && !ends_with("/", search_path[i]) && !ends_with("\\", search_path[i])) ? search_path[i] + "/" + incl_path // / will work under Windows : search_path[i] + incl_path; std::ifstream include_in(f.c_str()); try { if (!include_in.good()) { include_in.close(); continue; } read(include_in, incl_path, search_path, concat_line_num, true, visited_paths); } catch (...) { include_in.close(); throw; } include_in.close(); history_.push_back( preproc_event(concat_line_num, line_num, "restart", path)); found_path = true; break; } if (!found_path) { std::ostringstream include_err_msg; include_err_msg << "could not find include file " << incl_path << " in the following directories:\n"; for (size_t i = 0; i < search_path.size(); ++i) { include_err_msg << " " << search_path[i] << "\n"; } throw std::runtime_error(include_err_msg.str()); } } else { ++concat_line_num; program_ << line; } } visited_paths.erase(path); // allow multiple, just not nested } /** * Read the rest of a program from the specified input stream in * the specified path, with the specified search path for * include files, and incrementing the specified concatenated * line number. This method is called recursively for included * files. If a file is included recursively, the second include * is ignored. * * @param[in] in stream from which to read * @param[in] path name of stream * @param[in] search_path sequence of path names to search for * include files * @param[in,out] concat_line_num position in concatenated file * to be updated * @throw std::runtime_error if an included file cannot be found */ void read(std::istream& in, const std::string& path, const std::vector& search_path, int& concat_line_num) { std::set visited_paths; read(in, path, search_path, concat_line_num, false, visited_paths); } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/read_line.hpp0000644000176200001440000000147413766554456021704 0ustar liggesusers#ifndef STAN_IO_READ_LINE_HPP #define STAN_IO_READ_LINE_HPP #include #include #include namespace stan { namespace io { /** * Returns the next line read from the specified stream, or the * empty string if the stream is empty. * *

The input stream is read character by character and not * buffered, though the use cases are only for small files of * code, so this probably isn't a big deal. * * @param in input stream * @return next line from stream or empty string if empty */ inline std::string read_line(std::istream& in) { std::stringstream ss; while (true) { int c = in.get(); if (c == std::char_traits::eof()) return ss.str(); ss << static_cast(c); if (c == '\n') return ss.str(); } } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/var_context.hpp0000644000176200001440000001663213766554456022320 0ustar liggesusers#ifndef STAN_IO_VAR_CONTEXT_HPP #define STAN_IO_VAR_CONTEXT_HPP #include #include #include #include namespace stan { namespace io { /** * A var_context reads array variables of integer and * floating point type by name and dimension. * *

An array's dimensionality is described by a sequence of * (unsigned) integers. For instance, (7, 2, 3) picks * out a 7 by 2 by 3 array. The empty dimensionality sequence * () is used for scalars. * *

Multidimensional arrays are stored in column-major order, * meaning the first index changes the most quickly. * *

If a variable has integer variables, it should return * those integer values cast to floating point values when * accessed through the floating-point methods. */ class var_context { public: virtual ~var_context() {} /** * Return true if the specified variable name is * defined. This method should return true even * if the values are all integers. * * @param name Name of variable. * @return true if the variable exists with real * values. */ virtual bool contains_r(const std::string& name) const = 0; /** * Return the floating point values for the variable of the * specified variable name in last-index-major order. This * method should cast integers to floating point values if the * values of the named variable are all integers. * *

If there is no variable of the specified name, the empty * vector is returned. * * @param name Name of variable. * @return Sequence of values for the named variable. */ virtual std::vector vals_r(const std::string& name) const = 0; /** * Return the dimensions for the specified floating point variable. * If the variable doesn't exist or if it is a scalar, the * return result should be the empty vector. * * @param name Name of variable. * @return Sequence of dimensions for the variable. */ virtual std::vector dims_r(const std::string& name) const = 0; /** * Return true if the specified variable name has * integer values. * * @param name Name of variable. * @return true if an integer variable of the specified * name is defined. */ virtual bool contains_i(const std::string& name) const = 0; /** * Return the integer values for the variable of the specified * name in last-index-major order or the empty sequence if the * variable is not defined. * * @param name Name of variable. * @return Sequence of integer values. */ virtual std::vector vals_i(const std::string& name) const = 0; /** * Return the dimensions of the specified floating point variable. * If the variable doesn't exist (or if it is a scalar), the * return result should be the empty vector. * * @param name Name of variable. * @return Sequence of dimensions for the variable. */ virtual std::vector dims_i(const std::string& name) const = 0; /** * Fill a list of the names of the floating point variables in * the context. * * @param names Vector to store the list of names in. */ virtual void names_r(std::vector& names) const = 0; /** * Fill a list of the names of the integer variables in * the context. * * @param names Vector to store the list of names in. */ virtual void names_i(std::vector& names) const = 0; void add_vec(std::stringstream& msg, const std::vector& dims) const { msg << '('; for (size_t i = 0; i < dims.size(); ++i) { if (i > 0) msg << ','; msg << dims[i]; } msg << ')'; } void validate_dims(const std::string& stage, const std::string& name, const std::string& base_type, const std::vector& dims_declared) const { bool is_int_type = base_type == "int"; if (is_int_type) { if (!contains_i(name)) { std::stringstream msg; msg << (contains_r(name) ? "int variable contained non-int values" : "variable does not exist") << "; processing stage=" << stage << "; variable name=" << name << "; base type=" << base_type; throw std::runtime_error(msg.str()); } } else { if (!contains_r(name)) { std::stringstream msg; msg << "variable does not exist" << "; processing stage=" << stage << "; variable name=" << name << "; base type=" << base_type; throw std::runtime_error(msg.str()); } } std::vector dims = dims_r(name); if (dims.size() != dims_declared.size()) { std::stringstream msg; msg << "mismatch in number dimensions declared and found in context" << "; processing stage=" << stage << "; variable name=" << name << "; dims declared="; add_vec(msg, dims_declared); msg << "; dims found="; add_vec(msg, dims); throw std::runtime_error(msg.str()); } for (size_t i = 0; i < dims.size(); ++i) { if (dims_declared[i] != dims[i]) { std::stringstream msg; msg << "mismatch in dimension declared and found in context" << "; processing stage=" << stage << "; variable name=" << name << "; position=" << i << "; dims declared="; add_vec(msg, dims_declared); msg << "; dims found="; add_vec(msg, dims); throw std::runtime_error(msg.str()); } } } static std::vector to_vec() { return std::vector(); } static std::vector to_vec(size_t n1) { std::vector v(1); v[0] = n1; return v; } static std::vector to_vec(size_t n1, size_t n2) { std::vector v(2); v[0] = n1; v[1] = n2; return v; } static std::vector to_vec(size_t n1, size_t n2, size_t n3) { std::vector v(3); v[0] = n1; v[1] = n2; v[2] = n3; return v; } static std::vector to_vec(size_t n1, size_t n2, size_t n3, size_t n4) { std::vector v(4); v[0] = n1; v[1] = n2; v[2] = n3; v[3] = n4; return v; } static std::vector to_vec(size_t n1, size_t n2, size_t n3, size_t n4, size_t n5) { std::vector v(5); v[0] = n1; v[1] = n2; v[2] = n3; v[3] = n4; v[4] = n5; return v; } static std::vector to_vec(size_t n1, size_t n2, size_t n3, size_t n4, size_t n5, size_t n6) { std::vector v(6); v[0] = n1; v[1] = n2; v[2] = n3; v[3] = n4; v[4] = n5; v[5] = n6; return v; } static std::vector to_vec(size_t n1, size_t n2, size_t n3, size_t n4, size_t n5, size_t n6, size_t n7) { std::vector v(7); v[0] = n1; v[1] = n2; v[2] = n3; v[3] = n4; v[4] = n5; v[5] = n6; v[6] = n7; return v; } static std::vector to_vec(size_t n1, size_t n2, size_t n3, size_t n4, size_t n5, size_t n6, size_t n7, size_t n8) { std::vector v(8); v[0] = n1; v[1] = n2; v[2] = n3; v[3] = n4; v[4] = n5; v[5] = n6; v[6] = n7; v[7] = n8; return v; } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/ends_with.hpp0000644000176200001440000000073013766554456021740 0ustar liggesusers#ifndef STAN_IO_ENDS_WITH_HPP #define STAN_IO_ENDS_WITH_HPP #include namespace stan { namespace io { /** * Return true if the specified string starts with the specified * prefix. * * @param p prefix * @param s string to test * @return true if s has p as a prefix */ inline bool ends_with(const std::string& p, const std::string& s) { return s.size() >= p.size() && s.substr(s.size() - p.size()) == p; } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/trim_spaces.hpp0000644000176200001440000000124513766554456022267 0ustar liggesusers#ifndef STAN_IO_TRIM_SPACES_HPP #define STAN_IO_TRIM_SPACES_HPP #include #include namespace stan { namespace io { /** * Return a substring of the specified string without any * leading or trailing spaces. * * @param x string to convert * @return substring of input with no leading or trailing whitespace */ inline std::string trim_spaces(const std::string& x) { std::size_t start = 0; while (start < x.size() && is_whitespace(x[start])) ++start; std::size_t end = x.size(); while (end > 0 && is_whitespace(x[end - 1])) --end; return x.substr(start, end - start); } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/chained_var_context.hpp0000644000176200001440000000333613766554456023770 0ustar liggesusers#ifndef STAN_IO_CHAINED_VAR_CONTEXT_HPP #define STAN_IO_CHAINED_VAR_CONTEXT_HPP #include #include #include namespace stan { namespace io { /** * A chained_var_context object represents two objects of var_context * as one. */ class chained_var_context : public var_context { private: const var_context& vc1_; const var_context& vc2_; public: chained_var_context(const var_context& v1, const var_context& v2) : vc1_(v1), vc2_(v2) {} bool contains_i(const std::string& name) const { return vc1_.contains_i(name) || vc2_.contains_i(name); } bool contains_r(const std::string& name) const { return vc1_.contains_r(name) || vc2_.contains_r(name); } std::vector vals_r(const std::string& name) const { return vc1_.contains_r(name) ? vc1_.vals_r(name) : vc2_.vals_r(name); } std::vector vals_i(const std::string& name) const { return vc1_.contains_i(name) ? vc1_.vals_i(name) : vc2_.vals_i(name); } std::vector dims_r(const std::string& name) const { return vc1_.contains_r(name) ? vc1_.dims_r(name) : vc2_.dims_r(name); } std::vector dims_i(const std::string& name) const { return vc1_.contains_r(name) ? vc1_.dims_i(name) : vc2_.dims_i(name); } void names_r(std::vector& names) const { vc1_.names_r(names); std::vector names2; vc2_.names_r(names2); names.insert(names.end(), names2.begin(), names2.end()); } void names_i(std::vector& names) const { vc1_.names_i(names); std::vector names2; vc2_.names_i(names2); names.insert(names.end(), names2.begin(), names2.end()); } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/stan_csv_reader.hpp0000644000176200001440000002325713766554456023127 0ustar liggesusers#ifndef STAN_IO_STAN_CSV_READER_HPP #define STAN_IO_STAN_CSV_READER_HPP #include #include #include #include #include #include namespace stan { namespace io { // FIXME: should consolidate with the options from // the command line in stan::lang struct stan_csv_metadata { int stan_version_major; int stan_version_minor; int stan_version_patch; std::string model; std::string data; std::string init; size_t chain_id; size_t seed; bool random_seed; size_t num_samples; size_t num_warmup; bool save_warmup; size_t thin; bool append_samples; std::string algorithm; std::string engine; int max_depth; stan_csv_metadata() : stan_version_major(0), stan_version_minor(0), stan_version_patch(0), model(""), data(""), init(""), chain_id(1), seed(0), random_seed(false), num_samples(0), num_warmup(0), save_warmup(false), thin(0), append_samples(false), algorithm(""), engine(""), max_depth(10) {} }; struct stan_csv_adaptation { double step_size; Eigen::MatrixXd metric; stan_csv_adaptation() : step_size(0), metric(0, 0) {} }; struct stan_csv_timing { double warmup; double sampling; stan_csv_timing() : warmup(0), sampling(0) {} }; struct stan_csv { stan_csv_metadata metadata; Eigen::Matrix header; stan_csv_adaptation adaptation; Eigen::MatrixXd samples; stan_csv_timing timing; }; /** * Reads from a Stan output csv file. */ class stan_csv_reader { public: stan_csv_reader() {} ~stan_csv_reader() {} static bool read_metadata(std::istream& in, stan_csv_metadata& metadata, std::ostream* out) { std::stringstream ss; std::string line; if (in.peek() != '#') return false; while (in.peek() == '#') { std::getline(in, line); ss << line << '\n'; } ss.seekg(std::ios_base::beg); char comment; std::string lhs; std::string name; std::string value; while (ss.good()) { ss >> comment; std::getline(ss, lhs); size_t equal = lhs.find("="); if (equal != std::string::npos) { name = lhs.substr(0, equal); boost::trim(name); value = lhs.substr(equal + 1, lhs.size()); boost::trim(value); boost::replace_first(value, " (Default)", ""); } else { if (lhs.compare(" data") == 0) { ss >> comment; std::getline(ss, lhs); size_t equal = lhs.find("="); if (equal != std::string::npos) { name = lhs.substr(0, equal); boost::trim(name); value = lhs.substr(equal + 2, lhs.size()); boost::replace_first(value, " (Default)", ""); } if (name.compare("file") == 0) metadata.data = value; continue; } } if (name.compare("stan_version_major") == 0) { std::stringstream(value) >> metadata.stan_version_major; } else if (name.compare("stan_version_minor") == 0) { std::stringstream(value) >> metadata.stan_version_minor; } else if (name.compare("stan_version_patch") == 0) { std::stringstream(value) >> metadata.stan_version_patch; } else if (name.compare("model") == 0) { metadata.model = value; } else if (name.compare("num_samples") == 0) { std::stringstream(value) >> metadata.num_samples; } else if (name.compare("num_warmup") == 0) { std::stringstream(value) >> metadata.num_warmup; } else if (name.compare("save_warmup") == 0) { std::stringstream(value) >> metadata.save_warmup; } else if (name.compare("thin") == 0) { std::stringstream(value) >> metadata.thin; } else if (name.compare("id") == 0) { std::stringstream(value) >> metadata.chain_id; } else if (name.compare("init") == 0) { metadata.init = value; boost::trim(metadata.init); } else if (name.compare("seed") == 0) { std::stringstream(value) >> metadata.seed; metadata.random_seed = false; } else if (name.compare("append_samples") == 0) { std::stringstream(value) >> metadata.append_samples; } else if (name.compare("algorithm") == 0) { metadata.algorithm = value; } else if (name.compare("engine") == 0) { metadata.engine = value; } else if (name.compare("max_depth") == 0) { std::stringstream(value) >> metadata.max_depth; } } if (ss.good() == true) return false; return true; } // read_metadata static bool read_header(std::istream& in, Eigen::Matrix& header, std::ostream* out) { std::string line; if (in.peek() != 'l') return false; std::getline(in, line); std::stringstream ss(line); header.resize(std::count(line.begin(), line.end(), ',') + 1); int idx = 0; while (ss.good()) { std::string token; std::getline(ss, token, ','); boost::trim(token); int pos = token.find('.'); if (pos > 0) { token.replace(pos, 1, "["); std::replace(token.begin(), token.end(), '.', ','); token += "]"; } header(idx++) = token; } return true; } static bool read_adaptation(std::istream& in, stan_csv_adaptation& adaptation, std::ostream* out) { std::stringstream ss; std::string line; int lines = 0; if (in.peek() != '#' || in.good() == false) return false; while (in.peek() == '#') { std::getline(in, line); ss << line << std::endl; lines++; } ss.seekg(std::ios_base::beg); if (lines < 4) return false; char comment; // Buffer for comment indicator, # // Skip first two lines std::getline(ss, line); // Stepsize std::getline(ss, line, '='); boost::trim(line); ss >> adaptation.step_size; // Metric parameters std::getline(ss, line); std::getline(ss, line); std::getline(ss, line); int rows = lines - 3; int cols = std::count(line.begin(), line.end(), ',') + 1; adaptation.metric.resize(rows, cols); for (int row = 0; row < rows; row++) { std::stringstream line_ss; line_ss.str(line); line_ss >> comment; for (int col = 0; col < cols; col++) { std::string token; std::getline(line_ss, token, ','); boost::trim(token); std::stringstream(token) >> adaptation.metric(row, col); } std::getline(ss, line); // Read in next line } if (ss.good()) return false; else return true; } static bool read_samples(std::istream& in, Eigen::MatrixXd& samples, stan_csv_timing& timing, std::ostream* out) { std::stringstream ss; std::string line; int rows = 0; int cols = -1; if (in.peek() == '#' || in.good() == false) return false; while (in.good()) { bool comment_line = (in.peek() == '#'); bool empty_line = (in.peek() == '\n'); std::getline(in, line); if (empty_line) continue; if (!line.length()) break; if (comment_line) { if (line.find("(Warm-up)") != std::string::npos) { int left = 17; int right = line.find(" seconds"); double warmup; std::stringstream(line.substr(left, right - left)) >> warmup; timing.warmup += warmup; } else if (line.find("(Sampling)") != std::string::npos) { int left = 17; int right = line.find(" seconds"); double sampling; std::stringstream(line.substr(left, right - left)) >> sampling; timing.sampling += sampling; } } else { ss << line << '\n'; int current_cols = std::count(line.begin(), line.end(), ',') + 1; if (cols == -1) { cols = current_cols; } else if (cols != current_cols) { if (out) *out << "Error: expected " << cols << " columns, but found " << current_cols << " instead for row " << rows + 1 << std::endl; return false; } rows++; } in.peek(); } ss.seekg(std::ios_base::beg); if (rows > 0) { samples.resize(rows, cols); for (int row = 0; row < rows; row++) { std::getline(ss, line); std::stringstream ls(line); for (int col = 0; col < cols; col++) { std::getline(ls, line, ','); boost::trim(line); std::stringstream(line) >> samples(row, col); } } } return true; } /** * Parses the file. * * @param[in] in input stream to parse * @param[out] out output stream to send messages */ static stan_csv parse(std::istream& in, std::ostream* out) { stan_csv data; if (!read_metadata(in, data.metadata, out)) { if (out) *out << "Warning: non-fatal error reading metadata" << std::endl; } if (!read_header(in, data.header, out)) { if (out) *out << "Error: error reading header" << std::endl; throw std::invalid_argument("Error with header of input file in parse"); } if (!read_adaptation(in, data.adaptation, out)) { if (out) *out << "Warning: non-fatal error reading adapation data" << std::endl; } data.timing.warmup = 0; data.timing.sampling = 0; if (!read_samples(in, data.samples, data.timing, out)) { if (out) *out << "Warning: non-fatal error reading samples" << std::endl; } return data; } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/util.hpp0000644000176200001440000000135713766554456020737 0ustar liggesusers#ifndef STAN_IO_UTIL_HPP #define STAN_IO_UTIL_HPP #include #include namespace stan { namespace io { /** * Return the current coordinated universal time (UTC) as a string. * * Output is of the form "Fri Feb 24 21:15:36 2012" * * @return String representation of current UTC. */ std::string utc_time_string() { // FIXME: use std::strftime // original with asctime // std::time_t rawtime = time(0); // std::tm *time = gmtime(&rawtime); // return std::string(asctime(time)); // new with strfitime time_t rawtime; std::time(&rawtime); char cbuf[80]; std::strftime(cbuf, 80, "%a %b %d %Y %H:%M:%S", std::localtime(&rawtime)); return std::string(cbuf); } } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/io/empty_var_context.hpp0000644000176200001440000000453513766554456023535 0ustar liggesusers#ifndef STAN_IO_EMPTY_VAR_CONTEXT_HPP #define STAN_IO_EMPTY_VAR_CONTEXT_HPP #include #include #include namespace stan { namespace io { /** * This is an implementation of a var_context that doesn't contain * any variables. */ class empty_var_context : public var_context { public: /** * Destructor */ virtual ~empty_var_context() {} /** * Return true if the specified variable name is * defined. Always returns false. * * @param name Name of variable. * @return false */ bool contains_r(const std::string& name) const { return false; } /** * Always returns an empty vector. * * @param name Name of variable. * @return empty vector */ std::vector vals_r(const std::string& name) const { return std::vector(); } /** * Always returns an empty vector. * * @param name Name of variable. * @return empty vector */ std::vector dims_r(const std::string& name) const { return std::vector(); } /** * Return true if the specified variable name has * integer values. Always returns false. * * @param name Name of variable. * @return false */ bool contains_i(const std::string& name) const { return false; } /** * Returns an empty vector. * * @param name Name of variable. * @return empty vector */ std::vector vals_i(const std::string& name) const { return std::vector(); } /** * Return the dimensions of the specified floating point variable. * Returns an empty vector. * * @param name Name of variable. * @return empty vector */ std::vector dims_i(const std::string& name) const { return std::vector(); } /** * Fill a list of the names of the floating point variables in * the context. This context has no variables. * * @param names Vector to store the list of names in. */ void names_r(std::vector& names) const { names.clear(); } /** * Fill a list of the names of the integer variables in * the context. This context has no variables. * * @param names Vector to store the list of names in. */ void names_i(std::vector& names) const { names.clear(); } }; } // namespace io } // namespace stan #endif StanHeaders/inst/include/src/stan/callbacks/0000755000176200001440000000000013766554456020553 5ustar liggesusersStanHeaders/inst/include/src/stan/callbacks/writer.hpp0000644000176200001440000000174113766554456022603 0ustar liggesusers#ifndef STAN_CALLBACKS_WRITER_HPP #define STAN_CALLBACKS_WRITER_HPP #include #include #include namespace stan { namespace callbacks { /** * writer is a base class defining the interface * for Stan writer callbacks. The base class can be used as a * no-op implementation. */ class writer { public: /** * Virtual destructor. */ virtual ~writer() {} /** * Writes a set of names. * * @param[in] names Names in a std::vector */ virtual void operator()(const std::vector& names) {} /** * Writes a set of values. * * @param[in] state Values in a std::vector */ virtual void operator()(const std::vector& state) {} /** * Writes blank input. */ virtual void operator()() {} /** * Writes a string. * * @param[in] message A string */ virtual void operator()(const std::string& message) {} }; } // namespace callbacks } // namespace stan #endif StanHeaders/inst/include/src/stan/callbacks/interrupt.hpp0000644000176200001440000000123613766554456023322 0ustar liggesusers#ifndef STAN_CALLBACKS_INTERRUPT_HPP #define STAN_CALLBACKS_INTERRUPT_HPP namespace stan { namespace callbacks { /** * interrupt is a base class defining the interface * for Stan interrupt callbacks. * * The interrupt is called from within Stan algorithms to allow * for the interfaces to handle interrupt signals (ctrl-c). */ class interrupt { public: /** * Callback function. * * This function is called by the algorithms allowing the interfaces * to break when necessary. */ virtual void operator()() {} /** * Virtual destructor. */ virtual ~interrupt() {} }; } // namespace callbacks } // namespace stan #endif StanHeaders/inst/include/src/stan/callbacks/tee_writer.hpp0000644000176200001440000000234513766554456023441 0ustar liggesusers#ifndef STAN_CALLBACKS_TEE_WRITER_HPP #define STAN_CALLBACKS_TEE_WRITER_HPP #include #include #include #include namespace stan { namespace callbacks { /** * tee_writer is an implementation that writes to * two writers. * * For any call to this writer, it will tee the call to both writers * provided in the constructor. */ class tee_writer : public writer { public: /** * Constructor accepting two writers. * * @param[in, out] writer1 first writer * @param[in, out] writer2 second writer */ tee_writer(writer& writer1, writer& writer2) : writer1_(writer1), writer2_(writer2) {} virtual ~tee_writer() {} void operator()(const std::vector& names) { writer1_(names); writer2_(names); } void operator()(const std::vector& state) { writer1_(state); writer2_(state); } void operator()() { writer1_(); writer2_(); } void operator()(const std::string& message) { writer1_(message); writer2_(message); } private: /** * The first writer */ writer& writer1_; /** * The second writer */ writer& writer2_; }; } // namespace callbacks } // namespace stan #endif StanHeaders/inst/include/src/stan/callbacks/stream_logger.hpp0000644000176200001440000000403013766554456024113 0ustar liggesusers#ifndef STAN_CALLBACKS_STREAM_LOGGER_HPP #define STAN_CALLBACKS_STREAM_LOGGER_HPP #include #include #include #include namespace stan { namespace callbacks { /** * stream_logger is an implementation of * logger that writes messages to separate * std::stringstream outputs. */ class stream_logger : public logger { private: std::ostream& debug_; std::ostream& info_; std::ostream& warn_; std::ostream& error_; std::ostream& fatal_; public: /** * Constructs a stream_logger with an output * stream for each log level. * * @param[in,out] debug stream to output debug messages * @param[in,out] info stream to output info messages * @param[in,out] warn stream to output warn messages * @param[in,out] error stream to output error messages * @param[in,out] fatal stream to output fatal messages */ stream_logger(std::ostream& debug, std::ostream& info, std::ostream& warn, std::ostream& error, std::ostream& fatal) : debug_(debug), info_(info), warn_(warn), error_(error), fatal_(fatal) {} void debug(const std::string& message) { debug_ << message << std::endl; } void debug(const std::stringstream& message) { debug_ << message.str() << std::endl; } void info(const std::string& message) { info_ << message << std::endl; } void info(const std::stringstream& message) { info_ << message.str() << std::endl; } void warn(const std::string& message) { warn_ << message << std::endl; } void warn(const std::stringstream& message) { warn_ << message.str() << std::endl; } void error(const std::string& message) { error_ << message << std::endl; } void error(const std::stringstream& message) { error_ << message.str() << std::endl; } void fatal(const std::string& message) { fatal_ << message << std::endl; } void fatal(const std::stringstream& message) { fatal_ << message.str() << std::endl; } }; } // namespace callbacks } // namespace stan #endif StanHeaders/inst/include/src/stan/callbacks/logger.hpp0000644000176200001440000000377013766554456022552 0ustar liggesusers#ifndef STAN_CALLBACKS_LOGGER_HPP #define STAN_CALLBACKS_LOGGER_HPP #include #include namespace stan { namespace callbacks { /** * The logger class defines the callback * used by Stan's algorithms to log messages in the * interfaces. The base class can be used as a no-op * implementation. * * These are the logging levels used by logger, * in order: * 1. debug * 2. info * 3. warn * 4. error * 5. fatal */ class logger { public: virtual ~logger() {} /** * Logs a message with debug log level * * @param[in] message message */ virtual void debug(const std::string& message) {} /** * Logs a message with debug log level. * * @param[in] message message */ virtual void debug(const std::stringstream& message) {} /** * Logs a message with info log level. * * @param[in] message message */ virtual void info(const std::string& message) {} /** * Logs a message with info log level. * * @param[in] message message */ virtual void info(const std::stringstream& message) {} /** * Logs a message with warn log level. * * @param[in] message message */ virtual void warn(const std::string& message) {} /** * Logs a message with warn log level. * * @param[in] message message */ virtual void warn(const std::stringstream& message) {} /** * Logs an error with error log level. * * @param[in] message message */ virtual void error(const std::string& message) {} /** * Logs an error with error log level. * * @param[in] message message */ virtual void error(const std::stringstream& message) {} /** * Logs an error with fatal log level. * * @param[in] message message */ virtual void fatal(const std::string& message) {} /** * Logs an error with fatal log level. * * @param[in] message message */ virtual void fatal(const std::stringstream& message) {} }; } // namespace callbacks } // namespace stan #endif StanHeaders/inst/include/src/stan/callbacks/stream_writer.hpp0000644000176200001440000000514013766554456024153 0ustar liggesusers#ifndef STAN_CALLBACKS_STREAM_WRITER_HPP #define STAN_CALLBACKS_STREAM_WRITER_HPP #include #include #include #include namespace stan { namespace callbacks { /** * stream_writer is an implementation * of writer that writes to a stream. */ class stream_writer : public writer { public: /** * Constructs a stream writer with an output stream * and an optional prefix for comments. * * @param[in, out] output stream to write * @param[in] comment_prefix string to stream before * each comment line. Default is "". */ explicit stream_writer(std::ostream& output, const std::string& comment_prefix = "") : output_(output), comment_prefix_(comment_prefix) {} /** * Virtual destructor */ virtual ~stream_writer() {} /** * Writes a set of names on a single line in csv format followed * by a newline. * * Note: the names are not escaped. * * @param[in] names Names in a std::vector */ void operator()(const std::vector& names) { write_vector(names); } /** * Writes a set of values in csv format followed by a newline. * * Note: the precision of the output is determined by the settings * of the stream on construction. * * @param[in] state Values in a std::vector */ void operator()(const std::vector& state) { write_vector(state); } /** * Writes the comment_prefix to the stream followed by a newline. */ void operator()() { output_ << comment_prefix_ << std::endl; } /** * Writes the comment_prefix then the message followed by a newline. * * @param[in] message A string */ void operator()(const std::string& message) { output_ << comment_prefix_ << message << std::endl; } private: /** * Output stream */ std::ostream& output_; /** * Comment prefix to use when printing comments: strings and blank lines */ std::string comment_prefix_; /** * Writes a set of values in csv format followed by a newline. * * Note: the precision of the output is determined by the settings * of the stream on construction. * * @param[in] v Values in a std::vector */ template void write_vector(const std::vector& v) { if (v.empty()) return; typename std::vector::const_iterator last = v.end(); --last; for (typename std::vector::const_iterator it = v.begin(); it != last; ++it) output_ << *it << ","; output_ << v.back() << std::endl; } }; } // namespace callbacks } // namespace stan #endif StanHeaders/inst/include/src/stan/optimization/0000755000176200001440000000000013766554456021362 5ustar liggesusersStanHeaders/inst/include/src/stan/optimization/bfgs_update.hpp0000644000176200001440000000354013766554456024360 0ustar liggesusers#ifndef STAN_OPTIMIZATION_BFGS_UPDATE_HPP #define STAN_OPTIMIZATION_BFGS_UPDATE_HPP #include namespace stan { namespace optimization { template class BFGSUpdate_HInv { public: typedef Eigen::Matrix VectorT; typedef Eigen::Matrix HessianT; /** * Update the inverse Hessian approximation. * * @param yk Difference between the current and previous gradient vector. * @param sk Difference between the current and previous state vector. * @param reset Whether to reset the approximation, forgetting about * previous values. * @return In the case of a reset, returns the optimal scaling of the * initial Hessian approximation which is useful for predicting * step-sizes. **/ inline Scalar update(const VectorT &yk, const VectorT &sk, bool reset = false) { Scalar rhok, skyk, B0fact; HessianT Hupd; skyk = yk.dot(sk); rhok = 1.0 / skyk; Hupd.noalias() = HessianT::Identity(yk.size(), yk.size()) - rhok * sk * yk.transpose(); if (reset) { B0fact = yk.squaredNorm() / skyk; _Hk.noalias() = ((1.0 / B0fact) * Hupd) * Hupd.transpose(); } else { B0fact = 1.0; _Hk = Hupd * _Hk * Hupd.transpose(); } _Hk.noalias() += rhok * sk * sk.transpose(); return B0fact; } /** * Compute the search direction based on the current (inverse) Hessian * approximation and given gradient. * * @param[out] pk The negative product of the inverse Hessian and gradient * direction gk. * @param[in] gk Gradient direction. **/ inline void search_direction(VectorT &pk, const VectorT &gk) const { pk.noalias() = -(_Hk * gk); } private: HessianT _Hk; }; } // namespace optimization } // namespace stan #endif StanHeaders/inst/include/src/stan/optimization/lbfgs_update.hpp0000644000176200001440000000671613766554456024544 0ustar liggesusers#ifndef STAN_OPTIMIZATION_LBFGS_UPDATE_HPP #define STAN_OPTIMIZATION_LBFGS_UPDATE_HPP #include #include #include #include namespace stan { namespace optimization { /** * Implement a limited memory version of the BFGS update. This * class maintains a circular buffer of inverse Hessian updates * which can be applied to compute the search direction. **/ template class LBFGSUpdate { public: typedef Eigen::Matrix VectorT; typedef Eigen::Matrix HessianT; // NOLINTNEXTLINE(build/include_what_you_use) typedef boost::tuple UpdateT; explicit LBFGSUpdate(size_t L = 5) : _buf(L) {} /** * Set the number of inverse Hessian updates to keep. * * @param L New size of buffer. **/ void set_history_size(size_t L) { _buf.rset_capacity(L); } /** * Add a new set of update vectors to the history. * * @param yk Difference between the current and previous gradient vector. * @param sk Difference between the current and previous state vector. * @param reset Whether to reset the approximation, forgetting about * previous values. * @return In the case of a reset, returns the optimal scaling of the * initial Hessian * approximation which is useful for predicting step-sizes. **/ inline Scalar update(const VectorT &yk, const VectorT &sk, bool reset = false) { Scalar skyk = yk.dot(sk); Scalar B0fact; if (reset) { B0fact = yk.squaredNorm() / skyk; _buf.clear(); } else { B0fact = 1.0; } // New updates are pushed to the "back" of the circular buffer Scalar invskyk = 1.0 / skyk; _gammak = skyk / yk.squaredNorm(); _buf.push_back(); _buf.back() = boost::tie(invskyk, yk, sk); return B0fact; } /** * Compute the search direction based on the current (inverse) Hessian * approximation and given gradient. * * @param[out] pk The negative product of the inverse Hessian and gradient * direction gk. * @param[in] gk Gradient direction. **/ inline void search_direction(VectorT &pk, const VectorT &gk) const { std::vector alphas(_buf.size()); typename boost::circular_buffer::const_reverse_iterator buf_rit; typename boost::circular_buffer::const_iterator buf_it; typename std::vector::const_iterator alpha_it; typename std::vector::reverse_iterator alpha_rit; pk.noalias() = -gk; for (buf_rit = _buf.rbegin(), alpha_rit = alphas.rbegin(); buf_rit != _buf.rend(); buf_rit++, alpha_rit++) { Scalar alpha; const Scalar &rhoi(boost::get<0>(*buf_rit)); const VectorT &yi(boost::get<1>(*buf_rit)); const VectorT &si(boost::get<2>(*buf_rit)); alpha = rhoi * si.dot(pk); pk -= alpha * yi; *alpha_rit = alpha; } pk *= _gammak; for (buf_it = _buf.begin(), alpha_it = alphas.begin(); buf_it != _buf.end(); buf_it++, alpha_it++) { Scalar beta; const Scalar &rhoi(boost::get<0>(*buf_it)); const VectorT &yi(boost::get<1>(*buf_it)); const VectorT &si(boost::get<2>(*buf_it)); beta = rhoi * yi.dot(pk); pk += (*alpha_it - beta) * si; } } protected: boost::circular_buffer _buf; Scalar _gammak; }; } // namespace optimization } // namespace stan #endif StanHeaders/inst/include/src/stan/optimization/bfgs_linesearch.hpp0000644000176200001440000002156713766554456025224 0ustar liggesusers#ifndef STAN_OPTIMIZATION_BFGS_LINESEARCH_HPP #define STAN_OPTIMIZATION_BFGS_LINESEARCH_HPP #include #include #include #include #include #include namespace stan { namespace optimization { /** * Find the minima in an interval [loX, hiX] of a cubic function which * interpolates the points, function values and gradients provided. * * Implicitly, this function constructs an interpolating polynomial * g(x) = a_3 x^3 + a_2 x^2 + a_1 x + a_0 * such that g(0) = 0, g(x1) = f1, g'(0) = df0, g'(x1) = df1 where * g'(x) = 3 a_3 x^2 + 2 a_2 x + a_1 * is the derivative of g(x). It then computes the roots of g'(x) and * finds the minimal value of g(x) on the interval [loX,hiX] including * the end points. * * This function implements the full parameter version of CubicInterp(). * * @param df0 First derivative value, f'(x0) * @param x1 Second point * @param f1 Second function value, f(x1) * @param df1 Second derivative value, f'(x1) * @param loX Lower bound on the interval of solutions * @param hiX Upper bound on the interval of solutions **/ template Scalar CubicInterp(const Scalar &df0, const Scalar &x1, const Scalar &f1, const Scalar &df1, const Scalar &loX, const Scalar &hiX) { const Scalar c3((-12 * f1 + 6 * x1 * (df0 + df1)) / (x1 * x1 * x1)); const Scalar c2(-(4 * df0 + 2 * df1) / x1 + 6 * f1 / (x1 * x1)); const Scalar &c1(df0); const Scalar t_s = std::sqrt(c2 * c2 - 2.0 * c1 * c3); const Scalar s1 = -(c2 + t_s) / c3; const Scalar s2 = -(c2 - t_s) / c3; Scalar tmpF; Scalar minF, minX; // Check value at lower bound minF = loX * (loX * (loX * c3 / 3.0 + c2) / 2.0 + c1); minX = loX; // Check value at upper bound tmpF = hiX * (hiX * (hiX * c3 / 3.0 + c2) / 2.0 + c1); if (tmpF < minF) { minF = tmpF; minX = hiX; } // Check value of first root if (loX < s1 && s1 < hiX) { tmpF = s1 * (s1 * (s1 * c3 / 3.0 + c2) / 2.0 + c1); if (tmpF < minF) { minF = tmpF; minX = s1; } } // Check value of second root if (loX < s2 && s2 < hiX) { tmpF = s2 * (s2 * (s2 * c3 / 3.0 + c2) / 2.0 + c1); if (tmpF < minF) { minF = tmpF; minX = s2; } } return minX; } /** * Find the minima in an interval [loX, hiX] of a cubic function which * interpolates the points, function values and gradients provided. * * Implicitly, this function constructs an interpolating polynomial * g(x) = a_3 x^3 + a_2 x^2 + a_1 x + a_0 * such that g(x0) = f0, g(x1) = f1, g'(x0) = df0, g'(x1) = df1 where * g'(x) = 3 a_3 x^2 + 2 a_2 x + a_1 * is the derivative of g(x). It then computes the roots of g'(x) and * finds the minimal value of g(x) on the interval [loX,hiX] including * the end points. * * @param x0 First point * @param f0 First function value, f(x0) * @param df0 First derivative value, f'(x0) * @param x1 Second point * @param f1 Second function value, f(x1) * @param df1 Second derivative value, f'(x1) * @param loX Lower bound on the interval of solutions * @param hiX Upper bound on the interval of solutions **/ template Scalar CubicInterp(const Scalar &x0, const Scalar &f0, const Scalar &df0, const Scalar &x1, const Scalar &f1, const Scalar &df1, const Scalar &loX, const Scalar &hiX) { return x0 + CubicInterp(df0, x1 - x0, f1 - f0, df1, loX - x0, hiX - x0); } /** * An internal utility function for implementing WolfeLineSearch() **/ template int WolfLSZoom(Scalar &alpha, XType &newX, Scalar &newF, XType &newDF, FunctorType &func, const XType &x, const Scalar &f, const Scalar &dfp, const Scalar &c1dfp, const Scalar &c2dfp, const XType &p, Scalar alo, Scalar aloF, Scalar aloDFp, Scalar ahi, Scalar ahiF, Scalar ahiDFp, const Scalar &min_range) { Scalar d1, d2, newDFp; int itNum(0); while (1) { itNum++; if (std::fabs(alo - ahi) < min_range) return 1; if (itNum % 5 == 0) { alpha = 0.5 * (alo + ahi); } else { // Perform cubic interpolation to determine next point to try d1 = aloDFp + ahiDFp - 3 * (aloF - ahiF) / (alo - ahi); d2 = std::sqrt(d1 * d1 - aloDFp * ahiDFp); if (ahi < alo) d2 = -d2; alpha = ahi - (ahi - alo) * (ahiDFp + d2 - d1) / (ahiDFp - aloDFp + 2 * d2); if (!boost::math::isfinite(alpha) || alpha < std::min(alo, ahi) + 0.01 * std::fabs(alo - ahi) || alpha > std::max(alo, ahi) - 0.01 * std::fabs(alo - ahi)) alpha = 0.5 * (alo + ahi); } newX = x + alpha * p; while (func(newX, newF, newDF)) { alpha = 0.5 * (alpha + std::min(alo, ahi)); if (std::fabs(std::min(alo, ahi) - alpha) < min_range) return 1; newX = x + alpha * p; } newDFp = newDF.dot(p); if (newF > (f + alpha * c1dfp) || newF >= aloF) { ahi = alpha; ahiF = newF; ahiDFp = newDFp; } else { if (std::fabs(newDFp) <= -c2dfp) break; if (newDFp * (ahi - alo) >= 0) { ahi = alo; ahiF = aloF; ahiDFp = aloDFp; } alo = alpha; aloF = newF; aloDFp = newDFp; } } return 0; } /** * Perform a line search which finds an approximate solution to: * \f[ * \min_\alpha f(x_0 + \alpha p) * \f] * satisfying the strong Wolfe conditions: * 1) \f$ f(x_0 + \alpha p) \leq f(x_0) + c_1 \alpha p^T g(x_0) \f$ * 2) \f$ \vert p^T g(x_0 + \alpha p) \vert \leq c_2 \vert p^T g(x_0) \vert \f$ * where \f$g(x) = \frac{\partial f}{\partial x}\f$ is the gradient of f(x). * * @tparam FunctorType A type which supports being called as * ret = func(x,f,g) * where x is the input point, f and g are the function value and * gradient at x and ret is non-zero if function evaluation fails. * * @param func Function which is being minimized. * * @param alpha First value of \f$ \alpha \f$ to try. Upon return this * contains the final value of the \f$ \alpha \f$. * * @param x1 Final point, equal to \f$ x_0 + \alpha p \f$. * * @param f1 Final point function value, equal to \f$ f(x_0 + \alpha p) \f$. * * @param gradx1 Final point gradient, equal to \f$ g(x_0 + \alpha p) \f$. * * @param p Search direction. It is assumed to be a descent direction such * that \f$ p^T g(x_0) < 0 \f$. * * @param x0 Value of starting point, \f$ x_0 \f$. * * @param f0 Value of function at starting point, \f$ f(x_0) \f$. * * @param gradx0 Value of function gradient at starting point, * \f$ g(x_0) \f$. * * @param c1 Parameter of the Wolfe conditions. \f$ 0 < c_1 < c_2 < 1 \f$ * Typically c1 = 1e-4. * * @param c2 Parameter of the Wolfe conditions. \f$ 0 < c_1 < c_2 < 1 \f$ * Typically c2 = 0.9. * * @param minAlpha Smallest allowable step-size. * * @param maxLSIts Maximum number line search iterations. * * @param maxLSRestarts Maximum number of times line search will * restart with \f$ f() \f$ failing. * * @return Returns zero on success, non-zero otherwise. **/ template int WolfeLineSearch(FunctorType &func, Scalar &alpha, XType &x1, Scalar &f1, XType &gradx1, const XType &p, const XType &x0, const Scalar &f0, const XType &gradx0, const Scalar &c1, const Scalar &c2, const Scalar &minAlpha, const Scalar &maxLSIts, const Scalar &maxLSRestarts) { const Scalar dfp(gradx0.dot(p)); const Scalar c1dfp(c1 * dfp); const Scalar c2dfp(c2 * dfp); Scalar alpha0(minAlpha); Scalar alpha1(alpha); Scalar prevF(f0); XType prevDF(gradx0); Scalar prevDFp(dfp); Scalar newDFp; int retCode = 0, nits = 0, lsRestarts = 0, ret; while (1) { if (nits >= maxLSIts) { retCode = 1; break; } x1.noalias() = x0 + alpha1 * p; ret = func(x1, f1, gradx1); if (ret != 0) { if (lsRestarts >= maxLSRestarts) { retCode = 1; break; } alpha1 = 0.5 * (alpha0 + alpha1); lsRestarts++; continue; } lsRestarts = 0; newDFp = gradx1.dot(p); if ((f1 > f0 + alpha * c1dfp) || (f1 >= prevF && nits > 0)) { retCode = WolfLSZoom(alpha, x1, f1, gradx1, func, x0, f0, dfp, c1dfp, c2dfp, p, alpha0, prevF, prevDFp, alpha1, f1, newDFp, 1e-16); break; } if (std::fabs(newDFp) <= -c2dfp) { alpha = alpha1; break; } if (newDFp >= 0) { retCode = WolfLSZoom(alpha, x1, f1, gradx1, func, x0, f0, dfp, c1dfp, c2dfp, p, alpha1, f1, newDFp, alpha0, prevF, prevDFp, 1e-16); break; } alpha0 = alpha1; prevF = f1; std::swap(prevDF, gradx1); prevDFp = newDFp; alpha1 *= 10.0; nits++; } return retCode; } } // namespace optimization } // namespace stan #endif StanHeaders/inst/include/src/stan/optimization/newton.hpp0000644000176200001440000000470213766554456023410 0ustar liggesusers#ifndef STAN_OPTIMIZATION_NEWTON_HPP #define STAN_OPTIMIZATION_NEWTON_HPP #include #include #include #include #include #include namespace stan { namespace optimization { typedef Eigen::Matrix matrix_d; typedef Eigen::Matrix vector_d; // Negates any positive eigenvalues in H so that H is negative // definite, and then solves Hu = g and stores the result into // g. Avoids problems due to non-log-concave distributions. inline void make_negative_definite_and_solve(matrix_d& H, vector_d& g) { Eigen::SelfAdjointEigenSolver solver(H); matrix_d eigenvectors = solver.eigenvectors(); vector_d eigenvalues = solver.eigenvalues(); vector_d eigenprojections = eigenvectors.transpose() * g; for (int i = 0; i < g.size(); i++) { eigenprojections[i] = -eigenprojections[i] / fabs(eigenvalues[i]); } g = eigenvectors * eigenprojections; } template double newton_step(M& model, std::vector& params_r, std::vector& params_i, std::ostream* output_stream = 0) { std::vector gradient; std::vector hessian; double f0 = stan::model::grad_hess_log_prob( model, params_r, params_i, gradient, hessian); matrix_d H(params_r.size(), params_r.size()); for (size_t i = 0; i < hessian.size(); i++) { H(i) = hessian[i]; } vector_d g(params_r.size()); for (size_t i = 0; i < gradient.size(); i++) g(i) = gradient[i]; make_negative_definite_and_solve(H, g); // H.ldlt().solveInPlace(g); std::vector new_params_r(params_r.size()); double step_size = 2; double min_step_size = 1e-50; double f1 = -1e100; while (f1 < f0) { step_size *= 0.5; if (step_size < min_step_size) return f0; for (size_t i = 0; i < params_r.size(); i++) new_params_r[i] = params_r[i] - step_size * g[i]; try { f1 = stan::model::log_prob_grad(model, new_params_r, params_i, gradient); } catch (std::exception& e) { // FIXME: this is not a good way to handle a general exception f1 = -1e100; } } for (size_t i = 0; i < params_r.size(); i++) params_r[i] = new_params_r[i]; return f1; } } // namespace optimization } // namespace stan #endif StanHeaders/inst/include/src/stan/optimization/bfgs.hpp0000644000176200001440000003006613766554456023021 0ustar liggesusers#ifndef STAN_OPTIMIZATION_BFGS_HPP #define STAN_OPTIMIZATION_BFGS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace optimization { typedef enum { TERM_SUCCESS = 0, TERM_ABSX = 10, TERM_ABSF = 20, TERM_RELF = 21, TERM_ABSGRAD = 30, TERM_RELGRAD = 31, TERM_MAXIT = 40, TERM_LSFAIL = -1 } TerminationCondition; template class ConvergenceOptions { public: ConvergenceOptions() { maxIts = 10000; fScale = 1.0; tolAbsX = 1e-8; tolAbsF = 1e-12; tolAbsGrad = 1e-8; tolRelF = 1e+4; tolRelGrad = 1e+3; } size_t maxIts; Scalar tolAbsX; Scalar tolAbsF; Scalar tolRelF; Scalar fScale; Scalar tolAbsGrad; Scalar tolRelGrad; }; template class LSOptions { public: LSOptions() { c1 = 1e-4; c2 = 0.9; alpha0 = 1e-3; minAlpha = 1e-12; maxLSIts = 20; maxLSRestarts = 10; } Scalar c1; Scalar c2; Scalar alpha0; Scalar minAlpha; Scalar maxLSIts; Scalar maxLSRestarts; }; template class BFGSMinimizer { public: typedef Eigen::Matrix VectorT; typedef Eigen::Matrix HessianT; protected: FunctorType &_func; VectorT _gk, _gk_1, _xk_1, _xk, _pk, _pk_1; Scalar _fk, _fk_1, _alphak_1; Scalar _alpha, _alpha0; size_t _itNum; std::string _note; QNUpdateType _qn; public: LSOptions _ls_opts; ConvergenceOptions _conv_opts; QNUpdateType &get_qnupdate() { return _qn; } const QNUpdateType &get_qnupdate() const { return _qn; } const Scalar &curr_f() const { return _fk; } const VectorT &curr_x() const { return _xk; } const VectorT &curr_g() const { return _gk; } const VectorT &curr_p() const { return _pk; } const Scalar &prev_f() const { return _fk_1; } const VectorT &prev_x() const { return _xk_1; } const VectorT &prev_g() const { return _gk_1; } const VectorT &prev_p() const { return _pk_1; } Scalar prev_step_size() const { return _pk_1.norm() * _alphak_1; } inline Scalar rel_grad_norm() const { return -_pk.dot(_gk) / std::max(std::fabs(_fk), _conv_opts.fScale); } inline Scalar rel_obj_decrease() const { return std::fabs(_fk_1 - _fk) / std::max(std::fabs(_fk_1), std::max(std::fabs(_fk), _conv_opts.fScale)); } const Scalar &alpha0() const { return _alpha0; } const Scalar &alpha() const { return _alpha; } const size_t iter_num() const { return _itNum; } const std::string ¬e() const { return _note; } std::string get_code_string(int retCode) { switch (retCode) { case TERM_SUCCESS: return std::string("Successful step completed"); case TERM_ABSF: return std::string( "Convergence detected: absolute change " "in objective function was below tolerance"); case TERM_RELF: return std::string( "Convergence detected: relative change " "in objective function was below tolerance"); case TERM_ABSGRAD: return std::string( "Convergence detected: " "gradient norm is below tolerance"); case TERM_RELGRAD: return std::string( "Convergence detected: relative " "gradient magnitude is below tolerance"); case TERM_ABSX: return std::string( "Convergence detected: " "absolute parameter change was below tolerance"); case TERM_MAXIT: return std::string( "Maximum number of iterations hit, " "may not be at an optima"); case TERM_LSFAIL: return std::string( "Line search failed to achieve a sufficient " "decrease, no more progress can be made"); default: return std::string("Unknown termination code"); } } explicit BFGSMinimizer(FunctorType &f) : _func(f) {} void initialize(const VectorT &x0) { int ret; _xk = x0; ret = _func(_xk, _fk, _gk); if (ret) { throw std::runtime_error("Error evaluating initial BFGS point."); } _pk = -_gk; _itNum = 0; _note = ""; } int step() { Scalar gradNorm, stepNorm; VectorT sk, yk; int retCode(0); int resetB(0); _itNum++; if (_itNum == 1) { resetB = 1; _note = ""; } else { resetB = 0; _note = ""; } while (true) { if (resetB) { // Reset the Hessian approximation _pk.noalias() = -_gk; } // Get an initial guess for the step size (alpha) if (_itNum > 1 && resetB != 2) { // use cubic interpolation based on the previous step _alpha0 = _alpha = std::min( 1.0, 1.01 * CubicInterp(_gk_1.dot(_pk_1), _alphak_1, _fk - _fk_1, _gk.dot(_pk_1), _ls_opts.minAlpha, 1.0)); } else { // On the first step (or, after a reset) use the default step size _alpha0 = _alpha = _ls_opts.alpha0; } // Perform the line search. If successful, the results are in the // variables: _xk_1, _fk_1 and _gk_1. retCode = WolfeLineSearch(_func, _alpha, _xk_1, _fk_1, _gk_1, _pk, _xk, _fk, _gk, _ls_opts.c1, _ls_opts.c2, _ls_opts.minAlpha, _ls_opts.maxLSIts, _ls_opts.maxLSRestarts); if (retCode) { // Line search failed... if (resetB) { // did a Hessian reset and it still failed, // and nothing left to try retCode = TERM_LSFAIL; return retCode; } else { // try resetting the Hessian approximation resetB = 2; _note += "LS failed, Hessian reset"; continue; } } else { break; } } // Swap things so that k is the most recent iterate std::swap(_fk, _fk_1); _xk.swap(_xk_1); _gk.swap(_gk_1); _pk.swap(_pk_1); sk.noalias() = _xk - _xk_1; yk.noalias() = _gk - _gk_1; gradNorm = _gk.norm(); stepNorm = sk.norm(); // Update QN approximation if (resetB) { // If the QN approximation was reset, automatically scale it // and update the step-size accordingly Scalar B0fact = _qn.update(yk, sk, true); _pk_1 /= B0fact; _alphak_1 = _alpha * B0fact; } else { _qn.update(yk, sk); _alphak_1 = _alpha; } // Compute search direction for next step _qn.search_direction(_pk, _gk); // Check for convergence if (std::fabs(_fk_1 - _fk) < _conv_opts.tolAbsF) { // Objective function improvement wasn't sufficient retCode = TERM_ABSF; } else if (gradNorm < _conv_opts.tolAbsGrad) { retCode = TERM_ABSGRAD; // Gradient norm was below threshold } else if (stepNorm < _conv_opts.tolAbsX) { retCode = TERM_ABSX; // Change in x was too small } else if (_itNum >= _conv_opts.maxIts) { retCode = TERM_MAXIT; // Max number of iterations hit } else if (rel_obj_decrease() < _conv_opts.tolRelF * std::numeric_limits::epsilon()) { // Relative improvement in objective function wasn't sufficient retCode = TERM_RELF; } else if (rel_grad_norm() < _conv_opts.tolRelGrad * std::numeric_limits::epsilon()) { // Relative gradient norm was below threshold retCode = TERM_RELGRAD; } else { // Step was successful more progress to be made retCode = TERM_SUCCESS; } return retCode; } int minimize(VectorT &x0) { int retcode; initialize(x0); while (!(retcode = step())) continue; x0 = _xk; return retcode; } }; template class ModelAdaptor { private: M &_model; std::vector _params_i; std::ostream *_msgs; std::vector _x, _g; size_t _fevals; public: ModelAdaptor(M &model, const std::vector ¶ms_i, std::ostream *msgs) : _model(model), _params_i(params_i), _msgs(msgs), _fevals(0) {} size_t fevals() const { return _fevals; } int operator()(const Eigen::Matrix &x, double &f) { using Eigen::Dynamic; using Eigen::Matrix; using stan::math::index_type; using stan::model::log_prob_propto; typedef typename index_type >::type idx_t; _x.resize(x.size()); for (idx_t i = 0; i < x.size(); i++) _x[i] = x[i]; try { f = -log_prob_propto(_model, _x, _params_i, _msgs); } catch (const std::exception &e) { if (_msgs) (*_msgs) << e.what() << std::endl; return 1; } if (boost::math::isfinite(f)) { return 0; } else { if (_msgs) *_msgs << "Error evaluating model log probability: " "Non-finite function evaluation." << std::endl; return 2; } } int operator()(const Eigen::Matrix &x, double &f, Eigen::Matrix &g) { using Eigen::Dynamic; using Eigen::Matrix; using stan::math::index_type; using stan::model::log_prob_grad; typedef typename index_type >::type idx_t; _x.resize(x.size()); for (idx_t i = 0; i < x.size(); i++) _x[i] = x[i]; _fevals++; try { f = -log_prob_grad(_model, _x, _params_i, _g, _msgs); } catch (const std::exception &e) { if (_msgs) (*_msgs) << e.what() << std::endl; return 1; } g.resize(_g.size()); for (size_t i = 0; i < _g.size(); i++) { if (!boost::math::isfinite(_g[i])) { if (_msgs) *_msgs << "Error evaluating model log probability: " "Non-finite gradient." << std::endl; return 3; } g[i] = -_g[i]; } if (boost::math::isfinite(f)) { return 0; } else { if (_msgs) *_msgs << "Error evaluating model log probability: " << "Non-finite function evaluation." << std::endl; return 2; } } int df(const Eigen::Matrix &x, Eigen::Matrix &g) { double f; return (*this)(x, f, g); } }; template class BFGSLineSearch : public BFGSMinimizer, QNUpdateType, Scalar, DimAtCompile> { private: ModelAdaptor _adaptor; public: typedef BFGSMinimizer, QNUpdateType, Scalar, DimAtCompile> BFGSBase; typedef typename BFGSBase::VectorT vector_t; typedef typename stan::math::index_type::type idx_t; BFGSLineSearch(M &model, const std::vector ¶ms_r, const std::vector ¶ms_i, std::ostream *msgs = 0) : BFGSBase(_adaptor), _adaptor(model, params_i, msgs) { initialize(params_r); } void initialize(const std::vector ¶ms_r) { Eigen::Matrix x; x.resize(params_r.size()); for (size_t i = 0; i < params_r.size(); i++) x[i] = params_r[i]; BFGSBase::initialize(x); } size_t grad_evals() { return _adaptor.fevals(); } double logp() { return -(this->curr_f()); } double grad_norm() { return this->curr_g().norm(); } void grad(std::vector &g) { const vector_t &cg(this->curr_g()); g.resize(cg.size()); for (idx_t i = 0; i < cg.size(); i++) g[i] = -cg[i]; } void params_r(std::vector &x) { const vector_t &cx(this->curr_x()); x.resize(cx.size()); for (idx_t i = 0; i < cx.size(); i++) x[i] = cx[i]; } }; } // namespace optimization } // namespace stan #endif StanHeaders/inst/include/src/stan/variational/0000755000176200001440000000000013766554456021145 5ustar liggesusersStanHeaders/inst/include/src/stan/variational/base_family.hpp0000644000176200001440000000714413766554456024137 0ustar liggesusers#ifndef STAN_VARIATIONAL_BASE_FAMILY_HPP #define STAN_VARIATIONAL_BASE_FAMILY_HPP #include #include #include #include namespace stan { namespace variational { class base_family { public: // Constructors base_family() {} /** * Return the dimensionality of the approximation. */ virtual int dimension() const = 0; // Distribution-based operations virtual const Eigen::VectorXd& mean() const = 0; virtual double entropy() const = 0; virtual Eigen::VectorXd transform(const Eigen::VectorXd& eta) const = 0; /** * Assign a draw from this mean field approximation to the * specified vector using the specified random number generator. * * @tparam BaseRNG Class of random number generator. * @param[in] rng Base random number generator. * @param[out] eta Vector to which the draw is assigned; dimension has to be * the same as the dimension of variational q. * @throws std::range_error If the index is out of range. */ template void sample(BaseRNG& rng, Eigen::VectorXd& eta) const { // Draw from standard normal and transform to real-coordinate space for (int d = 0; d < dimension(); ++d) eta(d) = stan::math::normal_rng(0, 1, rng); eta = transform(eta); } /** * Draw a posterior sample from the normal distribution, * and return its log normal density. The constants are dropped. * * @param[in] rng Base random number generator. * @param[out] eta Vector to which the draw is assigned; dimension has to be * the same as the dimension of variational q. eta will be transformed into * variational posteriors. * @param[out] log_g The log density in the variational approximation; * The constant term is dropped. * @throws std::range_error If the index is out of range. */ template void sample_log_g(BaseRNG& rng, Eigen::VectorXd& eta, double& log_g) const { // Draw from the approximation for (int d = 0; d < dimension(); ++d) { eta(d) = stan::math::normal_rng(0, 1, rng); } // Compute the log density before transformation log_g = calc_log_g(eta); // Transform to real-coordinate space eta = transform(eta); } /** * Compute the unnormalized log unit normal density wrt eta. All constants are * dropped. * * @param[in] eta Vector; dimension has to be the same as the dimension * of variational q. * @return The unnormalized log density in the variational approximation; * @throws std::range_error If the index is out of range. */ double calc_log_g(const Eigen::VectorXd& eta) const { double log_g = 0; for (int d = 0; d < dimension(); ++d) { log_g += -stan::math::square(eta(d)) * 0.5; } return log_g; } template void calc_grad(base_family& elbo_grad, M& m, Eigen::VectorXd& cont_params, int n_monte_carlo_grad, BaseRNG& rng, callbacks::logger& logger) const; protected: void write_error_msg_(std::ostream* error_msgs, const std::exception& e) const { if (!error_msgs) { return; } *error_msgs << std::endl << "Informational Message: The current gradient evaluation " << "of the ELBO is ignored because of the following issue:" << std::endl << e.what() << std::endl << "If this warning occurs often then your model may be " << "either severely ill-conditioned or misspecified." << std::endl; } }; } // namespace variational } // namespace stan #endif StanHeaders/inst/include/src/stan/variational/advi.hpp0000644000176200001440000005044413766554456022610 0ustar liggesusers#ifndef STAN_VARIATIONAL_ADVI_HPP #define STAN_VARIATIONAL_ADVI_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace variational { /** * Automatic Differentiation Variational Inference * * Implements "black box" variational inference using stochastic gradient * ascent to maximize the Evidence Lower Bound for a given model * and variational family. * * @tparam Model class of model * @tparam Q class of variational distribution * @tparam BaseRNG class of random number generator */ template class advi { public: /** * Constructor * * @param[in] m stan model * @param[in] cont_params initialization of continuous parameters * @param[in,out] rng random number generator * @param[in] n_monte_carlo_grad number of samples for gradient computation * @param[in] n_monte_carlo_elbo number of samples for ELBO computation * @param[in] eval_elbo evaluate ELBO at every "eval_elbo" iters * @param[in] n_posterior_samples number of samples to draw from posterior * @throw std::runtime_error if n_monte_carlo_grad is not positive * @throw std::runtime_error if n_monte_carlo_elbo is not positive * @throw std::runtime_error if eval_elbo is not positive * @throw std::runtime_error if n_posterior_samples is not positive */ advi(Model& m, Eigen::VectorXd& cont_params, BaseRNG& rng, int n_monte_carlo_grad, int n_monte_carlo_elbo, int eval_elbo, int n_posterior_samples) : model_(m), cont_params_(cont_params), rng_(rng), n_monte_carlo_grad_(n_monte_carlo_grad), n_monte_carlo_elbo_(n_monte_carlo_elbo), eval_elbo_(eval_elbo), n_posterior_samples_(n_posterior_samples) { static const char* function = "stan::variational::advi"; math::check_positive(function, "Number of Monte Carlo samples for gradients", n_monte_carlo_grad_); math::check_positive(function, "Number of Monte Carlo samples for ELBO", n_monte_carlo_elbo_); math::check_positive(function, "Evaluate ELBO at every eval_elbo iteration", eval_elbo_); math::check_positive(function, "Number of posterior samples for output", n_posterior_samples_); } /** * Calculates the Evidence Lower BOund (ELBO) by sampling from * the variational distribution and then evaluating the log joint, * adjusted by the entropy term of the variational distribution. * * @param[in] variational variational approximation at which to evaluate * the ELBO. * @param logger logger for messages * @return the evidence lower bound. * @throw std::domain_error If, after n_monte_carlo_elbo_ number of draws * from the variational distribution all give non-finite log joint * evaluations. This means that the model is severly ill conditioned or * that the variational distribution has somehow collapsed. */ double calc_ELBO(const Q& variational, callbacks::logger& logger) const { static const char* function = "stan::variational::advi::calc_ELBO"; double elbo = 0.0; int dim = variational.dimension(); Eigen::VectorXd zeta(dim); int n_dropped_evaluations = 0; for (int i = 0; i < n_monte_carlo_elbo_;) { variational.sample(rng_, zeta); try { std::stringstream ss; double log_prob = model_.template log_prob(zeta, &ss); if (ss.str().length() > 0) logger.info(ss); stan::math::check_finite(function, "log_prob", log_prob); elbo += log_prob; ++i; } catch (const std::domain_error& e) { ++n_dropped_evaluations; if (n_dropped_evaluations >= n_monte_carlo_elbo_) { const char* name = "The number of dropped evaluations"; const char* msg1 = "has reached its maximum amount ("; const char* msg2 = "). Your model may be either severely " "ill-conditioned or misspecified."; stan::math::domain_error(function, name, n_monte_carlo_elbo_, msg1, msg2); } } } elbo /= n_monte_carlo_elbo_; elbo += variational.entropy(); return elbo; } /** * Calculates the "black box" gradient of the ELBO. * * @param[in] variational variational approximation at which to evaluate * the ELBO. * @param[out] elbo_grad gradient of ELBO with respect to variational * approximation. * @param logger logger for messages */ void calc_ELBO_grad(const Q& variational, Q& elbo_grad, callbacks::logger& logger) const { static const char* function = "stan::variational::advi::calc_ELBO_grad"; stan::math::check_size_match( function, "Dimension of elbo_grad", elbo_grad.dimension(), "Dimension of variational q", variational.dimension()); stan::math::check_size_match( function, "Dimension of variational q", variational.dimension(), "Dimension of variables in model", cont_params_.size()); variational.calc_grad(elbo_grad, model_, cont_params_, n_monte_carlo_grad_, rng_, logger); } /** * Heuristic grid search to adapt eta to the scale of the problem. * * @param[in] variational initial variational distribution. * @param[in] adapt_iterations number of iterations to spend doing stochastic * gradient ascent at each proposed eta value. * @param[in,out] logger logger for messages * @return adapted (tuned) value of eta via heuristic grid search * @throw std::domain_error If either (a) the initial ELBO cannot be * computed at the initial variational distribution, (b) all step-size * proposals in eta_sequence fail. */ double adapt_eta(Q& variational, int adapt_iterations, callbacks::logger& logger) const { static const char* function = "stan::variational::advi::adapt_eta"; stan::math::check_positive(function, "Number of adaptation iterations", adapt_iterations); logger.info("Begin eta adaptation."); // Sequence of eta values to try during adaptation const int eta_sequence_size = 5; double eta_sequence[eta_sequence_size] = {100, 10, 1, 0.1, 0.01}; // Initialize ELBO tracking variables double elbo = -std::numeric_limits::max(); double elbo_best = -std::numeric_limits::max(); double elbo_init; try { elbo_init = calc_ELBO(variational, logger); } catch (const std::domain_error& e) { const char* name = "Cannot compute ELBO using the initial " "variational distribution."; const char* msg1 = "Your model may be either " "severely ill-conditioned or misspecified."; stan::math::domain_error(function, name, "", msg1); } // Variational family to store gradients Q elbo_grad = Q(model_.num_params_r()); // Adaptive step-size sequence Q history_grad_squared = Q(model_.num_params_r()); double tau = 1.0; double pre_factor = 0.9; double post_factor = 0.1; double eta_best = 0.0; double eta; double eta_scaled; bool do_more_tuning = true; int eta_sequence_index = 0; while (do_more_tuning) { // Try next eta eta = eta_sequence[eta_sequence_index]; int print_progress_m; for (int iter_tune = 1; iter_tune <= adapt_iterations; ++iter_tune) { print_progress_m = eta_sequence_index * adapt_iterations + iter_tune; variational ::print_progress(print_progress_m, 0, adapt_iterations * eta_sequence_size, adapt_iterations, true, "", "", logger); // (ROBUST) Compute gradient of ELBO. It's OK if it diverges. // We'll try a smaller eta. try { calc_ELBO_grad(variational, elbo_grad, logger); } catch (const std::domain_error& e) { elbo_grad.set_to_zero(); } // Update step-size if (iter_tune == 1) { history_grad_squared += elbo_grad.square(); } else { history_grad_squared = pre_factor * history_grad_squared + post_factor * elbo_grad.square(); } eta_scaled = eta / sqrt(static_cast(iter_tune)); // Stochastic gradient update variational += eta_scaled * elbo_grad / (tau + history_grad_squared.sqrt()); } // (ROBUST) Compute ELBO. It's OK if it has diverged. try { elbo = calc_ELBO(variational, logger); } catch (const std::domain_error& e) { elbo = -std::numeric_limits::max(); } // Check if: // (1) ELBO at current eta is worse than the best ELBO // (2) the best ELBO hasn't gotten worse than the initial ELBO if (elbo < elbo_best && elbo_best > elbo_init) { std::stringstream ss; ss << "Success!" << " Found best value [eta = " << eta_best << "]"; if (eta_sequence_index < eta_sequence_size - 1) ss << (" earlier than expected."); else ss << "."; logger.info(ss); logger.info(""); do_more_tuning = false; } else { if (eta_sequence_index < eta_sequence_size - 1) { // Reset elbo_best = elbo; eta_best = eta; } else { // No more eta values to try, so use current eta if it // didn't diverge or fail if it did diverge if (elbo > elbo_init) { std::stringstream ss; ss << "Success!" << " Found best value [eta = " << eta_best << "]."; logger.info(ss); logger.info(""); eta_best = eta; do_more_tuning = false; } else { const char* name = "All proposed step-sizes"; const char* msg1 = "failed. Your model may be either " "severely ill-conditioned or misspecified."; stan::math::domain_error(function, name, "", msg1); } } // Reset history_grad_squared.set_to_zero(); } ++eta_sequence_index; variational = Q(cont_params_); } return eta_best; } /** * Runs stochastic gradient ascent with an adaptive stepsize sequence. * * @param[in,out] variational initia variational distribution * @param[in] eta stepsize scaling parameter * @param[in] tol_rel_obj relative tolerance parameter for convergence * @param[in] max_iterations max number of iterations to run algorithm * @param[in,out] logger logger for messages * @param[in,out] diagnostic_writer writer for diagnostic information * @throw std::domain_error If the ELBO or its gradient is ever * non-finite, at any iteration */ void stochastic_gradient_ascent(Q& variational, double eta, double tol_rel_obj, int max_iterations, callbacks::logger& logger, callbacks::writer& diagnostic_writer) const { static const char* function = "stan::variational::advi::stochastic_gradient_ascent"; stan::math::check_positive(function, "Eta stepsize", eta); stan::math::check_positive( function, "Relative objective function tolerance", tol_rel_obj); stan::math::check_positive(function, "Maximum iterations", max_iterations); // Gradient parameters Q elbo_grad = Q(model_.num_params_r()); // Stepsize sequence parameters Q history_grad_squared = Q(model_.num_params_r()); double tau = 1.0; double pre_factor = 0.9; double post_factor = 0.1; double eta_scaled; // Initialize ELBO and convergence tracking variables double elbo(0.0); double elbo_best = -std::numeric_limits::max(); double elbo_prev = -std::numeric_limits::max(); double delta_elbo = std::numeric_limits::max(); double delta_elbo_ave = std::numeric_limits::max(); double delta_elbo_med = std::numeric_limits::max(); // Heuristic to estimate how far to look back in rolling window int cb_size = static_cast(std::max(0.1 * max_iterations / eval_elbo_, 2.0)); boost::circular_buffer elbo_diff(cb_size); logger.info("Begin stochastic gradient ascent."); logger.info( " iter" " ELBO" " delta_ELBO_mean" " delta_ELBO_med" " notes "); // Timing variables clock_t start = clock(); clock_t end; double delta_t; // Main loop bool do_more_iterations = true; for (int iter_counter = 1; do_more_iterations; ++iter_counter) { // Compute gradient using Monte Carlo integration calc_ELBO_grad(variational, elbo_grad, logger); // Update step-size if (iter_counter == 1) { history_grad_squared += elbo_grad.square(); } else { history_grad_squared = pre_factor * history_grad_squared + post_factor * elbo_grad.square(); } eta_scaled = eta / sqrt(static_cast(iter_counter)); // Stochastic gradient update variational += eta_scaled * elbo_grad / (tau + history_grad_squared.sqrt()); // Check for convergence every "eval_elbo_"th iteration if (iter_counter % eval_elbo_ == 0) { elbo_prev = elbo; elbo = calc_ELBO(variational, logger); if (elbo > elbo_best) elbo_best = elbo; delta_elbo = rel_difference(elbo, elbo_prev); elbo_diff.push_back(delta_elbo); delta_elbo_ave = std::accumulate(elbo_diff.begin(), elbo_diff.end(), 0.0) / static_cast(elbo_diff.size()); delta_elbo_med = circ_buff_median(elbo_diff); std::stringstream ss; ss << " " << std::setw(4) << iter_counter << " " << std::setw(15) << std::fixed << std::setprecision(3) << elbo << " " << std::setw(16) << std::fixed << std::setprecision(3) << delta_elbo_ave << " " << std::setw(15) << std::fixed << std::setprecision(3) << delta_elbo_med; end = clock(); delta_t = static_cast(end - start) / CLOCKS_PER_SEC; std::vector print_vector; print_vector.clear(); print_vector.push_back(iter_counter); print_vector.push_back(delta_t); print_vector.push_back(elbo); diagnostic_writer(print_vector); if (delta_elbo_ave < tol_rel_obj) { ss << " MEAN ELBO CONVERGED"; do_more_iterations = false; } if (delta_elbo_med < tol_rel_obj) { ss << " MEDIAN ELBO CONVERGED"; do_more_iterations = false; } if (iter_counter > 10 * eval_elbo_) { if (delta_elbo_med > 0.5 || delta_elbo_ave > 0.5) { ss << " MAY BE DIVERGING... INSPECT ELBO"; } } logger.info(ss); if (do_more_iterations == false && rel_difference(elbo, elbo_best) > 0.05) { logger.info( "Informational Message: The ELBO at a previous " "iteration is larger than the ELBO upon " "convergence!"); logger.info( "This variational approximation may not " "have converged to a good optimum."); } } if (iter_counter == max_iterations) { logger.info( "Informational Message: The maximum number of " "iterations is reached! The algorithm may not have " "converged."); logger.info( "This variational approximation is not " "guaranteed to be meaningful."); do_more_iterations = false; } } } /** * Runs ADVI and writes to output. * * @param[in] eta eta parameter of stepsize sequence * @param[in] adapt_engaged boolean flag for eta adaptation * @param[in] adapt_iterations number of iterations for eta adaptation * @param[in] tol_rel_obj relative tolerance parameter for convergence * @param[in] max_iterations max number of iterations to run algorithm * @param[in,out] logger logger for messages * @param[in,out] parameter_writer writer for parameters * (typically to file) * @param[in,out] diagnostic_writer writer for diagnostic information */ int run(double eta, bool adapt_engaged, int adapt_iterations, double tol_rel_obj, int max_iterations, callbacks::logger& logger, callbacks::writer& parameter_writer, callbacks::writer& diagnostic_writer) const { diagnostic_writer("iter,time_in_seconds,ELBO"); // Initialize variational approximation Q variational = Q(cont_params_); if (adapt_engaged) { eta = adapt_eta(variational, adapt_iterations, logger); parameter_writer("Stepsize adaptation complete."); std::stringstream ss; ss << "eta = " << eta; parameter_writer(ss.str()); } stochastic_gradient_ascent(variational, eta, tol_rel_obj, max_iterations, logger, diagnostic_writer); // Write posterior mean of variational approximations. cont_params_ = variational.mean(); std::vector cont_vector(cont_params_.size()); for (int i = 0; i < cont_params_.size(); ++i) cont_vector.at(i) = cont_params_(i); std::vector disc_vector; std::vector values; std::stringstream msg; model_.write_array(rng_, cont_vector, disc_vector, values, true, true, &msg); if (msg.str().length() > 0) logger.info(msg); // The first row of lp_, log_p, and log_g. values.insert(values.begin(), {0, 0, 0}); parameter_writer(values); // Draw more from posterior and write on subsequent lines logger.info(""); std::stringstream ss; ss << "Drawing a sample of size " << n_posterior_samples_ << " from the approximate posterior... "; logger.info(ss); double log_p = 0; double log_g = 0; // Draw posterior sample. log_g is the log normal densities. for (int n = 0; n < n_posterior_samples_; ++n) { variational.sample_log_g(rng_, cont_params_, log_g); for (int i = 0; i < cont_params_.size(); ++i) { cont_vector.at(i) = cont_params_(i); } std::stringstream msg2; model_.write_array(rng_, cont_vector, disc_vector, values, true, true, &msg2); // log_p: Log probability in the unconstrained space log_p = model_.template log_prob(cont_params_, &msg2); if (msg2.str().length() > 0) logger.info(msg2); // Write lp__, log_p, and log_g. values.insert(values.begin(), {0, log_p, log_g}); parameter_writer(values); } logger.info("COMPLETED."); return stan::services::error_codes::OK; } // TODO(akucukelbir): move these things to stan math and test there /** * Compute the median of a circular buffer. * * @param[in] cb circular buffer with some number of values in it. * @return median of values in circular buffer. */ double circ_buff_median(const boost::circular_buffer& cb) const { // FIXME: naive implementation; creates a copy as a vector std::vector v; for (boost::circular_buffer::const_iterator i = cb.begin(); i != cb.end(); ++i) { v.push_back(*i); } size_t n = v.size() / 2; std::nth_element(v.begin(), v.begin() + n, v.end()); return v[n]; } /** * Compute the relative difference between two double values. * * @param[in] prev previous value * @param[in] curr current value * @return absolutely value of relative difference */ double rel_difference(double prev, double curr) const { return std::fabs((curr - prev) / prev); } protected: Model& model_; Eigen::VectorXd& cont_params_; BaseRNG& rng_; int n_monte_carlo_grad_; int n_monte_carlo_elbo_; int eval_elbo_; int n_posterior_samples_; }; } // namespace variational } // namespace stan #endif StanHeaders/inst/include/src/stan/variational/families/0000755000176200001440000000000013766554456022736 5ustar liggesusersStanHeaders/inst/include/src/stan/variational/families/normal_meanfield.hpp0000644000176200001440000003671613766554456026760 0ustar liggesusers#ifndef STAN_VARIATIONAL_NORMAL_MEANFIELD_HPP #define STAN_VARIATIONAL_NORMAL_MEANFIELD_HPP #include #include #include #include #include #include #include namespace stan { namespace variational { /** * Variational family approximation with mean-field (diagonal * covariance) multivariate normal distribution. */ class normal_meanfield : public base_family { private: /** * Mean vector. */ Eigen::VectorXd mu_; /** * Log standard deviation (log scale) vector. */ Eigen::VectorXd omega_; /** * Dimensionality of distribution. */ const int dimension_; public: /** * Construct a variational distribution of the specified * dimensionality with a zero mean and zero log standard * deviation (unit standard deviation). * * @param[in] dimension Dimensionality of distribution. */ explicit normal_meanfield(size_t dimension) : mu_(Eigen::VectorXd::Zero(dimension)), omega_(Eigen::VectorXd::Zero(dimension)), dimension_(dimension) {} /** * Construct a variational distribution with the specified mean * vector and zero log standard deviation (unit standard * deviation). * * @param[in] cont_params Mean vector. */ explicit normal_meanfield(const Eigen::VectorXd& cont_params) : mu_(cont_params), omega_(Eigen::VectorXd::Zero(cont_params.size())), dimension_(cont_params.size()) {} /** * Construct a variational distribution with the specified mean * and log standard deviation vectors. * * @param[in] mu Mean vector. * @param[in] omega Log standard deviation vector. * @throw std::domain_error If the sizes of mean and log * standard deviation vectors are different, or if either * contains a not-a-number value. */ normal_meanfield(const Eigen::VectorXd& mu, const Eigen::VectorXd& omega) : mu_(mu), omega_(omega), dimension_(mu.size()) { static const char* function = "stan::variational::normal_meanfield"; stan::math::check_size_match(function, "Dimension of mean vector", mu_.size(), "Dimension of log std vector", omega_.size()); stan::math::check_not_nan(function, "Mean vector", mu_); stan::math::check_not_nan(function, "Log std vector", omega_); } /** * Return the dimensionality of the approximation. */ int dimension() const { return dimension_; } /** * Return the mean vector. */ const Eigen::VectorXd& mu() const { return mu_; } /** * Return the log standard deviation vector. */ const Eigen::VectorXd& omega() const { return omega_; } /** * Set the mean vector to the specified value. * * @param[in] mu Mean vector. * @throw std::domain_error If the mean vector's size does not * match this approximation's dimensionality, or if it contains * not-a-number values. */ void set_mu(const Eigen::VectorXd& mu) { static const char* function = "stan::variational::normal_meanfield::set_mu"; stan::math::check_size_match(function, "Dimension of input vector", mu.size(), "Dimension of current vector", dimension()); stan::math::check_not_nan(function, "Input vector", mu); mu_ = mu; } /** * Set the log standard deviation vector to the specified * value. * * @param[in] omega Log standard deviation vector. * @throw std::domain_error If the log standard deviation * vector's size does not match this approximation's * dimensionality, or if it contains not-a-number values. */ void set_omega(const Eigen::VectorXd& omega) { static const char* function = "stan::variational::normal_meanfield::set_omega"; stan::math::check_size_match(function, "Dimension of input vector", omega.size(), "Dimension of current vector", dimension()); stan::math::check_not_nan(function, "Input vector", omega); omega_ = omega; } /** * Sets the mean and log standard deviation vector for this * approximation to zero. */ void set_to_zero() { mu_ = Eigen::VectorXd::Zero(dimension()); omega_ = Eigen::VectorXd::Zero(dimension()); } /** * Return a new mean field approximation resulting from squaring * the entries in the mean and log standard deviation. The new * approximation does not hold any references to this * approximation. */ normal_meanfield square() const { return normal_meanfield(Eigen::VectorXd(mu_.array().square()), Eigen::VectorXd(omega_.array().square())); } /** * Return a new mean field approximation resulting from taking * the square root of the entries in the mean and log standard * deviation. The new approximation does not hold any * references to this approximation. * * Warning: No checks are carried out to ensure the * entries are non-negative before taking square roots, so * not-a-number values may result. */ normal_meanfield sqrt() const { return normal_meanfield(Eigen::VectorXd(mu_.array().sqrt()), Eigen::VectorXd(omega_.array().sqrt())); } /** * Return this approximation after setting its mean vector and * Cholesky factor for covariance to the values given by the * specified approximation. * * @param[in] rhs Approximation from which to gather the mean * and log standard deviation vectors. * @return This approximation after assignment. * @throw std::domain_error If the dimensionality of the specified * approximation does not match this approximation's dimensionality. */ normal_meanfield& operator=(const normal_meanfield& rhs) { static const char* function = "stan::variational::normal_meanfield::operator="; stan::math::check_size_match(function, "Dimension of lhs", dimension(), "Dimension of rhs", rhs.dimension()); mu_ = rhs.mu(); omega_ = rhs.omega(); return *this; } /** * Add the mean and Cholesky factor of the covariance matrix of * the specified approximation to this approximation. * * @param[in] rhs Approximation from which to gather the mean * and log standard deviation vectors. * @return This approximation after adding the specified * approximation. * @throw std::domain_error If the size of the specified * approximation does not match the size of this approximation. */ normal_meanfield& operator+=(const normal_meanfield& rhs) { static const char* function = "stan::variational::normal_meanfield::operator+="; stan::math::check_size_match(function, "Dimension of lhs", dimension(), "Dimension of rhs", rhs.dimension()); mu_ += rhs.mu(); omega_ += rhs.omega(); return *this; } /** * Return this approximation after elementwise division by the * specified approximation's mean and log standard deviation * vectors. * * @param[in] rhs Approximation from which to gather the mean * and log standard deviation vectors. * @return This approximation after elementwise division by the * specified approximation. * @throw std::domain_error If the dimensionality of the specified * approximation does not match this approximation's dimensionality. */ inline normal_meanfield& operator/=(const normal_meanfield& rhs) { static const char* function = "stan::variational::normal_meanfield::operator/="; stan::math::check_size_match(function, "Dimension of lhs", dimension(), "Dimension of rhs", rhs.dimension()); mu_.array() /= rhs.mu().array(); omega_.array() /= rhs.omega().array(); return *this; } /** * Return this approximation after adding the specified scalar * to each entry in the mean and log standard deviation vectors. * * Warning: No finiteness check is made on the scalar, so * it may introduce NaNs. * * @param[in] scalar Scalar to add. * @return This approximation after elementwise addition of the * specified scalar. */ normal_meanfield& operator+=(double scalar) { mu_.array() += scalar; omega_.array() += scalar; return *this; } /** * Return this approximation after multiplying by the specified * scalar to each entry in the mean and log standard deviation * vectors. * * Warning: No finiteness check is made on the scalar, so * it may introduce NaNs. * * @param[in] scalar Scalar to add. * @return This approximation after elementwise addition of the * specified scalar. */ normal_meanfield& operator*=(double scalar) { mu_ *= scalar; omega_ *= scalar; return *this; } /** * Returns the mean vector for this approximation. * * See: mu(). * * @return Mean vector for this approximation. */ const Eigen::VectorXd& mean() const { return mu(); } /** * Return the entropy of the approximation. * *

The entropy is defined by * 0.5 * dim * (1+log2pi) + 0.5 * log det diag(sigma^2) * = 0.5 * dim * (1+log2pi) + sum(log(sigma)) * = 0.5 * dim * (1+log2pi) + sum(omega) * * @return Entropy of this approximation. */ double entropy() const { return 0.5 * static_cast(dimension()) * (1.0 + stan::math::LOG_TWO_PI) + omega_.sum(); } /** * Return the transform of the sepcified vector using the * Cholesky factor and mean vector. * * The transform is defined by * S^{-1}(eta) = sigma * eta + mu = exp(omega) * eta + mu. * * @param[in] eta Vector to transform. * @throw std::domain_error If the specified vector's size does * not match the dimensionality of this approximation. * @return Transformed vector. */ Eigen::VectorXd transform(const Eigen::VectorXd& eta) const { static const char* function = "stan::variational::normal_meanfield::transform"; stan::math::check_size_match(function, "Dimension of mean vector", dimension(), "Dimension of input vector", eta.size()); stan::math::check_not_nan(function, "Input vector", eta); // exp(omega) * eta + mu return eta.array().cwiseProduct(omega_.array().exp()) + mu_.array(); } /** * Calculates the "blackbox" gradient with respect to both the * location vector (mu) and the log-std vector (omega) in * parallel. It uses the same gradient computed from a set of * Monte Carlo samples. * * @tparam M Model class. * @tparam BaseRNG Class of base random number generator. * @param[in] elbo_grad Parameters to store "blackbox" gradient * @param[in] m Model. * @param[in] cont_params Continuous parameters. * @param[in] n_monte_carlo_grad Number of samples for gradient * computation. * @param[in,out] rng Random number generator. * @param[in,out] logger logger for messages * @throw std::domain_error If the number of divergent * iterations exceeds its specified bounds. */ template void calc_grad(normal_meanfield& elbo_grad, M& m, Eigen::VectorXd& cont_params, int n_monte_carlo_grad, BaseRNG& rng, callbacks::logger& logger) const { static const char* function = "stan::variational::normal_meanfield::calc_grad"; stan::math::check_size_match(function, "Dimension of elbo_grad", elbo_grad.dimension(), "Dimension of variational q", dimension()); stan::math::check_size_match(function, "Dimension of variational q", dimension(), "Dimension of variables in model", cont_params.size()); Eigen::VectorXd mu_grad = Eigen::VectorXd::Zero(dimension()); Eigen::VectorXd omega_grad = Eigen::VectorXd::Zero(dimension()); double tmp_lp = 0.0; Eigen::VectorXd tmp_mu_grad = Eigen::VectorXd::Zero(dimension()); Eigen::VectorXd eta = Eigen::VectorXd::Zero(dimension()); Eigen::VectorXd zeta = Eigen::VectorXd::Zero(dimension()); // Naive Monte Carlo integration static const int n_retries = 10; for (int i = 0, n_monte_carlo_drop = 0; i < n_monte_carlo_grad;) { // Draw from standard normal and transform to real-coordinate space for (int d = 0; d < dimension(); ++d) eta(d) = stan::math::normal_rng(0, 1, rng); zeta = transform(eta); try { std::stringstream ss; stan::model::gradient(m, zeta, tmp_lp, tmp_mu_grad, &ss); if (ss.str().length() > 0) logger.info(ss); stan::math::check_finite(function, "Gradient of mu", tmp_mu_grad); mu_grad += tmp_mu_grad; omega_grad.array() += tmp_mu_grad.array().cwiseProduct(eta.array()); ++i; } catch (const std::exception& e) { ++n_monte_carlo_drop; if (n_monte_carlo_drop >= n_retries * n_monte_carlo_grad) { const char* name = "The number of dropped evaluations"; const char* msg1 = "has reached its maximum amount ("; int y = n_retries * n_monte_carlo_grad; const char* msg2 = "). Your model may be either severely " "ill-conditioned or misspecified."; stan::math::domain_error(function, name, y, msg1, msg2); } } } mu_grad /= static_cast(n_monte_carlo_grad); omega_grad /= static_cast(n_monte_carlo_grad); omega_grad.array() = omega_grad.array().cwiseProduct(omega_.array().exp()); omega_grad.array() += 1.0; // add entropy gradient (unit) elbo_grad.set_mu(mu_grad); elbo_grad.set_omega(omega_grad); } }; /** * Return a new approximation resulting from adding the mean and * log standard deviation of the specified approximations. * * @param[in] lhs First approximation. * @param[in] rhs Second approximation. * @return Sum of the specified approximations. * @throw std::domain_error If the dimensionalities do not match. */ inline normal_meanfield operator+(normal_meanfield lhs, const normal_meanfield& rhs) { return lhs += rhs; } /** * Return a new approximation resulting from elementwise division of * of the first specified approximation by the second. * * @param[in] lhs First approximation. * @param[in] rhs Second approximation. * @return Elementwise division of the specified approximations. * @throw std::domain_error If the dimensionalities do not match. */ inline normal_meanfield operator/(normal_meanfield lhs, const normal_meanfield& rhs) { return lhs /= rhs; } /** * Return a new approximation resulting from elementwise addition * of the specified scalar to the mean and log standard deviation * entries of the specified approximation. * * @param[in] scalar Scalar value * @param[in] rhs Approximation. * @return Addition of scalar to specified approximation. */ inline normal_meanfield operator+(double scalar, normal_meanfield rhs) { return rhs += scalar; } /** * Return a new approximation resulting from elementwise * multiplication of the specified scalar to the mean and log * standard deviation vectors of the specified approximation. * * @param[in] scalar Scalar value * @param[in] rhs Approximation. * @return Multiplication of scalar by the specified approximation. */ inline normal_meanfield operator*(double scalar, normal_meanfield rhs) { return rhs *= scalar; } } // namespace variational } // namespace stan #endif StanHeaders/inst/include/src/stan/variational/families/normal_fullrank.hpp0000644000176200001440000004314013766554456026637 0ustar liggesusers#ifndef STAN_VARIATIONAL_NORMAL_FULLRANK_HPP #define STAN_VARIATIONAL_NORMAL_FULLRANK_HPP #include #include #include #include #include #include #include namespace stan { namespace variational { /** * Variational family approximation with full-rank multivariate * normal distribution. */ class normal_fullrank : public base_family { private: /** * Mean vector. */ Eigen::VectorXd mu_; /** * Cholesky factor of covariance: * Sigma = L_chol * L_chol.transpose() */ Eigen::MatrixXd L_chol_; /** * Dimensionality of distribution. */ const int dimension_; /** * Raise a domain exception if the specified vector contains * not-a-number values. * * @param[in] mu Mean vector. * @throw std::domain_error If the mean vector contains NaN * values or does not match this distribution's dimensionality. */ void validate_mean(const char* function, const Eigen::VectorXd& mu) { stan::math::check_not_nan(function, "Mean vector", mu); stan::math::check_size_match(function, "Dimension of input vector", mu.size(), "Dimension of current vector", dimension()); } /** * Raise a domain exception if the specified matrix is not * square, not lower triangular, or contains not-a-number * values. * * Warning: This function does not check that the * Cholesky factor is positive definite. * * @param[in] L_chol Cholesky factor for covariance matrix. * @throw std::domain_error If the specified matrix is not * square, is not lower triangular, if its size does not match * the dimensionality of this approximation, or if it contains * not-a-number values. */ void validate_cholesky_factor(const char* function, const Eigen::MatrixXd& L_chol) { stan::math::check_square(function, "Cholesky factor", L_chol); stan::math::check_lower_triangular(function, "Cholesky factor", L_chol); stan::math::check_size_match(function, "Dimension of mean vector", dimension(), "Dimension of Cholesky factor", L_chol.rows()); stan::math::check_not_nan(function, "Cholesky factor", L_chol); } public: /** * Construct a variational distribution of the specified * dimensionality with a zero mean and Cholesky factor of a zero * covariance matrix. * * @param[in] dimension Dimensionality of distribution. */ explicit normal_fullrank(size_t dimension) : mu_(Eigen::VectorXd::Zero(dimension)), L_chol_(Eigen::MatrixXd::Zero(dimension, dimension)), dimension_(dimension) {} /** * Construct a variational distribution with specified mean vector * and Cholesky factor for identity covariance. * * @param[in] cont_params Mean vector. */ explicit normal_fullrank(const Eigen::VectorXd& cont_params) : mu_(cont_params), L_chol_( Eigen::MatrixXd::Identity(cont_params.size(), cont_params.size())), dimension_(cont_params.size()) {} /** * Construct a variational distribution with specified mean and * Cholesky factor for covariance. * * Warning: Positive-definiteness is not enforced for the * Cholesky factor. * * @param[in] mu Mean vector. * @param[in] L_chol Cholesky factor of covariance. * @throws std::domain_error If the Cholesky factor is not * square or not lower triangular, if the mean and Cholesky factor * have different dimensionality, or if any of the elements is * not-a-number. */ normal_fullrank(const Eigen::VectorXd& mu, const Eigen::MatrixXd& L_chol) : mu_(mu), L_chol_(L_chol), dimension_(mu.size()) { static const char* function = "stan::variational::normal_fullrank"; validate_mean(function, mu); validate_cholesky_factor(function, L_chol); } /** * Return the dimensionality of the approximation. */ int dimension() const { return dimension_; } /** * Return the mean vector. */ const Eigen::VectorXd& mu() const { return mu_; } /** * Return the Cholesky factor of the covariance matrix. */ const Eigen::MatrixXd& L_chol() const { return L_chol_; } /** * Set the mean vector to the specified value. * * @param[in] mu Mean vector. * @throw std::domain_error If the size of the specified mean * vector does not match the stored dimension of this approximation. */ void set_mu(const Eigen::VectorXd& mu) { static const char* function = "stan::variational::set_mu"; validate_mean(function, mu); mu_ = mu; } /** * Set the Cholesky factor to the specified value. * * @param[in] L_chol Cholesky factor of covariance matrix. * @throw std::domain_error If the specified matrix is not * square, is not lower triangular, if its size does not match * the dimensionality of this approximation, or if it contains * not-a-number values. */ void set_L_chol(const Eigen::MatrixXd& L_chol) { static const char* function = "stan::variational::set_L_chol"; validate_cholesky_factor(function, L_chol); L_chol_ = L_chol; } /** * Set the mean vector and Cholesky factor for the covariance * matrix to zero. */ void set_to_zero() { mu_ = Eigen::VectorXd::Zero(dimension()); L_chol_ = Eigen::MatrixXd::Zero(dimension(), dimension()); } /** * Return a new full rank approximation resulting from squaring * the entries in the mean and Cholesky factor for the * covariance matrix. The new approximation does not hold * any references to this approximation. */ normal_fullrank square() const { return normal_fullrank(Eigen::VectorXd(mu_.array().square()), Eigen::MatrixXd(L_chol_.array().square())); } /** * Return a new full rank approximation resulting from taking * the square root of the entries in the mean and Cholesky * factor for the covariance matrix. The new approximation does * not hold any references to this approximation. * * Warning: No checks are carried out to ensure the * entries are non-negative before taking square roots, so * not-a-number values may result. */ normal_fullrank sqrt() const { return normal_fullrank(Eigen::VectorXd(mu_.array().sqrt()), Eigen::MatrixXd(L_chol_.array().sqrt())); } /** * Return this approximation after setting its mean vector and * Cholesky factor for covariance to the values given by the * specified approximation. * * @param[in] rhs Approximation from which to gather the mean and * covariance. * @return This approximation after assignment. * @throw std::domain_error If the dimensionality of the specified * approximation does not match this approximation's dimensionality. */ normal_fullrank& operator=(const normal_fullrank& rhs) { static const char* function = "stan::variational::normal_fullrank::operator="; stan::math::check_size_match(function, "Dimension of lhs", dimension(), "Dimension of rhs", rhs.dimension()); mu_ = rhs.mu(); L_chol_ = rhs.L_chol(); return *this; } /** * Add the mean and Cholesky factor of the covariance matrix of * the specified approximation to this approximation. * * @param[in] rhs Approximation from which to gather the mean and * covariance. * @return This approximation after adding the specified * approximation. * @throw std::domain_error If the dimensionality of the specified * approximation does not match this approximation's dimensionality. */ normal_fullrank& operator+=(const normal_fullrank& rhs) { static const char* function = "stan::variational::normal_fullrank::operator+="; stan::math::check_size_match(function, "Dimension of lhs", dimension(), "Dimension of rhs", rhs.dimension()); mu_ += rhs.mu(); L_chol_ += rhs.L_chol(); return *this; } /** * Return this approximation after elementwise division by the * specified approximation's mean and Cholesky factor for * covariance. * * @param[in] rhs Approximation from which to gather the mean and * covariance. * @return This approximation after elementwise division by the * specified approximation. * @throw std::domain_error If the dimensionality of the specified * approximation does not match this approximation's dimensionality. */ inline normal_fullrank& operator/=(const normal_fullrank& rhs) { static const char* function = "stan::variational::normal_fullrank::operator/="; stan::math::check_size_match(function, "Dimension of lhs", dimension(), "Dimension of rhs", rhs.dimension()); mu_.array() /= rhs.mu().array(); L_chol_.array() /= rhs.L_chol().array(); return *this; } /** * Return this approximation after adding the specified scalar * to each entry in the mean and cholesky factor for covariance. * * Warning: No finiteness check is made on the scalar, so * it may introduce NaNs. * * @param[in] scalar Scalar to add. * @return This approximation after elementwise addition of the * specified scalar. */ normal_fullrank& operator+=(double scalar) { mu_.array() += scalar; L_chol_.array() += scalar; return *this; } /** * Return this approximation after multiplying by the specified * scalar to each entry in the mean and cholesky factor for * covariance. * * Warning: No finiteness check is made on the scalar, so * it may introduce NaNs. * * @param[in] scalar Scalar to add. * @return This approximation after elementwise addition of the * specified scalar. */ normal_fullrank& operator*=(double scalar) { mu_ *= scalar; L_chol_ *= scalar; return *this; } /** * Returns the mean vector for this approximation. * * See: mu(). * * @return Mean vector for this approximation. */ const Eigen::VectorXd& mean() const { return mu(); } /** * Return the entropy of this approximation. * *

The entropy is defined by * 0.5 * dim * (1+log2pi) + 0.5 * log det (L^T L) * = 0.5 * dim * (1+log2pi) + sum(log(abs(diag(L)))). * * @return Entropy of this approximation */ double entropy() const { static double mult = 0.5 * (1.0 + stan::math::LOG_TWO_PI); double result = mult * dimension(); for (int d = 0; d < dimension(); ++d) { double tmp = fabs(L_chol_(d, d)); if (tmp != 0.0) result += log(tmp); } return result; } /** * Return the transform of the sepcified vector using the * Cholesky factor and mean vector. * * The transform is defined by * S^{-1}(eta) = L_chol * eta + mu. * * @param[in] eta Vector to transform. * @throw std::domain_error If the specified vector's size does * not match the dimensionality of this approximation. * @return Transformed vector. */ Eigen::VectorXd transform(const Eigen::VectorXd& eta) const { static const char* function = "stan::variational::normal_fullrank::transform"; stan::math::check_size_match(function, "Dimension of input vector", eta.size(), "Dimension of mean vector", dimension()); stan::math::check_not_nan(function, "Input vector", eta); return (L_chol_ * eta) + mu_; } template void sample(BaseRNG& rng, Eigen::VectorXd& eta) const { // Draw from standard normal and transform to real-coordinate space for (int d = 0; d < dimension(); ++d) eta(d) = stan::math::normal_rng(0, 1, rng); eta = transform(eta); } template void sample_log_g(BaseRNG& rng, Eigen::VectorXd& eta, double& log_g) const { // Draw from the approximation for (int d = 0; d < dimension(); ++d) { eta(d) = stan::math::normal_rng(0, 1, rng); } // Compute the log density before transformation log_g = calc_log_g(eta); // Transform to real-coordinate space eta = transform(eta); } double calc_log_g(const Eigen::VectorXd& eta) const { // Compute the log density wrt normal distribution dropping constants double log_g = 0; for (int d = 0; d < dimension(); ++d) { log_g += -stan::math::square(eta(d)) * 0.5; } return log_g; } /** * Calculates the "blackbox" gradient with respect to BOTH the * location vector (mu) and the cholesky factor of the scale * matrix (L_chol) in parallel. It uses the same gradient * computed from a set of Monte Carlo samples * * @tparam M Model class. * @tparam BaseRNG Class of base random number generator. * @param[in] elbo_grad Approximation to store "blackbox" gradient. * @param[in] m Model. * @param[in] cont_params Continuous parameters. * @param[in] n_monte_carlo_grad Sample size for gradient computation. * @param[in,out] rng Random number generator. * @param[in,out] logger logger for messages * @throw std::domain_error If the number of divergent * iterations exceeds its specified bounds. */ template void calc_grad(normal_fullrank& elbo_grad, M& m, Eigen::VectorXd& cont_params, int n_monte_carlo_grad, BaseRNG& rng, callbacks::logger& logger) const { static const char* function = "stan::variational::normal_fullrank::calc_grad"; stan::math::check_size_match(function, "Dimension of elbo_grad", elbo_grad.dimension(), "Dimension of variational q", dimension()); stan::math::check_size_match(function, "Dimension of variational q", dimension(), "Dimension of variables in model", cont_params.size()); Eigen::VectorXd mu_grad = Eigen::VectorXd::Zero(dimension()); Eigen::MatrixXd L_grad = Eigen::MatrixXd::Zero(dimension(), dimension()); double tmp_lp = 0.0; Eigen::VectorXd tmp_mu_grad = Eigen::VectorXd::Zero(dimension()); Eigen::VectorXd eta = Eigen::VectorXd::Zero(dimension()); Eigen::VectorXd zeta = Eigen::VectorXd::Zero(dimension()); // Naive Monte Carlo integration static const int n_retries = 10; for (int i = 0, n_monte_carlo_drop = 0; i < n_monte_carlo_grad;) { // Draw from standard normal and transform to real-coordinate space for (int d = 0; d < dimension(); ++d) { eta(d) = stan::math::normal_rng(0, 1, rng); } zeta = transform(eta); try { std::stringstream ss; stan::model::gradient(m, zeta, tmp_lp, tmp_mu_grad, &ss); if (ss.str().length() > 0) logger.info(ss); stan::math::check_finite(function, "Gradient of mu", tmp_mu_grad); mu_grad += tmp_mu_grad; for (int ii = 0; ii < dimension(); ++ii) { for (int jj = 0; jj <= ii; ++jj) { L_grad(ii, jj) += tmp_mu_grad(ii) * eta(jj); } } ++i; } catch (const std::exception& e) { ++n_monte_carlo_drop; if (n_monte_carlo_drop >= n_retries * n_monte_carlo_grad) { const char* name = "The number of dropped evaluations"; const char* msg1 = "has reached its maximum amount ("; int y = n_retries * n_monte_carlo_grad; const char* msg2 = "). Your model may be either severely " "ill-conditioned or misspecified."; stan::math::domain_error(function, name, y, msg1, msg2); } } } mu_grad /= static_cast(n_monte_carlo_grad); L_grad /= static_cast(n_monte_carlo_grad); // Add gradient of entropy term L_grad.diagonal().array() += L_chol_.diagonal().array().inverse(); elbo_grad.set_mu(mu_grad); elbo_grad.set_L_chol(L_grad); } }; /** * Return a new approximation resulting from adding the mean and * covariance matrix Cholesky factor of the specified * approximations. * * @param[in] lhs First approximation. * @param[in] rhs Second approximation. * @return Sum of the specified approximations. * @throw std::domain_error If the dimensionalities do not match. */ inline normal_fullrank operator+(normal_fullrank lhs, const normal_fullrank& rhs) { return lhs += rhs; } /** * Return a new approximation resulting from elementwise division of * of the first specified approximation by the second. * * @param[in] lhs First approximation. * @param[in] rhs Second approximation. * @return Elementwise division of the specified approximations. * @throw std::domain_error If the dimensionalities do not match. */ inline normal_fullrank operator/(normal_fullrank lhs, const normal_fullrank& rhs) { return lhs /= rhs; } /** * Return a new approximation resulting from elementwise addition * of the specified scalar to the mean and Cholesky factor of * covariance entries for the specified approximation. * * @param[in] scalar Scalar value * @param[in] rhs Approximation. * @return Addition of scalar to specified approximation. */ inline normal_fullrank operator+(double scalar, normal_fullrank rhs) { return rhs += scalar; } /** * Return a new approximation resulting from elementwise * multiplication of the specified scalar to the mean and Cholesky * factor of covariance entries for the specified approximation. * * @param[in] scalar Scalar value * @param[in] rhs Approximation. * @return Multiplication of scalar by the specified approximation. */ inline normal_fullrank operator*(double scalar, normal_fullrank rhs) { return rhs *= scalar; } } // namespace variational } // namespace stan #endif StanHeaders/inst/include/src/stan/variational/print_progress.hpp0000644000176200001440000000355513766554456024746 0ustar liggesusers#ifndef STAN_VARIATIONAL_PRINT_PROGRESS_HPP #define STAN_VARIATIONAL_PRINT_PROGRESS_HPP #include #include #include #include #include #include #include namespace stan { namespace variational { /** * Helper function for printing progress for variational inference * * @param[in] m total number of iterations * @param[in] start starting iteration * @param[in] finish final iteration * @param[in] refresh how frequently we want to print an update * @param[in] tune boolean indicates tuning vs. variational inference * @param[in] prefix prefix string * @param[in] suffix suffix string * @param[in,out] logger logger */ inline void print_progress(int m, int start, int finish, int refresh, bool tune, const std::string& prefix, const std::string& suffix, callbacks::logger& logger) { static const char* function = "stan::variational::print_progress"; stan::math::check_positive(function, "Total number of iterations", m); stan::math::check_nonnegative(function, "Starting iteration", start); stan::math::check_positive(function, "Final iteration", finish); stan::math::check_positive(function, "Refresh rate", refresh); int it_print_width = std::ceil(std::log10(static_cast(finish))); if (refresh > 0 && (start + m == finish || m - 1 == 0 || m % refresh == 0)) { std::stringstream ss; ss << prefix; ss << "Iteration: "; ss << std::setw(it_print_width) << m + start << " / " << finish; ss << " [" << std::setw(3) << (100 * (start + m)) / finish << "%] "; ss << (tune ? " (Adaptation)" : " (Variational Inference)"); ss << suffix; logger.info(ss); } } } // namespace variational } // namespace stan #endif StanHeaders/inst/include/src/stan/services/0000755000176200001440000000000013766554456020457 5ustar liggesusersStanHeaders/inst/include/src/stan/services/error_codes.hpp0000644000176200001440000000066413766554456023504 0ustar liggesusers#ifndef STAN_SERVICES_ERROR_CODES_HPP #define STAN_SERVICES_ERROR_CODES_HPP namespace stan { namespace services { struct error_codes { // defining error codes to follow FreeBSD sysexits conventions // http://www.gsp.com/cgi-bin/man.cgi?section=3&topic=sysexits enum { OK = 0, USAGE = 64, DATAERR = 65, NOINPUT = 66, SOFTWARE = 70, CONFIG = 78 }; }; } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/optimize/0000755000176200001440000000000013766554456022317 5ustar liggesusersStanHeaders/inst/include/src/stan/services/optimize/newton.hpp0000644000176200001440000001026113766554456024342 0ustar liggesusers#ifndef STAN_SERVICES_OPTIMIZE_NEWTON_HPP #define STAN_SERVICES_OPTIMIZE_NEWTON_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace optimize { /** * Runs the Newton algorithm for a model. * * @tparam Model A model implementation * @param[in] model the Stan model instantiated with data * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_iterations maximum number of iterations * @param[in] save_iterations indicates whether all the interations should * be saved * @param[in,out] interrupt callback to be called every iteration * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] parameter_writer output for parameter values * @return error_codes::OK if successful */ template int newton(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_iterations, bool save_iterations, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& parameter_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, false, logger, init_writer); double lp(0); try { std::stringstream message; lp = model.template log_prob(cont_vector, disc_vector, &message); logger.info(message); } catch (const std::exception& e) { logger.info(""); logger.info( "Informational Message: The current Metropolis" " proposal is about to be rejected because of" " the following issue:"); logger.info(e.what()); logger.info( "If this warning occurs sporadically, such as" " for highly constrained variable types like" " covariance matrices, then the sampler is fine,"); logger.info( "but if this warning occurs often then your model" " may be either severely ill-conditioned or" " misspecified."); lp = -std::numeric_limits::infinity(); } std::stringstream msg; msg << "Initial log joint probability = " << lp; logger.info(msg); std::vector names; names.push_back("lp__"); model.constrained_param_names(names, true, true); parameter_writer(names); double lastlp = lp; for (int m = 0; m < num_iterations; m++) { if (save_iterations) { std::vector values; std::stringstream ss; model.write_array(rng, cont_vector, disc_vector, values, true, true, &ss); if (ss.str().length() > 0) logger.info(ss); values.insert(values.begin(), lp); parameter_writer(values); } interrupt(); lastlp = lp; lp = stan::optimization::newton_step(model, cont_vector, disc_vector); std::stringstream msg2; msg2 << "Iteration " << std::setw(2) << (m + 1) << "." << " Log joint probability = " << std::setw(10) << lp << ". Improved by " << (lp - lastlp) << "."; logger.info(msg2); if (std::fabs(lp - lastlp) <= 1e-8) break; } { std::vector values; std::stringstream ss; model.write_array(rng, cont_vector, disc_vector, values, true, true, &ss); if (ss.str().length() > 0) logger.info(ss); values.insert(values.begin(), lp); parameter_writer(values); } return error_codes::OK; } } // namespace optimize } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/optimize/defaults.hpp0000644000176200001440000001600713766554456024643 0ustar liggesusers#ifndef STAN_SERVICES_OPTIMIZE_DEFAULTS_HPP #define STAN_SERVICES_OPTIMIZE_DEFAULTS_HPP #include #include namespace stan { namespace services { namespace optimize { /** * Line search step size for first iteration. */ struct init_alpha { /** * Return the string description of init_alpha. * * @return description */ static std::string description() { return "Line search step size for first iteration."; } /** * Validates init_alpha; init_alpha must be greater than 0. * * @param[in] init_alpha argument to validate * @throw std::invalid_argument unless init_alpha is greater than zero */ static void validate(double init_alpha) { if (!(init_alpha > 0)) throw std::invalid_argument("init_alpha must be greater than 0."); } /** * Return the default init_alpha value. * * @return 0.001 */ static double default_value() { return 0.001; } }; /** * Convergence tolerance on absolute changes in objective function value. */ struct tol_obj { /** * Return the string description of tol_obj. * * @return description */ static std::string description() { return "Convergence tolerance on absolute changes in objective" " function value."; } /** * Validates tol_obj; tol_obj must be greater than or equal to 0. * * @param[in] tol_obj argument to validate * @throw std::invalid_argument unless tol_obj is greater than or equal * to zero */ static void validate(double tol_obj) { if (!(tol_obj >= 0)) throw std::invalid_argument( "tol_obj must be greater" " than or equal to 0."); } /** * Return the default tol_obj value. * * @return 1e-12 */ static double default_value() { return 1e-12; } }; /** * Convergence tolerance on relative changes in objective function value. */ struct tol_rel_obj { /** * Return the string description of tol_rel_obj. * * @return description */ static std::string description() { return "Convergence tolerance on relative changes in" " objective function value."; } /** * Validates tol_rel_obj; tol_rel_obj must be greater than or equal * to 0. * * @param[in] tol_rel_obj argument to validate * @throw std::invalid_argument unless tol_rel_obj is greater than or * equal to zero */ static void validate(double tol_rel_obj) { if (!(tol_rel_obj >= 0)) throw std::invalid_argument( "tol_rel_obj must be greater" " than or equal to 0"); } /** * Return the default tol_rel_obj value. * * @return 10000 */ static double default_value() { return 10000; } }; /** * Convergence tolerance on the norm of the gradient. */ struct tol_grad { /** * Return the string description of tol_grad. * * @return description */ static std::string description() { return "Convergence tolerance on the norm of the gradient."; } /** * Validates tol_grad; tol_grad must be greater than or equal to 0. * * @param[in] tol_grad argument to validate * @throw std::invalid_argument unless tol_grad is greater than or * equal to zero */ static void validate(double tol_grad) { if (!(tol_grad >= 0)) throw std::invalid_argument( "tol_grad must be greater" " than or equal to 0"); } /** * Return the default tol_grad value. * * @return 1e-8 */ static double default_value() { return 1e-8; } }; /** * Convergence tolerance on the relative norm of the gradient. */ struct tol_rel_grad { /** * Return the string description of tol_rel_grad. * * @return description */ static std::string description() { return "Convergence tolerance on the relative norm of the gradient."; } /** * Validates tol_rel_grad; tol_rel_grad must be greater than * or equal to 0. * * @param[in] tol_rel_grad argument to validate * @throw std::invalid_argument unless tol_rel_grad is greater than or * equal to zero */ static void validate(double tol_rel_grad) { if (!(tol_rel_grad >= 0)) throw std::invalid_argument( "tol_rel_grad must be greater" " than or equal to 0."); } /** * Return the default tol_rel_grad value. * * @return 10000000 */ static double default_value() { return 10000000; } }; /** * Convergence tolerance on changes in parameter value. */ struct tol_param { /** * Return the string description of tol_param. * * @return description */ static std::string description() { return "Convergence tolerance on changes in parameter value."; } /** * Validates tol_param; tol_param must be greater than or equal to 0. * * @param[in] tol_param argument to validate * @throw std::invalid_argument unless tol_param is greater than or * equal to zero */ static void validate(double tol_param) { if (!(tol_param >= 0)) throw std::invalid_argument("tol_param"); } /** * Return the default tol_param. * * @return 1e-08 */ static double default_value() { return 1e-08; } }; /** * Amount of history to keep for L-BFGS. */ struct history_size { /** * Return the string description of history_size. * * @return description */ static std::string description() { return "Amount of history to keep for L-BFGS."; } /** * Validates history_size; history_size must be greater than 0. * * @param[in] history_size argument to validate * @throw std::invalid_argument unless history_size is greater than * zero */ static void validate(int history_size) { if (!(history_size > 0)) throw std::invalid_argument("history_size must be greater than 0."); } /** * Return the default history_size value. * * @return 5 */ static int default_value() { return 5; } }; /** * Total number of iterations. */ struct iter { /** * Return the string description of iter. * * @return description */ static std::string description() { return "Total number of iterations."; } /** * Validates iter; iter must be greater than 0. * * @param[in] iter argument to validate * @throw std::invalid_argument unless iter is greater than zero */ static void validate(int iter) { if (!(iter > 0)) throw std::invalid_argument("iter must be greater than 0."); } /** * Return the default iter value. * * @return 2000 */ static int default_value() { return 2000; } }; /** * Save optimization interations to output. */ struct save_iterations { /** * Return the string description of save_iterations. * * @return description */ static std::string description() { return "Save optimization interations to output."; } /** * Validates save_iterations. This is a no-op. * * @param[in] save_iterations argument to validate */ static void validate(bool save_iterations) {} /** * Return the default save_iterations value. * * @return false */ static bool default_value() { return false; } }; } // namespace optimize } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/optimize/lbfgs.hpp0000644000176200001440000001450713766554456024134 0ustar liggesusers#ifndef STAN_SERVICES_OPTIMIZE_LBFGS_HPP #define STAN_SERVICES_OPTIMIZE_LBFGS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace optimize { /** * Runs the L-BFGS algorithm for a model. * * @tparam Model A model implementation * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] history_size amount of history to keep for L-BFGS * @param[in] init_alpha line search step size for first iteration * @param[in] tol_obj convergence tolerance on absolute changes in * objective function value * @param[in] tol_rel_obj convergence tolerance on relative changes * in objective function value * @param[in] tol_grad convergence tolerance on the norm of the gradient * @param[in] tol_rel_grad convergence tolerance on the relative norm of * the gradient * @param[in] tol_param convergence tolerance on changes in parameter * value * @param[in] num_iterations maximum number of iterations * @param[in] save_iterations indicates whether all the interations should * be saved to the parameter_writer * @param[in] refresh how often to write output to logger * @param[in,out] interrupt callback to be called every iteration * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] parameter_writer output for parameter values * @return error_codes::OK if successful */ template int lbfgs(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int history_size, double init_alpha, double tol_obj, double tol_rel_obj, double tol_grad, double tol_rel_grad, double tol_param, int num_iterations, bool save_iterations, int refresh, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& parameter_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, false, logger, init_writer); std::stringstream lbfgs_ss; typedef stan::optimization::BFGSLineSearch > Optimizer; Optimizer lbfgs(model, cont_vector, disc_vector, &lbfgs_ss); lbfgs.get_qnupdate().set_history_size(history_size); lbfgs._ls_opts.alpha0 = init_alpha; lbfgs._conv_opts.tolAbsF = tol_obj; lbfgs._conv_opts.tolRelF = tol_rel_obj; lbfgs._conv_opts.tolAbsGrad = tol_grad; lbfgs._conv_opts.tolRelGrad = tol_rel_grad; lbfgs._conv_opts.tolAbsX = tol_param; lbfgs._conv_opts.maxIts = num_iterations; double lp = lbfgs.logp(); std::stringstream initial_msg; initial_msg << "Initial log joint probability = " << lp; logger.info(initial_msg); std::vector names; names.push_back("lp__"); model.constrained_param_names(names, true, true); parameter_writer(names); if (save_iterations) { std::vector values; std::stringstream msg; model.write_array(rng, cont_vector, disc_vector, values, true, true, &msg); if (msg.str().length() > 0) logger.info(msg); values.insert(values.begin(), lp); parameter_writer(values); } int ret = 0; while (ret == 0) { interrupt(); if (refresh > 0 && (lbfgs.iter_num() == 0 || ((lbfgs.iter_num() + 1) % refresh == 0))) logger.info( " Iter" " log prob" " ||dx||" " ||grad||" " alpha" " alpha0" " # evals" " Notes "); ret = lbfgs.step(); lp = lbfgs.logp(); lbfgs.params_r(cont_vector); if (refresh > 0 && (ret != 0 || !lbfgs.note().empty() || lbfgs.iter_num() == 0 || ((lbfgs.iter_num() + 1) % refresh == 0))) { std::stringstream msg; msg << " " << std::setw(7) << lbfgs.iter_num() << " "; msg << " " << std::setw(12) << std::setprecision(6) << lp << " "; msg << " " << std::setw(12) << std::setprecision(6) << lbfgs.prev_step_size() << " "; msg << " " << std::setw(12) << std::setprecision(6) << lbfgs.curr_g().norm() << " "; msg << " " << std::setw(10) << std::setprecision(4) << lbfgs.alpha() << " "; msg << " " << std::setw(10) << std::setprecision(4) << lbfgs.alpha0() << " "; msg << " " << std::setw(7) << lbfgs.grad_evals() << " "; msg << " " << lbfgs.note() << " "; logger.info(msg); } if (lbfgs_ss.str().length() > 0) { logger.info(lbfgs_ss); lbfgs_ss.str(""); } if (save_iterations) { std::vector values; std::stringstream msg; model.write_array(rng, cont_vector, disc_vector, values, true, true, &msg); if (msg.str().length() > 0) logger.info(msg); values.insert(values.begin(), lp); parameter_writer(values); } } if (!save_iterations) { std::vector values; std::stringstream msg; model.write_array(rng, cont_vector, disc_vector, values, true, true, &msg); if (msg.str().length() > 0) logger.info(msg); values.insert(values.begin(), lp); parameter_writer(values); } int return_code; if (ret >= 0) { logger.info("Optimization terminated normally: "); return_code = error_codes::OK; } else { logger.info("Optimization terminated with error: "); return_code = error_codes::SOFTWARE; } logger.info(" " + lbfgs.get_code_string(ret)); return return_code; } } // namespace optimize } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/optimize/bfgs.hpp0000644000176200001440000001425613766554456023761 0ustar liggesusers#ifndef STAN_SERVICES_OPTIMIZE_BFGS_HPP #define STAN_SERVICES_OPTIMIZE_BFGS_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace optimize { /** * Runs the BFGS algorithm for a model. * * @tparam Model A model implementation * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] init_alpha line search step size for first iteration * @param[in] tol_obj convergence tolerance on absolute changes in * objective function value * @param[in] tol_rel_obj convergence tolerance on relative changes * in objective function value * @param[in] tol_grad convergence tolerance on the norm of the gradient * @param[in] tol_rel_grad convergence tolerance on the relative norm of * the gradient * @param[in] tol_param convergence tolerance on changes in parameter * value * @param[in] num_iterations maximum number of iterations * @param[in] save_iterations indicates whether all the interations should * be saved to the parameter_writer * @param[in] refresh how often to write output to logger * @param[in,out] interrupt callback to be called every iteration * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] parameter_writer output for parameter values * @return error_codes::OK if successful */ template int bfgs(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, double init_alpha, double tol_obj, double tol_rel_obj, double tol_grad, double tol_rel_grad, double tol_param, int num_iterations, bool save_iterations, int refresh, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& parameter_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, false, logger, init_writer); std::stringstream bfgs_ss; typedef stan::optimization::BFGSLineSearch< Model, stan::optimization::BFGSUpdate_HInv<> > Optimizer; Optimizer bfgs(model, cont_vector, disc_vector, &bfgs_ss); bfgs._ls_opts.alpha0 = init_alpha; bfgs._conv_opts.tolAbsF = tol_obj; bfgs._conv_opts.tolRelF = tol_rel_obj; bfgs._conv_opts.tolAbsGrad = tol_grad; bfgs._conv_opts.tolRelGrad = tol_rel_grad; bfgs._conv_opts.tolAbsX = tol_param; bfgs._conv_opts.maxIts = num_iterations; double lp = bfgs.logp(); std::stringstream initial_msg; initial_msg << "Initial log joint probability = " << lp; logger.info(initial_msg); std::vector names; names.push_back("lp__"); model.constrained_param_names(names, true, true); parameter_writer(names); if (save_iterations) { std::vector values; std::stringstream msg; model.write_array(rng, cont_vector, disc_vector, values, true, true, &msg); if (msg.str().length() > 0) logger.info(msg); values.insert(values.begin(), lp); parameter_writer(values); } int ret = 0; while (ret == 0) { interrupt(); if (refresh > 0 && (bfgs.iter_num() == 0 || ((bfgs.iter_num() + 1) % refresh == 0))) logger.info( " Iter" " log prob" " ||dx||" " ||grad||" " alpha" " alpha0" " # evals" " Notes "); ret = bfgs.step(); lp = bfgs.logp(); bfgs.params_r(cont_vector); if (refresh > 0 && (ret != 0 || !bfgs.note().empty() || bfgs.iter_num() == 0 || ((bfgs.iter_num() + 1) % refresh == 0))) { std::stringstream msg; msg << " " << std::setw(7) << bfgs.iter_num() << " "; msg << " " << std::setw(12) << std::setprecision(6) << lp << " "; msg << " " << std::setw(12) << std::setprecision(6) << bfgs.prev_step_size() << " "; msg << " " << std::setw(12) << std::setprecision(6) << bfgs.curr_g().norm() << " "; msg << " " << std::setw(10) << std::setprecision(4) << bfgs.alpha() << " "; msg << " " << std::setw(10) << std::setprecision(4) << bfgs.alpha0() << " "; msg << " " << std::setw(7) << bfgs.grad_evals() << " "; msg << " " << bfgs.note() << " "; logger.info(msg); } if (bfgs_ss.str().length() > 0) { logger.info(bfgs_ss); bfgs_ss.str(""); } if (save_iterations) { std::vector values; std::stringstream msg; model.write_array(rng, cont_vector, disc_vector, values, true, true, &msg); // This if is here to match the pre-refactor behavior if (msg.str().length() > 0) logger.info(msg); values.insert(values.begin(), lp); parameter_writer(values); } } if (!save_iterations) { std::vector values; std::stringstream msg; model.write_array(rng, cont_vector, disc_vector, values, true, true, &msg); if (msg.str().length() > 0) logger.info(msg); values.insert(values.begin(), lp); parameter_writer(values); } int return_code; if (ret >= 0) { logger.info("Optimization terminated normally: "); return_code = error_codes::OK; } else { logger.info("Optimization terminated with error: "); return_code = error_codes::SOFTWARE; } logger.info(" " + bfgs.get_code_string(ret)); return return_code; } } // namespace optimize } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/experimental/0000755000176200001440000000000013766554456023154 5ustar liggesusersStanHeaders/inst/include/src/stan/services/experimental/advi/0000755000176200001440000000000013766554456024077 5ustar liggesusersStanHeaders/inst/include/src/stan/services/experimental/advi/fullrank.hpp0000644000176200001440000000703713766554456026435 0ustar liggesusers#ifndef STAN_SERVICES_EXPERIMENTAL_ADVI_FULLRANK_HPP #define STAN_SERVICES_EXPERIMENTAL_ADVI_FULLRANK_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace experimental { namespace advi { /** * Runs full rank ADVI. * * @tparam Model A model implementation * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the random number generator * @param[in] init_radius radius to initialize * @param[in] grad_samples number of samples for Monte Carlo estimate * of gradients * @param[in] elbo_samples number of samples for Monte Carlo estimate * of ELBO * @param[in] max_iterations maximum number of iterations * @param[in] tol_rel_obj convergence tolerance on the relative norm of * the objective * @param[in] eta stepsize scaling parameter for variational inference * @param[in] adapt_engaged adaptation engaged? * @param[in] adapt_iterations number of iterations for eta adaptation * @param[in] eval_elbo evaluate ELBO every Nth iteration * @param[in] output_samples number of posterior samples to draw and * save * @param[in,out] interrupt callback to be called every iteration * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] parameter_writer output for parameter values * @param[in,out] diagnostic_writer output for diagnostic values * @return error_codes::OK if successful */ template int fullrank(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int grad_samples, int elbo_samples, int max_iterations, double tol_rel_obj, double eta, bool adapt_engaged, int adapt_iterations, int eval_elbo, int output_samples, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& parameter_writer, callbacks::writer& diagnostic_writer) { util::experimental_message(logger); boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); std::vector names; names.push_back("lp__"); names.push_back("log_p__"); names.push_back("log_g__"); model.constrained_param_names(names, true, true); parameter_writer(names); Eigen::VectorXd cont_params = Eigen::Map(&cont_vector[0], cont_vector.size(), 1); stan::variational::advi cmd_advi(model, cont_params, rng, grad_samples, elbo_samples, eval_elbo, output_samples); cmd_advi.run(eta, adapt_engaged, adapt_iterations, tol_rel_obj, max_iterations, logger, parameter_writer, diagnostic_writer); return 0; } } // namespace advi } // namespace experimental } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/experimental/advi/meanfield.hpp0000644000176200001440000000705413766554456026542 0ustar liggesusers#ifndef STAN_SERVICES_EXPERIMENTAL_ADVI_MEANFIELD_HPP #define STAN_SERVICES_EXPERIMENTAL_ADVI_MEANFIELD_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace experimental { namespace advi { /** * Runs mean field ADVI. * * @tparam Model A model implementation * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the random number generator * @param[in] init_radius radius to initialize * @param[in] grad_samples number of samples for Monte Carlo estimate * of gradients * @param[in] elbo_samples number of samples for Monte Carlo estimate * of ELBO * @param[in] max_iterations maximum number of iterations * @param[in] tol_rel_obj convergence tolerance on the relative norm * of the objective * @param[in] eta stepsize scaling parameter for variational inference * @param[in] adapt_engaged adaptation engaged? * @param[in] adapt_iterations number of iterations for eta adaptation * @param[in] eval_elbo evaluate ELBO every Nth iteration * @param[in] output_samples number of posterior samples to draw and * save * @param[in,out] interrupt callback to be called every iteration * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] parameter_writer output for parameter values * @param[in,out] diagnostic_writer output for diagnostic values * @return error_codes::OK if successful */ template int meanfield(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int grad_samples, int elbo_samples, int max_iterations, double tol_rel_obj, double eta, bool adapt_engaged, int adapt_iterations, int eval_elbo, int output_samples, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& parameter_writer, callbacks::writer& diagnostic_writer) { util::experimental_message(logger); boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); std::vector names; names.push_back("lp__"); names.push_back("log_p__"); names.push_back("log_g__"); model.constrained_param_names(names, true, true); parameter_writer(names); Eigen::VectorXd cont_params = Eigen::Map(&cont_vector[0], cont_vector.size(), 1); stan::variational::advi cmd_advi(model, cont_params, rng, grad_samples, elbo_samples, eval_elbo, output_samples); cmd_advi.run(eta, adapt_engaged, adapt_iterations, tol_rel_obj, max_iterations, logger, parameter_writer, diagnostic_writer); return 0; } } // namespace advi } // namespace experimental } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/experimental/advi/defaults.hpp0000644000176200001440000001575713766554456026436 0ustar liggesusers#ifndef STAN_SERVICES_EXPERIMENTAL_ADVI_DEFAULTS_HPP #define STAN_SERVICES_EXPERIMENTAL_ADVI_DEFAULTS_HPP #include #include namespace stan { namespace services { namespace experimental { namespace advi { /** * Number of samples for Monte Carlo estimate of gradients. */ struct gradient_samples { /** * Return the string description of gradient_samples. * * @return description */ static std::string description() { return "Number of Monte Carlo draws for computing the gradient."; } /** * Validates gradient_samples; must be greater than 0. * * @param[in] gradient_samples argument to validate * @throw std::invalid_argument unless gradient_samples is greater * than zero */ static void validate(int gradient_samples) { if (!(gradient_samples > 0)) throw std::invalid_argument( "gradient_samples must be greater" " than 0."); } /** * Return the default number of gradient_samples. * * @return 1 */ static int default_value() { return 1; } }; /** * Number of Monte Carlo samples for estimate of ELBO. */ struct elbo_samples { /** * Return the string description of elbo_samples. * * @return description */ static std::string description() { return "Number of Monte Carlo draws for estimate of ELBO."; } /** * Validates elbo_samples; must be greater than 0. * * @param[in] elbo_samples argument to validate * @throw std::invalid_argument unless elbo_samples is greater than * zero */ static void validate(double elbo_samples) { if (!(elbo_samples > 0)) throw std::invalid_argument( "elbo_samples must be greater" " than 0."); } /** * Return the default elbo_samples value. * * @return 100 */ static int default_value() { return 100; } }; /** * Maximum number of iterations to run ADVI. */ struct max_iterations { /** * Return the string description of max_iterations. * * @return description */ static std::string description() { return "Maximum number of ADVI iterations."; } /** * Validates max_iterations; max_iterations must be greater than 0. * * @param[in] max_iterations argument to validate * @throw std::invalid_argument unless max_iterations is greater * than zero */ static void validate(int max_iterations) { if (!(max_iterations > 0)) throw std::invalid_argument( "max_iterations must be greater" " than 0."); } /** * Return the default max_iterations value. * * @return 10000 */ static int default_value() { return 10000; } }; /** * Relative tolerance parameter for convergence. */ struct tol_rel_obj { /** * Return the string description of tol_rel_obj. * * @return description */ static std::string description() { return "Relative tolerance parameter for convergence."; } /** * Validates tol_rel_obj; must be greater than 0. * * @param[in] tol_rel_obj argument to validate * @throw std::invalid_argument unless tol_rel_obj is greater than * zero */ static void validate(double tol_rel_obj) { if (!(tol_rel_obj > 0)) throw std::invalid_argument( "tol_rel_obj must be greater" " than 0."); } /** * Return the default tol_rel_obj value. * * @return 0.01 */ static double default_value() { return 0.01; } }; /** * Stepsize scaling parameter for variational inference */ struct eta { /** * Return the string description of eta. * * @return description */ static std::string description() { return "Stepsize scaling parameter."; } /** * Validates eta; must be greater than 0. * * @param[in] eta argument to validate * @throw std::invalid_argument unless eta is greater than zero */ static void validate(double eta) { if (!(eta > 0)) throw std::invalid_argument("eta must be greater than 0."); } /** * Return the default eta value. * * @return 1.0 */ static double default_value() { return 1.0; } }; /** * Flag for eta adaptation. */ struct adapt_engaged { /** * Return the string description of adapt_engaged. * * @return description */ static std::string description() { return "Boolean flag for eta adaptation."; } /** * Validates adapt_engaged. This is a no-op. * * @param[in] adapt_engaged argument to validate */ static void validate(bool adapt_engaged) {} /** * Return the default adapt_engaged value. * * @return true */ static bool default_value() { return true; } }; /** * Number of iterations for eta adaptation. */ struct adapt_iterations { /** * Return the string description of adapt_iterations. * * @return description */ static std::string description() { return "Number of iterations for eta adaptation."; } /** * Validates adapt_iterations; must be greater than 0. * * @param[in] adapt_iterations argument to validate * @throw std::invalid_argument unless adapt_iterations is * greater than zero */ static void validate(int adapt_iterations) { if (!(adapt_iterations > 0)) throw std::invalid_argument( "adapt_iterations must be greater" " than 0."); } /** * Return the default adapt_iterations value. * * @return 50 */ static int default_value() { return 50; } }; /** * Evaluate ELBO every Nth iteration */ struct eval_elbo { /** * Return the string description of eval_elbo. Evaluate * ELBO at every eval_elbo iterations. * * @return description */ static std::string description() { return "Number of interations between ELBO evaluations"; } /** * Validates eval_elbo; must be greater than 0. * * @param[in] eval_elbo argument to validate * @throw std::invalid_argument unless eval_elbo is greater than zero */ static void validate(int eval_elbo) { if (!(eval_elbo > 0)) throw std::invalid_argument("eval_elbo must be greater than 0."); } /** * Return the default eval_elbo value. * * @return 100 */ static int default_value() { return 100; } }; /** * Number of approximate posterior output draws to save. */ struct output_draws { /** * Return the string description of output_draws. * * @return description */ static std::string description() { return "Number of approximate posterior output draws to save."; } /** * Validates output_draws; must be greater than or equal to 0. * * @param[in] output_draws argument to validate * @throw std::invalid_argument unless output_draws is greater than * or equal to zero */ static void validate(int output_draws) { if (!(output_draws >= 0)) throw std::invalid_argument( "output_draws must be greater than" " or equal to 0."); } /** * Return the default output_samples value. * * @return 1000 */ static int default_value() { return 1000; } }; } // namespace advi } // namespace experimental } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/0000755000176200001440000000000013766554456021434 5ustar liggesusersStanHeaders/inst/include/src/stan/services/util/run_adaptive_sampler.hpp0000644000176200001440000000654613766554456026364 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_RUN_ADAPTIVE_SAMPLER_HPP #define STAN_SERVICES_UTIL_RUN_ADAPTIVE_SAMPLER_HPP #include #include #include #include #include #include namespace stan { namespace services { namespace util { /** * Runs the sampler with adaptation. * * @tparam Sampler Type of adaptive sampler. * @tparam Model Type of model * @tparam RNG Type of random number generator * @param[in,out] sampler the mcmc sampler to use on the model * @param[in] model the model concept to use for computing log probability * @param[in] cont_vector initial parameter values * @param[in] num_warmup number of warmup draws * @param[in] num_samples number of post warmup draws * @param[in] num_thin number to thin the draws. Must be greater than * or equal to 1. * @param[in] refresh controls output to the logger * @param[in] save_warmup indicates whether the warmup draws should be * sent to the sample writer * @param[in,out] rng random number generator * @param[in,out] interrupt interrupt callback * @param[in,out] logger logger for messages * @param[in,out] sample_writer writer for draws * @param[in,out] diagnostic_writer writer for diagnostic information */ template void run_adaptive_sampler(Sampler& sampler, Model& model, std::vector& cont_vector, int num_warmup, int num_samples, int num_thin, int refresh, bool save_warmup, RNG& rng, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { Eigen::Map cont_params(cont_vector.data(), cont_vector.size()); sampler.engage_adaptation(); try { sampler.z().q = cont_params; sampler.init_stepsize(logger); } catch (const std::exception& e) { logger.info("Exception initializing step size."); logger.info(e.what()); return; } services::util::mcmc_writer writer(sample_writer, diagnostic_writer, logger); stan::mcmc::sample s(cont_params, 0, 0); // Headers writer.write_sample_names(s, sampler, model); writer.write_diagnostic_names(s, sampler, model); clock_t start = clock(); util::generate_transitions(sampler, num_warmup, 0, num_warmup + num_samples, num_thin, refresh, save_warmup, true, writer, s, model, rng, interrupt, logger); clock_t end = clock(); double warm_delta_t = static_cast(end - start) / CLOCKS_PER_SEC; sampler.disengage_adaptation(); writer.write_adapt_finish(sampler); sampler.write_sampler_state(sample_writer); start = clock(); util::generate_transitions(sampler, num_samples, num_warmup, num_warmup + num_samples, num_thin, refresh, true, false, writer, s, model, rng, interrupt, logger); end = clock(); double sample_delta_t = static_cast(end - start) / CLOCKS_PER_SEC; writer.write_timing(warm_delta_t, sample_delta_t); } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/create_rng.hpp0000644000176200001440000000205513766554456024260 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_CREATE_RNG_HPP #define STAN_SERVICES_UTIL_CREATE_RNG_HPP #include namespace stan { namespace services { namespace util { /** * Creates a pseudo random number generator from a random seed * and a chain id by initializing the PRNG with the seed and * then advancing past pow(2, 50) times the chain ID draws to * ensure different chains sample from different segments of the * pseudo random number sequence. * * Chain IDs should be kept to larger values than one to ensure * that the draws used to initialized transformed data are not * duplicated. * * @param[in] seed the random seed * @param[in] chain the chain id * @return a boost::ecuyer1988 instance */ inline boost::ecuyer1988 create_rng(unsigned int seed, unsigned int chain) { using boost::uintmax_t; static uintmax_t DISCARD_STRIDE = static_cast(1) << 50; boost::ecuyer1988 rng(seed); rng.discard(DISCARD_STRIDE * chain); return rng; } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/generate_transitions.hpp0000644000176200001440000000576113766554456026405 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_GENERATE_TRANSITIONS_HPP #define STAN_SERVICES_UTIL_GENERATE_TRANSITIONS_HPP #include #include #include #include #include namespace stan { namespace services { namespace util { /** * Generates MCMC transitions. * * @tparam Model model class * @tparam RNG random number generator class * @param[in,out] sampler MCMC sampler used to generate transitions * @param[in] num_iterations number of MCMC transitions * @param[in] start starting iteration number used for printing messages * @param[in] finish end iteration number used for printing messages * @param[in] num_thin when save is true, a draw will be written to the * mcmc_writer every num_thin iterations * @param[in] refresh number of iterations to print a message. If * refresh is zero, iteration number messages will not be printed * @param[in] save if save is true, the transitions will be written * to the mcmc_writer. If false, transitions will not be written * @param[in] warmup indicates whether these transitions are warmup. Used * for printing iteration number messages * @param[in,out] mcmc_writer writer to handle mcmc otuput * @param[in,out] init_s starts as the initial unconstrained parameter * values. When the function completes, this will have the final * iteration's unconstrained parameter values * @param[in] model model * @param[in,out] base_rng random number generator * @param[in,out] callback interrupt callback called once an iteration * @param[in,out] logger logger for messages */ template void generate_transitions(stan::mcmc::base_mcmc& sampler, int num_iterations, int start, int finish, int num_thin, int refresh, bool save, bool warmup, util::mcmc_writer& mcmc_writer, stan::mcmc::sample& init_s, Model& model, RNG& base_rng, callbacks::interrupt& callback, callbacks::logger& logger) { for (int m = 0; m < num_iterations; ++m) { callback(); if (refresh > 0 && (start + m + 1 == finish || m == 0 || (m + 1) % refresh == 0)) { int it_print_width = std::ceil(std::log10(static_cast(finish))); std::stringstream message; message << "Iteration: "; message << std::setw(it_print_width) << m + 1 + start << " / " << finish; message << " [" << std::setw(3) << static_cast((100.0 * (start + m + 1)) / finish) << "%] "; message << (warmup ? " (Warmup)" : " (Sampling)"); logger.info(message); } init_s = sampler.transition(init_s, logger); if (save && ((m % num_thin) == 0)) { mcmc_writer.write_sample_params(base_rng, init_s, sampler, model); mcmc_writer.write_diagnostic_params(init_s, sampler); } } } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/validate_dense_inv_metric.hpp0000644000176200001440000000174513766554456027342 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_VALIDATE_DENSE_INV_METRIC_HPP #define STAN_SERVICES_UTIL_VALIDATE_DENSE_INV_METRIC_HPP #include #include namespace stan { namespace services { namespace util { /** * Validate that dense inverse Euclidean metric is positive definite * * @param[in] inv_metric inverse Euclidean metric * @param[in,out] logger Logger for messages * @throws std::domain_error if matrix is not positive definite */ inline void validate_dense_inv_metric(const Eigen::MatrixXd& inv_metric, callbacks::logger& logger) { try { stan::math::check_pos_definite("check_pos_definite", "inv_metric", inv_metric); } catch (const std::domain_error& e) { logger.error("Inverse Euclidean metric not positive definite."); throw std::domain_error("Initialization failure"); } } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/inv_metric.hpp0000644000176200001440000000054713766554456024312 0ustar liggesusers#include #include #include #include #include #include StanHeaders/inst/include/src/stan/services/util/validate_diag_inv_metric.hpp0000644000176200001440000000177513766554456027153 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_VALIDATE_DIAG_INV_METRIC_HPP #define STAN_SERVICES_UTIL_VALIDATE_DIAG_INV_METRIC_HPP #include #include namespace stan { namespace services { namespace util { /** * Validate that diag inverse Euclidean metric is positive definite * * @param[in] inv_metric inverse Euclidean metric * @param[in,out] logger Logger for messages * @throws std::domain_error if matrix is not positive definite */ inline void validate_diag_inv_metric(const Eigen::VectorXd& inv_metric, callbacks::logger& logger) { try { stan::math::check_finite("check_finite", "inv_metric", inv_metric); stan::math::check_positive("check_positive", "inv_metric", inv_metric); } catch (const std::domain_error& e) { logger.error("Inverse Euclidean metric not positive definite."); throw std::domain_error("Initialization failure"); } } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/experimental_message.hpp0000644000176200001440000000171013766554456026345 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_EXPERIMENTAL_MESSAGE_HPP #define STAN_SERVICES_UTIL_EXPERIMENTAL_MESSAGE_HPP #include namespace stan { namespace services { namespace util { /** * Writes an experimental message to the writer. * All experimental algorithms should call this function. * * @param[in,out] logger logger for experimental algorithm message */ inline void experimental_message(stan::callbacks::logger& logger) { logger.info( "------------------------------" "------------------------------"); logger.info("EXPERIMENTAL ALGORITHM:"); logger.info( " This procedure has not been thoroughly tested" " and may be unstable"); logger.info(" or buggy. The interface is subject to change."); logger.info( "------------------------------" "------------------------------"); logger.info(""); logger.info(""); } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/read_diag_inv_metric.hpp0000644000176200001440000000312413766554456026263 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_READ_DIAG_INV_METRIC_HPP #define STAN_SERVICES_UTIL_READ_DIAG_INV_METRIC_HPP #include #include #include #include #include #include #include namespace stan { namespace services { namespace util { /** * Extract diagonal values for an inverse Euclidean metric * from a var_context object. * * @param[in] init_context a var_context with initial values * @param[in] num_params expected number of diagonal elements * @param[in,out] logger Logger for messages * @throws std::domain_error if the Euclidean metric is invalid * @return inv_metric vector of diagonal values */ inline Eigen::VectorXd read_diag_inv_metric(stan::io::var_context& init_context, size_t num_params, callbacks::logger& logger) { Eigen::VectorXd inv_metric(num_params); try { init_context.validate_dims("read diag inv metric", "inv_metric", "vector_d", init_context.to_vec(num_params)); std::vector diag_vals = init_context.vals_r("inv_metric"); for (size_t i = 0; i < num_params; i++) { inv_metric(i) = diag_vals[i]; } } catch (const std::exception& e) { logger.error("Cannot get inverse Euclidean metric from input file."); logger.error("Caught exception: "); logger.error(e.what()); throw std::domain_error("Initialization failure"); } return inv_metric; } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/gq_writer.hpp0000644000176200001440000000551313766554456024154 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_GQ_WRITER_HPP #define STAN_SERVICES_UTIL_GQ_WRITER_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace util { /** * gq_writer writes out * * @tparam Model Model class */ class gq_writer { private: callbacks::writer& sample_writer_; callbacks::logger& logger_; int num_constrained_params_; public: /** * Constructor. * * @param[in,out] sample_writer samples are "written" to this stream * @param[in,out] logger messages are written through the logger * @param[in] num_constrained_params offset into write_array gqs */ gq_writer(callbacks::writer& sample_writer, callbacks::logger& logger, int num_constrained_params) : sample_writer_(sample_writer), logger_(logger), num_constrained_params_(num_constrained_params) {} /** * Write names of variables declared in the generated quantities block * to stream `sample_writer_`. * * @tparam M model class */ template void write_gq_names(const Model& model) { static const bool include_tparams = false; static const bool include_gqs = true; std::vector names; model.constrained_param_names(names, include_tparams, include_gqs); std::vector gq_names(names.begin() + num_constrained_params_, names.end()); sample_writer_(gq_names); } /** * Calls model's `write_array` method and writes values of * variables defined in the generated quantities block * to stream `sample_writer_`. * * @tparam M model class * @tparam RNG pseudo random number generator class * @param[in] model instantiated model * @param[in] rng instantiated RNG * @param[in] draw sequence unconstrained parameters values. */ template void write_gq_values(const Model& model, RNG& rng, const std::vector& draw) { std::vector values; std::vector params_i; // unused - no discrete params std::stringstream ss; try { model.write_array(rng, const_cast&>(draw), params_i, values, false, true, &ss); } catch (const std::exception& e) { if (ss.str().length() > 0) logger_.info(ss); logger_.info(e.what()); return; } if (ss.str().length() > 0) logger_.info(ss); std::vector gq_values(values.begin() + num_constrained_params_, values.end()); sample_writer_(gq_values); } }; } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/initialize.hpp0000644000176200001440000001753613766554456024322 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_INITIALIZE_HPP #define STAN_SERVICES_UTIL_INITIALIZE_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace util { /** * Returns a valid initial value of the parameters of the model * on the unconstrained scale. * * For identical inputs (model, init, rng, init_radius), this * function will produce the same initialization. * * Initialization first tries to use the provided * stan::io::var_context, then it will generate * random uniform values from -init_radius to +init_radius for missing * parameters. * * When the var_context provides all variables or * the init_radius is 0, this function will only evaluate the * log probability of the model with the unconstrained * parameters once to see if it's valid. * * When at least some of the initialization is random, it will * randomly initialize until it finds a set of unconstrained * parameters that are valid or it hits MAX_INIT_TRIES = * 100 (hard-coded). * * Valid initialization is defined as a finite, non-NaN value for the * evaluation of the log probability density function and all its * gradients. * * @tparam Jacobian indicates whether to include the Jacobian term when * evaluating the log density function * @tparam Model the type of the model class * @tparam RNG the type of the random number generator * * @param[in] model the model * @param[in] init a var_context with initial values * @param[in,out] rng random number generator * @param[in] init_radius the radius for generating random values. * A value of 0 indicates that the unconstrained parameters (not * provided by init) should be initialized with 0. * @param[in] print_timing indicates whether a timing message should * be printed to the logger * @param[in,out] logger logger for messages * @param[in,out] init_writer init writer (on the unconstrained scale) * @throws exception passed through from the model if the model has a * fatal error (not a std::domain_error) * @throws std::domain_error if the model can not be initialized and * the model does not have a fatal error (only allows for * std::domain_error) * @return valid unconstrained parameters for the model */ template std::vector initialize(Model& model, stan::io::var_context& init, RNG& rng, double init_radius, bool print_timing, stan::callbacks::logger& logger, stan::callbacks::writer& init_writer) { std::vector unconstrained; std::vector disc_vector; bool is_fully_initialized = true; bool any_initialized = false; std::vector param_names; model.get_param_names(param_names); for (size_t n = 0; n < param_names.size(); n++) { is_fully_initialized &= init.contains_r(param_names[n]); any_initialized |= init.contains_r(param_names[n]); } bool is_initialized_with_zero = init_radius == 0.0; int MAX_INIT_TRIES = is_fully_initialized || is_initialized_with_zero ? 1 : 100; int num_init_tries = 0; for (; num_init_tries < MAX_INIT_TRIES; num_init_tries++) { std::stringstream msg; try { stan::io::random_var_context random_context(model, rng, init_radius, is_initialized_with_zero); if (!any_initialized) { unconstrained = random_context.get_unconstrained(); } else { stan::io::chained_var_context context(init, random_context); model.transform_inits(context, disc_vector, unconstrained, &msg); } } catch (std::domain_error& e) { if (msg.str().length() > 0) logger.info(msg); logger.info("Rejecting initial value:"); logger.info( " Error evaluating the log probability" " at the initial value."); logger.info(e.what()); continue; } catch (std::exception& e) { if (msg.str().length() > 0) logger.info(msg); logger.info( "Unrecoverable error evaluating the log probability" " at the initial value."); logger.info(e.what()); throw; } msg.str(""); double log_prob(0); try { // we evaluate the log_prob function with propto=false // because we're evaluating with `double` as the type of // the parameters. log_prob = model.template log_prob(unconstrained, disc_vector, &msg); if (msg.str().length() > 0) logger.info(msg); } catch (std::domain_error& e) { if (msg.str().length() > 0) logger.info(msg); logger.info("Rejecting initial value:"); logger.info( " Error evaluating the log probability" " at the initial value."); logger.info(e.what()); continue; } catch (std::exception& e) { if (msg.str().length() > 0) logger.info(msg); logger.info( "Unrecoverable error evaluating the log probability" " at the initial value."); logger.info(e.what()); throw; } if (!boost::math::isfinite(log_prob)) { logger.info("Rejecting initial value:"); logger.info( " Log probability evaluates to log(0)," " i.e. negative infinity."); logger.info( " Stan can't start sampling from this" " initial value."); continue; } std::stringstream log_prob_msg; std::vector gradient; clock_t start_check = clock(); try { // we evaluate this with propto=true since we're // evaluating with autodiff variables log_prob = stan::model::log_prob_grad( model, unconstrained, disc_vector, gradient, &log_prob_msg); } catch (const std::exception& e) { if (log_prob_msg.str().length() > 0) logger.info(log_prob_msg); logger.info(e.what()); throw; } clock_t end_check = clock(); double deltaT = static_cast(end_check - start_check) / CLOCKS_PER_SEC; if (log_prob_msg.str().length() > 0) logger.info(log_prob_msg); bool gradient_ok = boost::math::isfinite(stan::math::sum(gradient)); if (!gradient_ok) { logger.info("Rejecting initial value:"); logger.info( " Gradient evaluated at the initial value" " is not finite."); logger.info( " Stan can't start sampling from this" " initial value."); } if (gradient_ok && print_timing) { logger.info(""); std::stringstream msg1; msg1 << "Gradient evaluation took " << deltaT << " seconds"; logger.info(msg1); std::stringstream msg2; msg2 << "1000 transitions using 10 leapfrog steps" << " per transition would take" << " " << 1e4 * deltaT << " seconds."; logger.info(msg2); logger.info("Adjust your expectations accordingly!"); logger.info(""); logger.info(""); } if (gradient_ok) { init_writer(unconstrained); return unconstrained; } } if (!is_initialized_with_zero) { logger.info(""); std::stringstream msg; msg << "Initialization between (-" << init_radius << ", " << init_radius << ") failed after" << " " << MAX_INIT_TRIES << " attempts. "; logger.info(msg); logger.info( " Try specifying initial values," " reducing ranges of constrained values," " or reparameterizing the model."); } throw std::domain_error("Initialization failed."); } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/create_unit_e_dense_inv_metric.hpp0000644000176200001440000000200313766554456030343 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_CREATE_UNIT_E_DENSE_INV_METRIC_HPP #define STAN_SERVICES_UTIL_CREATE_UNIT_E_DENSE_INV_METRIC_HPP #include #include #include namespace stan { namespace services { namespace util { /** * Create a stan::dump object which contains vector "metric" * of specified size where all elements are ones. * * @param[in] num_params expected number of denseonal elements * @return var_context */ inline stan::io::dump create_unit_e_dense_inv_metric(size_t num_params) { Eigen::MatrixXd inv_metric(num_params, num_params); inv_metric.setIdentity(); size_t num_elements = num_params * num_params; std::stringstream txt; txt << "inv_metric <- structure(c("; for (size_t i = 0; i < num_elements; i++) { txt << inv_metric(i); if (i < num_elements - 1) txt << ", "; } txt << "),.Dim=c(" << num_params << ", " << num_params << "))"; return stan::io::dump(txt); } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/create_unit_e_diag_inv_metric.hpp0000644000176200001440000000150313766554456030155 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_CREATE_UNIT_E_DIAG_INV_METRIC_HPP #define STAN_SERVICES_UTIL_CREATE_UNIT_E_DIAG_INV_METRIC_HPP #include #include namespace stan { namespace services { namespace util { /** * Create a stan::dump object which contains vector "metric" * of specified size where all elements are ones. * * @param[in] num_params expected number of diagonal elements * @return var_context */ inline stan::io::dump create_unit_e_diag_inv_metric(size_t num_params) { std::stringstream txt; txt << "inv_metric <- structure(c("; for (size_t i = 0; i < num_params; ++i) { txt << "1.0"; if (i < num_params - 1) txt << ", "; } txt << "),.Dim=c(" << num_params << "))"; return stan::io::dump(txt); } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/run_sampler.hpp0000644000176200001440000000560513766554456024502 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_RUN_SAMPLER_HPP #define STAN_SERVICES_UTIL_RUN_SAMPLER_HPP #include #include #include #include #include namespace stan { namespace services { namespace util { /** * Runs the sampler without adaptation. * * @tparam Model Type of model * @tparam RNG Type of random number generator * @param[in,out] sampler the mcmc sampler to use on the model * @param[in] model the model concept to use for computing log probability * @param[in] cont_vector initial parameter values * @param[in] num_warmup number of warmup draws * @param[in] num_samples number of post warmup draws * @param[in] num_thin number to thin the draws. Must be greater than or * equal to 1. * @param[in] refresh controls output to the logger * @param[in] save_warmup indicates whether the warmup draws should be * sent to the sample writer * @param[in,out] rng random number generator * @param[in,out] interrupt interrupt callback * @param[in,out] logger logger for messages * @param[in,out] sample_writer writer for draws * @param[in,out] diagnostic_writer writer for diagnostic information */ template void run_sampler(stan::mcmc::base_mcmc& sampler, Model& model, std::vector& cont_vector, int num_warmup, int num_samples, int num_thin, int refresh, bool save_warmup, RNG& rng, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { Eigen::Map cont_params(cont_vector.data(), cont_vector.size()); services::util::mcmc_writer writer(sample_writer, diagnostic_writer, logger); stan::mcmc::sample s(cont_params, 0, 0); // Headers writer.write_sample_names(s, sampler, model); writer.write_diagnostic_names(s, sampler, model); clock_t start = clock(); util::generate_transitions(sampler, num_warmup, 0, num_warmup + num_samples, num_thin, refresh, save_warmup, true, writer, s, model, rng, interrupt, logger); clock_t end = clock(); double warm_delta_t = static_cast(end - start) / CLOCKS_PER_SEC; writer.write_adapt_finish(sampler); sampler.write_sampler_state(sample_writer); start = clock(); util::generate_transitions(sampler, num_samples, num_warmup, num_warmup + num_samples, num_thin, refresh, true, false, writer, s, model, rng, interrupt, logger); end = clock(); double sample_delta_t = static_cast(end - start) / CLOCKS_PER_SEC; writer.write_timing(warm_delta_t, sample_delta_t); } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/mcmc_writer.hpp0000644000176200001440000001652313766554456024467 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_MCMC_WRITER_HPP #define STAN_SERVICES_UTIL_MCMC_WRITER_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace util { /** * mcmc_writer writes out headers and samples * * @tparam Model Model class */ class mcmc_writer { private: callbacks::writer& sample_writer_; callbacks::writer& diagnostic_writer_; callbacks::logger& logger_; public: size_t num_sample_params_; size_t num_sampler_params_; size_t num_model_params_; /** * Constructor. * * @param[in,out] sample_writer samples are "written" to this stream * @param[in,out] diagnostic_writer diagnostic info is "written" to this * stream * @param[in,out] logger messages are written through the logger */ mcmc_writer(callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer, callbacks::logger& logger) : sample_writer_(sample_writer), diagnostic_writer_(diagnostic_writer), logger_(logger), num_sample_params_(0), num_sampler_params_(0), num_model_params_(0) {} /** * Outputs parameter string names. First outputs the names stored in * the sample object (stan::mcmc::sample), then uses the sampler * provided to output sampler specific names, then adds the model * constrained parameter names. * * The names are written to the sample_stream as comma separated values * with a newline at the end. * * @param[in] sample a sample (unconstrained) that works with the model * @param[in] sampler a stan::mcmc::base_mcmc object * @param[in] model the model */ template void write_sample_names(stan::mcmc::sample& sample, stan::mcmc::base_mcmc& sampler, Model& model) { std::vector names; sample.get_sample_param_names(names); num_sample_params_ = names.size(); sampler.get_sampler_param_names(names); num_sampler_params_ = names.size() - num_sample_params_; model.constrained_param_names(names, true, true); num_model_params_ = names.size() - num_sample_params_ - num_sampler_params_; sample_writer_(names); } /** * Outputs samples. First outputs the values of the sample params * from a stan::mcmc::sample, then outputs the values of the sampler * params from a stan::mcmc::base_mcmc, then finally outputs the values * of the model. * * The samples are written to the sample_stream as comma separated * values with a newline at the end. * * @param[in,out] rng random number generator (used by * model.write_array()) * @param[in] sample the sample in constrained space * @param[in] sampler the sampler * @param[in] model the model */ template void write_sample_params(RNG& rng, stan::mcmc::sample& sample, stan::mcmc::base_mcmc& sampler, Model& model) { std::vector values; sample.get_sample_params(values); sampler.get_sampler_params(values); std::vector model_values; std::vector params_i; std::stringstream ss; try { std::vector cont_params( sample.cont_params().data(), sample.cont_params().data() + sample.cont_params().size()); model.write_array(rng, cont_params, params_i, model_values, true, true, &ss); } catch (const std::exception& e) { if (ss.str().length() > 0) logger_.info(ss); ss.str(""); logger_.info(e.what()); } if (ss.str().length() > 0) logger_.info(ss); if (model_values.size() > 0) values.insert(values.end(), model_values.begin(), model_values.end()); if (model_values.size() < num_model_params_) values.insert(values.end(), num_model_params_ - model_values.size(), std::numeric_limits::quiet_NaN()); sample_writer_(values); } /** * Prints additional info to the streams * * Prints to the sample stream * * @param[in] sampler sampler */ void write_adapt_finish(stan::mcmc::base_mcmc& sampler) { sample_writer_("Adaptation terminated"); } /** * Print diagnostic names * * @param[in] sample unconstrained sample * @param[in] sampler sampler * @param[in] model model */ template void write_diagnostic_names(stan::mcmc::sample sample, stan::mcmc::base_mcmc& sampler, Model& model) { std::vector names; sample.get_sample_param_names(names); sampler.get_sampler_param_names(names); std::vector model_names; model.unconstrained_param_names(model_names, false, false); sampler.get_sampler_diagnostic_names(model_names, names); diagnostic_writer_(names); } /** * Print diagnostic params to the diagnostic stream. * * @param[in] sample unconstrained sample * @param[in] sampler sampler */ void write_diagnostic_params(stan::mcmc::sample& sample, stan::mcmc::base_mcmc& sampler) { std::vector values; sample.get_sample_params(values); sampler.get_sampler_params(values); sampler.get_sampler_diagnostics(values); diagnostic_writer_(values); } /** * Internal method * * Prints timing information * * @param[in] warmDeltaT warmup time in seconds * @param[in] sampleDeltaT sample time in seconds * @param[in,out] writer output stream */ void write_timing(double warmDeltaT, double sampleDeltaT, callbacks::writer& writer) { std::string title(" Elapsed Time: "); writer(); std::stringstream ss1; ss1 << title << warmDeltaT << " seconds (Warm-up)"; writer(ss1.str()); std::stringstream ss2; ss2 << std::string(title.size(), ' ') << sampleDeltaT << " seconds (Sampling)"; writer(ss2.str()); std::stringstream ss3; ss3 << std::string(title.size(), ' ') << warmDeltaT + sampleDeltaT << " seconds (Total)"; writer(ss3.str()); writer(); } /** * Internal method * * Logs timing information * * @param[in] warmDeltaT warmup time in seconds * @param[in] sampleDeltaT sample time in seconds */ void log_timing(double warmDeltaT, double sampleDeltaT) { std::string title(" Elapsed Time: "); logger_.info(""); std::stringstream ss1; ss1 << title << warmDeltaT << " seconds (Warm-up)"; logger_.info(ss1); std::stringstream ss2; ss2 << std::string(title.size(), ' ') << sampleDeltaT << " seconds (Sampling)"; logger_.info(ss2); std::stringstream ss3; ss3 << std::string(title.size(), ' ') << warmDeltaT + sampleDeltaT << " seconds (Total)"; logger_.info(ss3); logger_.info(""); } /** * Print timing information to all streams * * @param[in] warmDeltaT warmup time (sec) * @param[in] sampleDeltaT sample time (sec) */ void write_timing(double warmDeltaT, double sampleDeltaT) { write_timing(warmDeltaT, sampleDeltaT, sample_writer_); write_timing(warmDeltaT, sampleDeltaT, diagnostic_writer_); log_timing(warmDeltaT, sampleDeltaT); } }; } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/util/read_dense_inv_metric.hpp0000644000176200001440000000273513766554456026464 0ustar liggesusers#ifndef STAN_SERVICES_UTIL_READ_DENSE_INV_METRIC_HPP #define STAN_SERVICES_UTIL_READ_DENSE_INV_METRIC_HPP #include #include #include #include #include #include #include namespace stan { namespace services { namespace util { /** * Extract dense inverse Euclidean metric from a var_context object. * * @param[in] init_context a var_context with array of initial values * @param[in] num_params expected number of row, column elements * @param[in,out] logger Logger for messages * @throws std::domain_error if cannot read the Euclidean metric * @return inv_metric */ inline Eigen::MatrixXd read_dense_inv_metric( stan::io::var_context& init_context, size_t num_params, callbacks::logger& logger) { Eigen::MatrixXd inv_metric; try { init_context.validate_dims("read dense inv metric", "inv_metric", "matrix", init_context.to_vec(num_params, num_params)); std::vector dense_vals = init_context.vals_r("inv_metric"); inv_metric = stan::math::to_matrix(dense_vals, num_params, num_params); } catch (const std::exception& e) { logger.error("Cannot get inverse metric from input file."); logger.error("Caught exception: "); logger.error(e.what()); throw std::domain_error("Initialization failure"); } return inv_metric; } } // namespace util } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/diagnose/0000755000176200001440000000000013766554456022250 5ustar liggesusersStanHeaders/inst/include/src/stan/services/diagnose/diagnose.hpp0000644000176200001440000000465613766554456024565 0ustar liggesusers#ifndef STAN_SERVICES_DIAGNOSE_DIAGNOSE_HPP #define STAN_SERVICES_DIAGNOSE_DIAGNOSE_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace diagnose { /** * Checks the gradients of the model computed using reverse mode * autodiff against finite differences. * * This will test the first order gradients using reverse mode * at the value specified in cont_params. This method only * outputs to the logger. * * @tparam Model A model implementation * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] epsilon epsilon to use for finite differences * @param[in] error amount of absolute error to allow * @param[in,out] interrupt interrupt callback * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] parameter_writer Writer callback for file output * @return the number of parameters that are not within epsilon * of the finite difference calculation */ template int diagnose(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, double epsilon, double error, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& parameter_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, false, logger, init_writer); logger.info("TEST GRADIENT MODE"); int num_failed = stan::model::test_gradients( model, cont_vector, disc_vector, epsilon, error, interrupt, logger, parameter_writer); return num_failed; } } // namespace diagnose } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/diagnose/defaults.hpp0000644000176200001440000000321513766554456024571 0ustar liggesusers#ifndef STAN_SERVICES_DIAGNOSE_DEFAULTS_HPP #define STAN_SERVICES_DIAGNOSE_DEFAULTS_HPP #include #include namespace stan { namespace services { namespace diagnose { /** * Epsilon is the finite differences stepsize. */ struct epsilon { /** * Return the string description of epsilon. * * @return description */ static std::string description() { return "Finite difference stepsize."; } /** * Validates epsilon; epsilon must be greater than 0. * * @param[in] epsilon argument to validate * @throw std::invalid_argument unless epsilon is greater than zero */ static void validate(double epsilon) { if (!(epsilon > 0)) throw std::invalid_argument("epsilon must be greater than 0."); } /** * Return the default epsilon value. * * @return 1e-6 */ static double default_value() { return 1e-6; } }; /** * Error is the absolute error threshold for evaluating * gradients relative to the finite differences calculation. */ struct error { /** * Return the string description of error. * * @return description */ static std::string description() { return "Absolute error threshold."; } /** * Validates error; error must be greater than 0. * * @throw std::invalid_argument unless error is greater than zero * equal to 0. */ static void validate(double error) { if (!(error > 0)) throw std::invalid_argument("error must be greater than 0."); } /** * Return the default error value. * * @return 1e-6 */ static double default_value() { return 1e-6; } }; } // namespace diagnose } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/0000755000176200001440000000000013766554456021740 5ustar liggesusersStanHeaders/inst/include/src/stan/services/sample/fixed_param.hpp0000644000176200001440000000620413766554456024732 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_FIXED_PARAM_HPP #define STAN_SERVICES_SAMPLE_FIXED_PARAM_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs the fixed parameter sampler. * * The fixed parameter sampler sets the parameters randomly once * on the unconstrained scale, then runs the model for the number * of iterations specified with the parameters fixed. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] refresh Controls the output * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int fixed_param(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_samples, int num_thin, int refresh, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, false, logger, init_writer); stan::mcmc::fixed_param_sampler sampler; util::mcmc_writer writer(sample_writer, diagnostic_writer, logger); Eigen::VectorXd cont_params(cont_vector.size()); for (size_t i = 0; i < cont_vector.size(); i++) cont_params[i] = cont_vector[i]; stan::mcmc::sample s(cont_params, 0, 0); // Headers writer.write_sample_names(s, sampler, model); writer.write_diagnostic_names(s, sampler, model); clock_t start = clock(); util::generate_transitions(sampler, num_samples, 0, num_samples, num_thin, refresh, true, false, writer, s, model, rng, interrupt, logger); clock_t end = clock(); double sampleDeltaT = static_cast(end - start) / CLOCKS_PER_SEC; writer.write_timing(0.0, sampleDeltaT); return error_codes::OK; } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_static_dense_e_adapt.hpp0000644000176200001440000001632513766554456027431 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_STATIC_DENSE_E_ADAPT_HPP #define STAN_SERVICES_SAMPLE_HMC_STATIC_DENSE_E_ADAPT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs static HMC with adaptation using dense Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial diagonal inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_dense_e_adapt( Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::MatrixXd inv_metric; try { inv_metric = util::read_dense_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_dense_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::adapt_dense_e_static_hmc sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize_and_T(stepsize, int_time); sampler.set_stepsize_jitter(stepsize_jitter); sampler.get_stepsize_adaptation().set_mu(log(10 * stepsize)); sampler.get_stepsize_adaptation().set_delta(delta); sampler.get_stepsize_adaptation().set_gamma(gamma); sampler.get_stepsize_adaptation().set_kappa(kappa); sampler.get_stepsize_adaptation().set_t0(t0); sampler.set_window_params(num_warmup, init_buffer, term_buffer, window, logger); util::run_adaptive_sampler( sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs static HMC with adaptation using dense Euclidean metric. * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_dense_e_adapt( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_dense_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_static_dense_e_adapt( model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, int_time, delta, gamma, kappa, t0, init_buffer, term_buffer, window, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_nuts_unit_e.hpp0000644000176200001440000000601113766554456025632 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_NUTS_UNIT_E_HPP #define STAN_SERVICES_SAMPLE_HMC_NUTS_UNIT_E_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs HMC with NUTS with unit Euclidean * metric without adaptation. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_unit_e(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); stan::mcmc::unit_e_nuts sampler(model, rng); sampler.set_nominal_stepsize(stepsize); sampler.set_stepsize_jitter(stepsize_jitter); sampler.set_max_depth(max_depth); util::run_sampler(sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/defaults.hpp0000644000176200001440000002374013766554456024266 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_DEFAULTS_HPP #define STAN_SERVICES_SAMPLE_DEFAULTS_HPP #include #include namespace stan { namespace services { namespace sample { /** * Number of sampling iterations. */ struct num_samples { /** * Return the string description of num_samples. * * @return description */ static std::string description() { return "Number of sampling iterations."; } /** * Validates num_samples; num_samples must be greater than or * equal to 0. * * @param[in] num_samples argument to validate * @throw std::invalid_argument unless num_samples is greater * than or equal to zero */ static void validate(int num_samples) { if (!(num_samples >= 0)) throw std::invalid_argument( "num_samples must be greater" " than or equal to 0."); } /** * Return the default num_samples value. * * @return 1000 */ static int default_value() { return 1000; } }; /** * Number of warmup iterations. */ struct num_warmup { /** * Return the string description of num_warmup. * * @return description */ static std::string description() { return "Number of warmup iterations."; } /** * Validates num_warmup; num_warmup must be greater than or * equal to 0. * * @param[in] num_warmup argument to validate * @throw std::invalid_argument unless num_warmup is greater than * or equal to zero */ static void validate(int num_warmup) { if (!(num_warmup >= 0)) throw std::invalid_argument( "num_warmup must be greater" " than or equal to 0."); } /** * Return the default num_warmup value. * * @return 1000 */ static int default_value() { return 1000; } }; /** * Save warmup iterations to output. */ struct save_warmup { /** * Return the string description of save_warmup. * * @return description */ static std::string description() { return "Save warmup iterations to output."; } /** * Validates save_warmup. This is a no-op. * * @param[in] save_warmup argument to validate */ static void validate(bool save_warmup) {} /** * Return the default save_warmup value. * * @return false */ static bool default_value() { return false; } }; /** * Period between saved samples. */ struct thin { /** * Return the string description of thin. * * @return description */ static std::string description() { return "Period between saved samples."; } /** * Validates thin; thin must be greater than 0. * * @param[in] thin argument to validate * @throw std::invalid_argument unless thin is greater than zero */ static void validate(int thin) { if (!(thin > 0)) throw std::invalid_argument("thin must be greater than 0."); } /** * Return the default thin value. * * @return 1 */ static int default_value() { return 1; } }; /** * Indicates whether adaptation is engaged. */ struct adaptation_engaged { /** * Return the string description of adaptation_engaged. * * @return description */ static std::string description() { return "Indicates whether adaptation is engaged."; } /** * Validates adaptation_engaged. This is a no op. * * @param[in] adaptation_engaged argument to validate */ static void validate(bool adaptation_engaged) {} /** * Return the default adaptation_engaged value. * * @return true */ static bool default_value() { return true; } }; /** * Adaptation regularization scale. */ struct gamma { /** * Return the string description of gamma. * * @return description */ static std::string description() { return "Adaptation regularization scale."; } /** * Validates gamma; gamma must be greater than 0. * * @param[in] gamma argument to validate * @throw std::invalid_argument unless gamma is greater than zero */ static void validate(double gamma) { if (!(gamma > 0)) throw std::invalid_argument("gamma must be greater than 0."); } /** * Return the default gamma value. * * @return 0.05 */ static double default_value() { return 0.05; } }; /** * Adaptation relaxation exponent. */ struct kappa { /** * Return the string description of kappa. * * @return description */ static std::string description() { return "Adaptation relaxation exponent."; } /** * Validates kappa; kappa must be greater than 0. * * @param[in] kappa argument to validate * @throw std::invalid_argument unless kappa is greater than zero */ static void validate(double kappa) { if (!(kappa > 0)) throw std::invalid_argument("kappa must be greater than 0."); } /** * Return the default kappa value. * * @return 0.75 */ static double default_value() { return 0.75; } }; /** * Adaptation iteration offset. */ struct t0 { /** * Return the description of t0. * * @return description */ static std::string description() { return "Adaptation iteration offset."; } /** * Validates t0; t0 must be greater than 0. * * @param[in] t0 argument to validate * @throw std::invalid_argument unless t0 is greater than zero */ static void validate(double t0) { if (!(t0 > 0)) throw std::invalid_argument("t0 must be greater than 0."); } /** * Return the default t0 value. * * @return 10 */ static double default_value() { return 10; } }; /** * Width of initial fast adaptation interval. */ struct init_buffer { /** * Return the string description of init_buffer. * * @return description */ static std::string description() { return "Width of initial fast adaptation interval."; } /** * Validates init_buffer. This is a no op. * * @param[in] init_buffer argument to validate */ static void validate(unsigned int init_buffer) {} /** * Return the default init_buffer value. * * @return 75 */ static unsigned int default_value() { return 75; } }; /** * Width of final fast adaptation interval. */ struct term_buffer { /** * Return the string description of term_buffer. * * @return description */ static std::string description() { return "Width of final fast adaptation interval."; } /** * Validates term_buffer. This is a no-op. * * @param[in] term_buffer argument to validate */ static void validate(unsigned int term_buffer) {} /** * Return the default term_buffer value. * * @return 50 */ static unsigned int default_value() { return 50; } }; /** * Initial width of slow adaptation interval. */ struct window { /** * Return the string description of window. * * @return description */ static std::string description() { return "Initial width of slow adaptation interval."; } /** * Validates window. This is a no op. * * @param[in] window argument to validate */ static void validate(unsigned int window) {} /** * Return the default window value. * * @return 25 */ static unsigned int default_value() { return 25; } }; /** * Total integration time for Hamiltonian evolution. */ struct int_time { /** * Return the string description of int_time. * * @return description */ static std::string description() { return "Total integration time for Hamiltonian evolution."; } /** * Validates int_time. int_time must be greater than 0. * * @param[in] int_time argument to validate * @throw std::invalid_argument unless int_time is greater than zero */ static void validate(double int_time) { if (!(int_time > 0)) throw std::invalid_argument("int_time must be greater than 0."); } /** * Return the default int_time value. * * @return 2 * pi */ static double default_value() { return 6.28318530717959; } }; /** * Maximum tree depth. */ struct max_depth { /** * Return the string description of max_depth. * * @return description */ static std::string description() { return "Maximum tree depth."; } /** * Validates max_depth; max_depth must be greater than 0. * * @param[in] max_depth argument to validate * @throw std::invalid_argument unless max_depth is greater than zero */ static void validate(int max_depth) { if (!(max_depth > 0)) throw std::invalid_argument("max_depth must be greater than 0."); } /** * Return the default max_depth value. * * @return 10 */ static int default_value() { return 10; } }; /** * Step size for discrete evolution */ struct stepsize { /** * Return the string description of stepsize. * * @return description */ static std::string description() { return "Step size for discrete evolution."; } /** * Validates stepsize; stepsize must be greater than 0. * * @param[in] stepsize argument to validate * @throw std::invalid_argument unless stepsize is greater than zero */ static void validate(double stepsize) { if (!(stepsize > 0)) throw std::invalid_argument("stepsize must be greater than 0."); } /** * Return the default stepsize value. * * @return 1 */ static double default_value() { return 1; } }; /** * Uniformly random jitter of the stepsize, in percent. */ struct stepsize_jitter { /** * Return the string description of stepsize_jitter. * * @return description */ static std::string description() { return "Uniformly random jitter of the stepsize, in percent."; } /** * Validates stepsize_jitter; stepsize_jitter must be between 0 and 1. * * @param[in] stepsize_jitter argument to validate * @throw std::invalid_argument unless stepsize_jitter is between 0 and * 1, inclusive */ static void validate(double stepsize_jitter) { if (!(stepsize_jitter >= 0 && stepsize_jitter <= 1)) throw std::invalid_argument( "stepsize_jitter must be between" " 0 and 1."); } /** * Return the default stepsize_jitter value. * * @return 0 */ static double default_value() { return 0; } }; } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_static_unit_e_adapt.hpp0000644000176200001440000000704013766554456027304 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_STATIC_UNIT_E_ADAPT_HPP #define STAN_SERVICES_SAMPLE_HMC_STATIC_UNIT_E_ADAPT_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs static HMC with unit Euclidean * metric with adaptation. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_unit_e_adapt( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, double delta, double gamma, double kappa, double t0, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); stan::mcmc::adapt_unit_e_static_hmc sampler(model, rng); sampler.set_nominal_stepsize_and_T(stepsize, int_time); sampler.set_stepsize_jitter(stepsize_jitter); sampler.get_stepsize_adaptation().set_mu(log(10 * stepsize)); sampler.get_stepsize_adaptation().set_delta(delta); sampler.get_stepsize_adaptation().set_gamma(gamma); sampler.get_stepsize_adaptation().set_kappa(kappa); sampler.get_stepsize_adaptation().set_t0(t0); util::run_adaptive_sampler( sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_nuts_diag_e_adapt.hpp0000644000176200001440000001613513766554456026740 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_NUTS_DIAG_E_ADAPT_HPP #define STAN_SERVICES_SAMPLE_HMC_NUTS_DIAG_E_ADAPT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs HMC with NUTS with adaptation using diagonal Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial diagonal inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_diag_e_adapt( Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::VectorXd inv_metric; try { inv_metric = util::read_diag_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_diag_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::adapt_diag_e_nuts sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize(stepsize); sampler.set_stepsize_jitter(stepsize_jitter); sampler.set_max_depth(max_depth); sampler.get_stepsize_adaptation().set_mu(log(10 * stepsize)); sampler.get_stepsize_adaptation().set_delta(delta); sampler.get_stepsize_adaptation().set_gamma(gamma); sampler.get_stepsize_adaptation().set_kappa(kappa); sampler.get_stepsize_adaptation().set_t0(t0); sampler.set_window_params(num_warmup, init_buffer, term_buffer, window, logger); util::run_adaptive_sampler( sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs HMC with NUTS with adaptation using diagonal Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_diag_e_adapt( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_diag_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_nuts_diag_e_adapt( model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, max_depth, delta, gamma, kappa, t0, init_buffer, term_buffer, window, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_nuts_diag_e.hpp0000644000176200001440000001374713766554456025575 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_NUTS_DIAG_E_HPP #define STAN_SERVICES_SAMPLE_HMC_NUTS_DIAG_E_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs HMC with NUTS without adaptation using diagonal Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial diagonal inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_diag_e(Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::VectorXd inv_metric; try { inv_metric = util::read_diag_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_diag_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::diag_e_nuts sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize(stepsize); sampler.set_stepsize_jitter(stepsize_jitter); sampler.set_max_depth(max_depth); util::run_sampler(sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs HMC with NUTS without adaptation using diagonal Euclidean metric, * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_diag_e(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_diag_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_nuts_diag_e(model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, max_depth, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_static_dense_e.hpp0000644000176200001440000001325013766554456026252 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_STATIC_DENSE_E_HPP #define STAN_SERVICES_SAMPLE_HMC_STATIC_DENSE_E_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs static HMC without adaptation using dense Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial diagonal inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_dense_e( Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::MatrixXd inv_metric; try { inv_metric = util::read_dense_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_dense_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::dense_e_static_hmc sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize_and_T(stepsize, int_time); sampler.set_stepsize_jitter(stepsize_jitter); util::run_sampler(sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs static HMC without adaptation using dense Euclidean metric, * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_dense_e( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_dense_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_static_dense_e(model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, int_time, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_static_unit_e.hpp0000644000176200001440000000610213766554456026131 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_STATIC_UNIT_E_HPP #define STAN_SERVICES_SAMPLE_HMC_STATIC_UNIT_E_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs static HMC with unit Euclidean * metric without adaptation. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_unit_e(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); stan::mcmc::unit_e_static_hmc sampler(model, rng); sampler.set_nominal_stepsize_and_T(stepsize, int_time); sampler.set_stepsize_jitter(stepsize_jitter); util::run_sampler(sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_nuts_unit_e_adapt.hpp0000644000176200001440000000665713766554456027023 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_NUTS_UNIT_E_ADAPT_HPP #define STAN_SERVICES_SAMPLE_HMC_NUTS_UNIT_E_ADAPT_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs HMC with NUTS with unit Euclidean * metric with adaptation. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_unit_e_adapt( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, double delta, double gamma, double kappa, double t0, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); stan::mcmc::adapt_unit_e_nuts sampler(model, rng); sampler.set_nominal_stepsize(stepsize); sampler.set_stepsize_jitter(stepsize_jitter); sampler.set_max_depth(max_depth); sampler.get_stepsize_adaptation().set_mu(log(10 * stepsize)); sampler.get_stepsize_adaptation().set_delta(delta); sampler.get_stepsize_adaptation().set_gamma(gamma); sampler.get_stepsize_adaptation().set_kappa(kappa); sampler.get_stepsize_adaptation().set_t0(t0); util::run_adaptive_sampler( sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_nuts_dense_e.hpp0000644000176200001440000001372513766554456025763 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_NUTS_DENSE_E_HPP #define STAN_SERVICES_SAMPLE_HMC_NUTS_DENSE_E_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs HMC with NUTS without adaptation using dense Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial dense inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_dense_e(Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::MatrixXd inv_metric; try { inv_metric = util::read_dense_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_dense_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::dense_e_nuts sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize(stepsize); sampler.set_stepsize_jitter(stepsize_jitter); sampler.set_max_depth(max_depth); util::run_sampler(sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs HMC with NUTS without adaptation using dense Euclidean metric, * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful * */ template int hmc_nuts_dense_e(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_dense_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_nuts_dense_e(model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, max_depth, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_nuts_dense_e_adapt.hpp0000644000176200001440000001621713766554456027133 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_NUTS_DENSE_E_ADAPT_HPP #define STAN_SERVICES_SAMPLE_HMC_NUTS_DENSE_E_ADAPT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs HMC with NUTS with adaptation using dense Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial dense inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_dense_e_adapt( Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::MatrixXd inv_metric; try { inv_metric = util::read_dense_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_dense_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::adapt_dense_e_nuts sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize(stepsize); sampler.set_stepsize_jitter(stepsize_jitter); sampler.set_max_depth(max_depth); sampler.get_stepsize_adaptation().set_mu(log(10 * stepsize)); sampler.get_stepsize_adaptation().set_delta(delta); sampler.get_stepsize_adaptation().set_gamma(gamma); sampler.get_stepsize_adaptation().set_kappa(kappa); sampler.get_stepsize_adaptation().set_t0(t0); sampler.set_window_params(num_warmup, init_buffer, term_buffer, window, logger); util::run_adaptive_sampler( sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs HMC with NUTS with adaptation using dense Euclidean metric, * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] max_depth Maximum tree depth * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_nuts_dense_e_adapt( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, int max_depth, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_dense_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_nuts_dense_e_adapt( model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, max_depth, delta, gamma, kappa, t0, init_buffer, term_buffer, window, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/standalone_gqs.hpp0000644000176200001440000001113313766554456025452 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_STANDALONE_GQS_HPP #define STAN_SERVICES_SAMPLE_STANDALONE_GQS_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { /** * Find the names, dimensions of the model parameters. * Assembles vectors of name, dimensions for the variables * declared in the parameters block. * * @tparam Model type of model * @param[in] model model to query * @param[in, out] param_names sequence of parameter names * @param[in, out] param_dimss seqeunce of variable dimensionalities */ template void get_model_parameters(const Model &model, std::vector ¶m_names, std::vector> ¶m_dimss) { std::vector constrained_names; model.constrained_param_names(constrained_names, false, false); size_t num_params = constrained_names.size(); std::vector> dimss; model.get_dims(dimss); size_t total = 0; for (size_t i = 0; i < dimss.size(); ++i) { param_dimss.emplace_back(dimss[i]); int cur_param = 1; for (int j = 0; j < dimss[i].size(); ++j) cur_param *= dimss[i][j]; if (cur_param == 1) { param_names.emplace_back(constrained_names[total]); } else { int idx = constrained_names[total].find('.'); param_names.emplace_back(constrained_names[total].substr(0, idx)); } total += cur_param; if (total == num_params) break; } } /** * Given a set of draws from a fitted model, generate corresponding * quantities of interes which are written to callback writer. * Matrix of draws consists of one row per draw, one column per parameter. * Draws are processed one row at a time. * Return code indicates success or type of error. * * @tparam Model model class * @param[in] model instantiated model * @param[in] draws sequence of draws of constrained parameters * @param[in] seed seed to use for randomization * @param[in, out] interrupt called every iteration * @param[in, out] logger logger to which to write warning and error messages * @param[in, out] sample_writer writer to which draws are written * @return error code */ template int standalone_generate(const Model &model, const Eigen::MatrixXd &draws, unsigned int seed, callbacks::interrupt &interrupt, callbacks::logger &logger, callbacks::writer &sample_writer) { if (draws.size() == 0) { logger.error("Empty set of draws from fitted model."); return error_codes::DATAERR; } std::vector p_names; model.constrained_param_names(p_names, false, false); std::vector gq_names; model.constrained_param_names(gq_names, false, true); if (!(p_names.size() < gq_names.size())) { logger.error("Model doesn't generate any quantities of interest."); return error_codes::CONFIG; } std::stringstream msg; if (p_names.size() != draws.cols()) { msg << "Wrong number of parameter values in draws from fitted model. "; msg << "Expecting " << p_names.size() << " columns, "; msg << "found " << draws.cols() << " columns."; std::string msgstr = msg.str(); logger.error(msgstr); return error_codes::DATAERR; } util::gq_writer writer(sample_writer, logger, p_names.size()); writer.write_gq_names(model); boost::ecuyer1988 rng = util::create_rng(seed, 1); std::vector param_names; std::vector> param_dimss; get_model_parameters(model, param_names, param_dimss); std::vector dummy_params_i; std::vector unconstrained_params_r; for (size_t i = 0; i < draws.rows(); ++i) { dummy_params_i.clear(); unconstrained_params_r.clear(); try { stan::io::array_var_context context(param_names, draws.row(i), param_dimss); model.transform_inits(context, dummy_params_i, unconstrained_params_r, &msg); } catch (const std::exception &e) { if (msg.str().length() > 0) logger.error(msg); logger.error(e.what()); return error_codes::DATAERR; } interrupt(); // call out to interrupt and fail writer.write_gq_values(model, rng, unconstrained_params_r); } return error_codes::OK; } } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_static_diag_e.hpp0000644000176200001440000001401613766554456026061 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_STATIC_DIAG_E_HPP #define STAN_SERVICES_SAMPLE_HMC_STATIC_DIAG_E_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs static HMC without adaptation using diagonal Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial diagonal inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_diag_e(Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::VectorXd inv_metric; try { inv_metric = util::read_diag_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_diag_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::diag_e_static_hmc sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize_and_T(stepsize, int_time); sampler.set_stepsize_jitter(stepsize_jitter); util::run_sampler(sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs static HMC without adaptation using diagonal Euclidean metric. * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_diag_e(Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_diag_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_static_diag_e(model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, int_time, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/src/stan/services/sample/hmc_static_diag_e_adapt.hpp0000644000176200001440000001631713766554456027240 0ustar liggesusers#ifndef STAN_SERVICES_SAMPLE_HMC_STATIC_DIAG_E_ADAPT_HPP #define STAN_SERVICES_SAMPLE_HMC_STATIC_DIAG_E_ADAPT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace services { namespace sample { /** * Runs static HMC with adaptation using diagonal Euclidean metric * with a pre-specified Euclidean metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] init_inv_metric var context exposing an initial diagonal inverse Euclidean metric (must be positive definite) * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_diag_e_adapt( Model& model, stan::io::var_context& init, stan::io::var_context& init_inv_metric, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { boost::ecuyer1988 rng = util::create_rng(random_seed, chain); std::vector disc_vector; std::vector cont_vector = util::initialize( model, init, rng, init_radius, true, logger, init_writer); Eigen::VectorXd inv_metric; try { inv_metric = util::read_diag_inv_metric(init_inv_metric, model.num_params_r(), logger); util::validate_diag_inv_metric(inv_metric, logger); } catch (const std::domain_error& e) { return error_codes::CONFIG; } stan::mcmc::adapt_diag_e_static_hmc sampler(model, rng); sampler.set_metric(inv_metric); sampler.set_nominal_stepsize_and_T(stepsize, int_time); sampler.set_stepsize_jitter(stepsize_jitter); sampler.get_stepsize_adaptation().set_mu(log(10 * stepsize)); sampler.get_stepsize_adaptation().set_delta(delta); sampler.get_stepsize_adaptation().set_gamma(gamma); sampler.get_stepsize_adaptation().set_kappa(kappa); sampler.get_stepsize_adaptation().set_t0(t0); sampler.set_window_params(num_warmup, init_buffer, term_buffer, window, logger); util::run_adaptive_sampler( sampler, model, cont_vector, num_warmup, num_samples, num_thin, refresh, save_warmup, rng, interrupt, logger, sample_writer, diagnostic_writer); return error_codes::OK; } /** * Runs static HMC with adaptation using diagonal Euclidean metric, * with identity matrix as initial inv_metric. * * @tparam Model Model class * @param[in] model Input model to test (with data already instantiated) * @param[in] init var context for initialization * @param[in] random_seed random seed for the random number generator * @param[in] chain chain id to advance the pseudo random number generator * @param[in] init_radius radius to initialize * @param[in] num_warmup Number of warmup samples * @param[in] num_samples Number of samples * @param[in] num_thin Number to thin the samples * @param[in] save_warmup Indicates whether to save the warmup iterations * @param[in] refresh Controls the output * @param[in] stepsize initial stepsize for discrete evolution * @param[in] stepsize_jitter uniform random jitter of stepsize * @param[in] int_time integration time * @param[in] delta adaptation target acceptance statistic * @param[in] gamma adaptation regularization scale * @param[in] kappa adaptation relaxation exponent * @param[in] t0 adaptation iteration offset * @param[in] init_buffer width of initial fast adaptation interval * @param[in] term_buffer width of final fast adaptation interval * @param[in] window initial width of slow adaptation interval * @param[in,out] interrupt Callback for interrupts * @param[in,out] logger Logger for messages * @param[in,out] init_writer Writer callback for unconstrained inits * @param[in,out] sample_writer Writer for draws * @param[in,out] diagnostic_writer Writer for diagnostic information * @return error_codes::OK if successful */ template int hmc_static_diag_e_adapt( Model& model, stan::io::var_context& init, unsigned int random_seed, unsigned int chain, double init_radius, int num_warmup, int num_samples, int num_thin, bool save_warmup, int refresh, double stepsize, double stepsize_jitter, double int_time, double delta, double gamma, double kappa, double t0, unsigned int init_buffer, unsigned int term_buffer, unsigned int window, callbacks::interrupt& interrupt, callbacks::logger& logger, callbacks::writer& init_writer, callbacks::writer& sample_writer, callbacks::writer& diagnostic_writer) { stan::io::dump dmp = util::create_unit_e_diag_inv_metric(model.num_params_r()); stan::io::var_context& unit_e_metric = dmp; return hmc_static_diag_e_adapt( model, init, unit_e_metric, random_seed, chain, init_radius, num_warmup, num_samples, num_thin, save_warmup, refresh, stepsize, stepsize_jitter, int_time, delta, gamma, kappa, t0, init_buffer, term_buffer, window, interrupt, logger, init_writer, sample_writer, diagnostic_writer); } } // namespace sample } // namespace services } // namespace stan #endif StanHeaders/inst/include/idas/0000755000176200001440000000000013766554135016012 5ustar liggesusersStanHeaders/inst/include/idas/idas_spils.h0000644000176200001440000001001213766554457020316 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated Scaled, Preconditioned Iterative * Linear Solver interface in IDAS; these routines now just wrap * the updated IDA generic linear solver interface in idas_ls.h. * -----------------------------------------------------------------*/ #ifndef _IDASSPILS_H #define _IDASSPILS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*=============================================================== Function Types (typedefs for equivalent types in idas_ls.h) ===============================================================*/ typedef IDALsPrecSetupFn IDASpilsPrecSetupFn; typedef IDALsPrecSolveFn IDASpilsPrecSolveFn; typedef IDALsJacTimesSetupFn IDASpilsJacTimesSetupFn; typedef IDALsJacTimesVecFn IDASpilsJacTimesVecFn; typedef IDALsPrecSetupFnB IDASpilsPrecSetupFnB; typedef IDALsPrecSetupFnBS IDASpilsPrecSetupFnBS; typedef IDALsPrecSolveFnB IDASpilsPrecSolveFnB; typedef IDALsPrecSolveFnBS IDASpilsPrecSolveFnBS; typedef IDALsJacTimesSetupFnB IDASpilsJacTimesSetupFnB; typedef IDALsJacTimesSetupFnBS IDASpilsJacTimesSetupFnBS; typedef IDALsJacTimesVecFnB IDASpilsJacTimesVecFnB; typedef IDALsJacTimesVecFnBS IDASpilsJacTimesVecFnBS; /*==================================================================== Exported Functions (wrappers for equivalent routines in idas_ls.h) ====================================================================*/ int IDASpilsSetLinearSolver(void *ida_mem, SUNLinearSolver LS); int IDASpilsSetPreconditioner(void *ida_mem, IDASpilsPrecSetupFn pset, IDASpilsPrecSolveFn psolve); int IDASpilsSetJacTimes(void *ida_mem, IDASpilsJacTimesSetupFn jtsetup, IDASpilsJacTimesVecFn jtimes); int IDASpilsSetEpsLin(void *ida_mem, realtype eplifac); int IDASpilsSetIncrementFactor(void *ida_mem, realtype dqincfac); int IDASpilsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); int IDASpilsGetNumPrecEvals(void *ida_mem, long int *npevals); int IDASpilsGetNumPrecSolves(void *ida_mem, long int *npsolves); int IDASpilsGetNumLinIters(void *ida_mem, long int *nliters); int IDASpilsGetNumConvFails(void *ida_mem, long int *nlcfails); int IDASpilsGetNumJTSetupEvals(void *ida_mem, long int *njtsetups); int IDASpilsGetNumJtimesEvals(void *ida_mem, long int *njvevals); int IDASpilsGetNumResEvals(void *ida_mem, long int *nrevalsLS); int IDASpilsGetLastFlag(void *ida_mem, long int *flag); char *IDASpilsGetReturnFlagName(long int flag); int IDASpilsSetLinearSolverB(void *ida_mem, int which, SUNLinearSolver LS); int IDASpilsSetEpsLinB(void *ida_mem, int which, realtype eplifacB); int IDASpilsSetIncrementFactorB(void *ida_mem, int which, realtype dqincfacB); int IDASpilsSetPreconditionerB(void *ida_mem, int which, IDASpilsPrecSetupFnB psetB, IDASpilsPrecSolveFnB psolveB); int IDASpilsSetPreconditionerBS(void *ida_mem, int which, IDASpilsPrecSetupFnBS psetBS, IDASpilsPrecSolveFnBS psolveBS); int IDASpilsSetJacTimesB(void *ida_mem, int which, IDASpilsJacTimesSetupFnB jtsetupB, IDASpilsJacTimesVecFnB jtimesB); int IDASpilsSetJacTimesBS(void *ida_mem, int which, IDASpilsJacTimesSetupFnBS jtsetupBS, IDASpilsJacTimesVecFnBS jtimesBS); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/idas/idas_direct.h0000644000176200001440000000423613766554457020451 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * Header file for the deprecated direct linear solver interface in * IDA; these routines now just wrap the updated IDA generic * linear solver interface in idas_ls.h. * -----------------------------------------------------------------*/ #ifndef _IDADLS_H #define _IDADLS_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= Function Types (typedefs for equivalent types in ida_ls.h) =================================================================*/ typedef IDALsJacFn IDADlsJacFn; typedef IDALsJacFnB IDADlsJacFnB; typedef IDALsJacFnBS IDADlsJacFnBS; /*=================================================================== Exported Functions (wrappers for equivalent routines in idas_ls.h) ===================================================================*/ int IDADlsSetLinearSolver(void *ida_mem, SUNLinearSolver LS, SUNMatrix A); int IDADlsSetJacFn(void *ida_mem, IDADlsJacFn jac); int IDADlsGetWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); int IDADlsGetNumJacEvals(void *ida_mem, long int *njevals); int IDADlsGetNumResEvals(void *ida_mem, long int *nrevalsLS); int IDADlsGetLastFlag(void *ida_mem, long int *flag); char *IDADlsGetReturnFlagName(long int flag); int IDADlsSetLinearSolverB(void *ida_mem, int which, SUNLinearSolver LS, SUNMatrix A); int IDADlsSetJacFnB(void *ida_mem, int which, IDADlsJacFnB jacB); int IDADlsSetJacFnBS(void *ida_mem, int which, IDADlsJacFnBS jacBS); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/idas/idas_bbdpre.h0000644000176200001440000000665613766554457020445 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU, * Alan C. Hindmarsh, Radu Serban and Aaron Collier @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the IDABBDPRE module, for a * band-block-diagonal preconditioner, i.e. a block-diagonal * matrix with banded blocks. * -----------------------------------------------------------------*/ #ifndef _IDASBBDPRE_H #define _IDASBBDPRE_H #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*----------------- FORWARD PROBLEMS -----------------*/ /* User-supplied function Types */ typedef int (*IDABBDLocalFn)(sunindextype Nlocal, realtype tt, N_Vector yy, N_Vector yp, N_Vector gval, void *user_data); typedef int (*IDABBDCommFn)(sunindextype Nlocal, realtype tt, N_Vector yy, N_Vector yp, void *user_data); /* Exported Functions */ SUNDIALS_EXPORT int IDABBDPrecInit(void *ida_mem, sunindextype Nlocal, sunindextype mudq, sunindextype mldq, sunindextype mukeep, sunindextype mlkeep, realtype dq_rel_yy, IDABBDLocalFn Gres, IDABBDCommFn Gcomm); SUNDIALS_EXPORT int IDABBDPrecReInit(void *ida_mem, sunindextype mudq, sunindextype mldq, realtype dq_rel_yy); /* Optional output functions */ SUNDIALS_EXPORT int IDABBDPrecGetWorkSpace(void *ida_mem, long int *lenrwBBDP, long int *leniwBBDP); SUNDIALS_EXPORT int IDABBDPrecGetNumGfnEvals(void *ida_mem, long int *ngevalsBBDP); /*------------------ BACKWARD PROBLEMS ------------------*/ /* User-Supplied Function Types */ typedef int (*IDABBDLocalFnB)(sunindextype NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector gvalB, void *user_dataB); typedef int (*IDABBDCommFnB)(sunindextype NlocalB, realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, void *user_dataB); /* Exported Functions */ SUNDIALS_EXPORT int IDABBDPrecInitB(void *ida_mem, int which, sunindextype NlocalB, sunindextype mudqB, sunindextype mldqB, sunindextype mukeepB, sunindextype mlkeepB, realtype dq_rel_yyB, IDABBDLocalFnB GresB, IDABBDCommFnB GcommB); SUNDIALS_EXPORT int IDABBDPrecReInitB(void *ida_mem, int which, sunindextype mudqB, sunindextype mldqB, realtype dq_rel_yyB); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/idas/idas_ls.h0000644000176200001440000002670213766554457017617 0ustar liggesusers/* ---------------------------------------------------------------- * Programmer(s): Daniel R. Reynolds @ SMU * Radu Serban @ LLNL * ---------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ---------------------------------------------------------------- * This is the header file for IDAS' linear solver interface. * ----------------------------------------------------------------*/ #ifndef _IDASLS_H #define _IDASLS_H #include #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /*================================================================= IDALS Constants =================================================================*/ #define IDALS_SUCCESS 0 #define IDALS_MEM_NULL -1 #define IDALS_LMEM_NULL -2 #define IDALS_ILL_INPUT -3 #define IDALS_MEM_FAIL -4 #define IDALS_PMEM_NULL -5 #define IDALS_JACFUNC_UNRECVR -6 #define IDALS_JACFUNC_RECVR -7 #define IDALS_SUNMAT_FAIL -8 #define IDALS_SUNLS_FAIL -9 /* Return values for the adjoint module */ #define IDALS_NO_ADJ -101 #define IDALS_LMEMB_NULL -102 /*================================================================= Forward problems =================================================================*/ /*================================================================= IDALS user-supplied function prototypes =================================================================*/ typedef int (*IDALsJacFn)(realtype t, realtype c_j, N_Vector y, N_Vector yp, N_Vector r, SUNMatrix Jac, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); typedef int (*IDALsPrecSetupFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data); typedef int (*IDALsPrecSolveFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector rvec, N_Vector zvec, realtype c_j, realtype delta, void *user_data); typedef int (*IDALsJacTimesSetupFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, realtype c_j, void *user_data); typedef int (*IDALsJacTimesVecFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, N_Vector v, N_Vector Jv, realtype c_j, void *user_data, N_Vector tmp1, N_Vector tmp2); /*================================================================= IDALS Exported functions =================================================================*/ SUNDIALS_EXPORT int IDASetLinearSolver(void *ida_mem, SUNLinearSolver LS, SUNMatrix A); /*----------------------------------------------------------------- Optional inputs to the IDALS linear solver interface -----------------------------------------------------------------*/ SUNDIALS_EXPORT int IDASetJacFn(void *ida_mem, IDALsJacFn jac); SUNDIALS_EXPORT int IDASetPreconditioner(void *ida_mem, IDALsPrecSetupFn pset, IDALsPrecSolveFn psolve); SUNDIALS_EXPORT int IDASetJacTimes(void *ida_mem, IDALsJacTimesSetupFn jtsetup, IDALsJacTimesVecFn jtimes); SUNDIALS_EXPORT int IDASetEpsLin(void *ida_mem, realtype eplifac); SUNDIALS_EXPORT int IDASetIncrementFactor(void *ida_mem, realtype dqincfac); /*----------------------------------------------------------------- Optional outputs from the IDALS linear solver interface -----------------------------------------------------------------*/ SUNDIALS_EXPORT int IDAGetLinWorkSpace(void *ida_mem, long int *lenrwLS, long int *leniwLS); SUNDIALS_EXPORT int IDAGetNumJacEvals(void *ida_mem, long int *njevals); SUNDIALS_EXPORT int IDAGetNumPrecEvals(void *ida_mem, long int *npevals); SUNDIALS_EXPORT int IDAGetNumPrecSolves(void *ida_mem, long int *npsolves); SUNDIALS_EXPORT int IDAGetNumLinIters(void *ida_mem, long int *nliters); SUNDIALS_EXPORT int IDAGetNumLinConvFails(void *ida_mem, long int *nlcfails); SUNDIALS_EXPORT int IDAGetNumJTSetupEvals(void *ida_mem, long int *njtsetups); SUNDIALS_EXPORT int IDAGetNumJtimesEvals(void *ida_mem, long int *njvevals); SUNDIALS_EXPORT int IDAGetNumLinResEvals(void *ida_mem, long int *nrevalsLS); SUNDIALS_EXPORT int IDAGetLastLinFlag(void *ida_mem, long int *flag); SUNDIALS_EXPORT char *IDAGetLinReturnFlagName(long int flag); /*================================================================= Backward problems =================================================================*/ /*================================================================= IDALS user-supplied function prototypes =================================================================*/ typedef int (*IDALsJacFnB)(realtype tt, realtype c_jB, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, SUNMatrix JacB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); typedef int (*IDALsJacFnBS)(realtype tt, realtype c_jB, N_Vector yy, N_Vector yp, N_Vector *yS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, SUNMatrix JacB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B, N_Vector tmp3B); typedef int (*IDALsPrecSetupFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB); typedef int (*IDALsPrecSetupFnBS)(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB); typedef int (*IDALsPrecSolveFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *user_dataB); typedef int (*IDALsPrecSolveFnBS)(realtype tt, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector rvecB, N_Vector zvecB, realtype c_jB, realtype deltaB, void *user_dataB); typedef int (*IDALsJacTimesSetupFnB)(realtype t, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB); typedef int (*IDALsJacTimesSetupFnBS)(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, realtype c_jB, void *user_dataB); typedef int (*IDALsJacTimesVecFnB)(realtype t, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B); typedef int (*IDALsJacTimesVecFnBS)(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrB, N_Vector vB, N_Vector JvB, realtype c_jB, void *user_dataB, N_Vector tmp1B, N_Vector tmp2B); /*================================================================= IDALS Exported functions =================================================================*/ SUNDIALS_EXPORT int IDASetLinearSolverB(void *ida_mem, int which, SUNLinearSolver LS, SUNMatrix A); /*----------------------------------------------------------------- Each IDASet***B or IDASet***BS function below links the main IDAS integrator with the corresponding IDALS optional input function for the backward integration. The 'which' argument is the int returned by IDACreateB. -----------------------------------------------------------------*/ SUNDIALS_EXPORT int IDASetJacFnB(void *ida_mem, int which, IDALsJacFnB jacB); SUNDIALS_EXPORT int IDASetJacFnBS(void *ida_mem, int which, IDALsJacFnBS jacBS); SUNDIALS_EXPORT int IDASetEpsLinB(void *ida_mem, int which, realtype eplifacB); SUNDIALS_EXPORT int IDASetIncrementFactorB(void *ida_mem, int which, realtype dqincfacB); SUNDIALS_EXPORT int IDASetPreconditionerB(void *ida_mem, int which, IDALsPrecSetupFnB psetB, IDALsPrecSolveFnB psolveB); SUNDIALS_EXPORT int IDASetPreconditionerBS(void *ida_mem, int which, IDALsPrecSetupFnBS psetBS, IDALsPrecSolveFnBS psolveBS); SUNDIALS_EXPORT int IDASetJacTimesB(void *ida_mem, int which, IDALsJacTimesSetupFnB jtsetupB, IDALsJacTimesVecFnB jtimesB); SUNDIALS_EXPORT int IDASetJacTimesBS(void *ida_mem, int which, IDALsJacTimesSetupFnBS jtsetupBS, IDALsJacTimesVecFnBS jtimesBS); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/idas/idas.h0000644000176200001440000006034613766554457017123 0ustar liggesusers/* ----------------------------------------------------------------- * Programmer(s): Radu Serban @ LLNL * ----------------------------------------------------------------- * SUNDIALS Copyright Start * Copyright (c) 2002-2019, Lawrence Livermore National Security * and Southern Methodist University. * All rights reserved. * * See the top-level LICENSE and NOTICE files for details. * * SPDX-License-Identifier: BSD-3-Clause * SUNDIALS Copyright End * ----------------------------------------------------------------- * This is the header file for the main IDAS solver. * -----------------------------------------------------------------*/ #ifndef _IDAS_H #define _IDAS_H #include #include #include #include #ifdef __cplusplus /* wrapper to enable C++ usage */ extern "C" { #endif /* ----------------- * IDAS Constants * ----------------- */ /* itask */ #define IDA_NORMAL 1 #define IDA_ONE_STEP 2 /* icopt */ #define IDA_YA_YDP_INIT 1 #define IDA_Y_INIT 2 /* ism */ #define IDA_SIMULTANEOUS 1 #define IDA_STAGGERED 2 /* DQtype */ #define IDA_CENTERED 1 #define IDA_FORWARD 2 /* interp */ #define IDA_HERMITE 1 #define IDA_POLYNOMIAL 2 /* return values */ #define IDA_SUCCESS 0 #define IDA_TSTOP_RETURN 1 #define IDA_ROOT_RETURN 2 #define IDA_WARNING 99 #define IDA_TOO_MUCH_WORK -1 #define IDA_TOO_MUCH_ACC -2 #define IDA_ERR_FAIL -3 #define IDA_CONV_FAIL -4 #define IDA_LINIT_FAIL -5 #define IDA_LSETUP_FAIL -6 #define IDA_LSOLVE_FAIL -7 #define IDA_RES_FAIL -8 #define IDA_REP_RES_ERR -9 #define IDA_RTFUNC_FAIL -10 #define IDA_CONSTR_FAIL -11 #define IDA_FIRST_RES_FAIL -12 #define IDA_LINESEARCH_FAIL -13 #define IDA_NO_RECOVERY -14 #define IDA_NLS_INIT_FAIL -15 #define IDA_NLS_SETUP_FAIL -16 #define IDA_MEM_NULL -20 #define IDA_MEM_FAIL -21 #define IDA_ILL_INPUT -22 #define IDA_NO_MALLOC -23 #define IDA_BAD_EWT -24 #define IDA_BAD_K -25 #define IDA_BAD_T -26 #define IDA_BAD_DKY -27 #define IDA_VECTOROP_ERR -28 #define IDA_NO_QUAD -30 #define IDA_QRHS_FAIL -31 #define IDA_FIRST_QRHS_ERR -32 #define IDA_REP_QRHS_ERR -33 #define IDA_NO_SENS -40 #define IDA_SRES_FAIL -41 #define IDA_REP_SRES_ERR -42 #define IDA_BAD_IS -43 #define IDA_NO_QUADSENS -50 #define IDA_QSRHS_FAIL -51 #define IDA_FIRST_QSRHS_ERR -52 #define IDA_REP_QSRHS_ERR -53 #define IDA_UNRECOGNIZED_ERROR -99 /* adjoint return values */ #define IDA_NO_ADJ -101 #define IDA_NO_FWD -102 #define IDA_NO_BCK -103 #define IDA_BAD_TB0 -104 #define IDA_REIFWD_FAIL -105 #define IDA_FWD_FAIL -106 #define IDA_GETY_BADT -107 /* ------------------------------ * User-Supplied Function Types * ------------------------------ */ typedef int (*IDAResFn)(realtype tt, N_Vector yy, N_Vector yp, N_Vector rr, void *user_data); typedef int (*IDARootFn)(realtype t, N_Vector y, N_Vector yp, realtype *gout, void *user_data); typedef int (*IDAEwtFn)(N_Vector y, N_Vector ewt, void *user_data); typedef void (*IDAErrHandlerFn)(int error_code, const char *module, const char *function, char *msg, void *user_data); typedef int (*IDAQuadRhsFn)(realtype tres, N_Vector yy, N_Vector yp, N_Vector rrQ, void *user_data); typedef int (*IDASensResFn)(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector resval, N_Vector *yyS, N_Vector *ypS, N_Vector *resvalS, void *user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3); typedef int (*IDAQuadSensRhsFn)(int Ns, realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector rrQ, N_Vector *rhsvalQS, void *user_data, N_Vector yytmp, N_Vector yptmp, N_Vector tmpQS); typedef int (*IDAResFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rrB, void *user_dataB); typedef int (*IDAResFnBS)(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rrBS, void *user_dataB); typedef int (*IDAQuadRhsFnB)(realtype tt, N_Vector yy, N_Vector yp, N_Vector yyB, N_Vector ypB, N_Vector rhsvalBQ, void *user_dataB); typedef int (*IDAQuadRhsFnBS)(realtype t, N_Vector yy, N_Vector yp, N_Vector *yyS, N_Vector *ypS, N_Vector yyB, N_Vector ypB, N_Vector rhsvalBQS, void *user_dataB); /* --------------------------------------- * Exported Functions -- Forward Problems * --------------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT void *IDACreate(void); SUNDIALS_EXPORT int IDAInit(void *ida_mem, IDAResFn res, realtype t0, N_Vector yy0, N_Vector yp0); SUNDIALS_EXPORT int IDAReInit(void *ida_mem, realtype t0, N_Vector yy0, N_Vector yp0); /* Tolerance input functions */ SUNDIALS_EXPORT int IDASStolerances(void *ida_mem, realtype reltol, realtype abstol); SUNDIALS_EXPORT int IDASVtolerances(void *ida_mem, realtype reltol, N_Vector abstol); SUNDIALS_EXPORT int IDAWFtolerances(void *ida_mem, IDAEwtFn efun); /* Initial condition calculation function */ SUNDIALS_EXPORT int IDACalcIC(void *ida_mem, int icopt, realtype tout1); /* Initial condition calculation optional input functions */ SUNDIALS_EXPORT int IDASetNonlinConvCoefIC(void *ida_mem, realtype epiccon); SUNDIALS_EXPORT int IDASetMaxNumStepsIC(void *ida_mem, int maxnh); SUNDIALS_EXPORT int IDASetMaxNumJacsIC(void *ida_mem, int maxnj); SUNDIALS_EXPORT int IDASetMaxNumItersIC(void *ida_mem, int maxnit); SUNDIALS_EXPORT int IDASetLineSearchOffIC(void *ida_mem, booleantype lsoff); SUNDIALS_EXPORT int IDASetStepToleranceIC(void *ida_mem, realtype steptol); SUNDIALS_EXPORT int IDASetMaxBacksIC(void *ida_mem, int maxbacks); /* Optional input functions */ SUNDIALS_EXPORT int IDASetErrHandlerFn(void *ida_mem, IDAErrHandlerFn ehfun, void *eh_data); SUNDIALS_EXPORT int IDASetErrFile(void *ida_mem, FILE *errfp); SUNDIALS_EXPORT int IDASetUserData(void *ida_mem, void *user_data); SUNDIALS_EXPORT int IDASetMaxOrd(void *ida_mem, int maxord); SUNDIALS_EXPORT int IDASetMaxNumSteps(void *ida_mem, long int mxsteps); SUNDIALS_EXPORT int IDASetInitStep(void *ida_mem, realtype hin); SUNDIALS_EXPORT int IDASetMaxStep(void *ida_mem, realtype hmax); SUNDIALS_EXPORT int IDASetStopTime(void *ida_mem, realtype tstop); SUNDIALS_EXPORT int IDASetNonlinConvCoef(void *ida_mem, realtype epcon); SUNDIALS_EXPORT int IDASetMaxErrTestFails(void *ida_mem, int maxnef); SUNDIALS_EXPORT int IDASetMaxNonlinIters(void *ida_mem, int maxcor); SUNDIALS_EXPORT int IDASetMaxConvFails(void *ida_mem, int maxncf); SUNDIALS_EXPORT int IDASetSuppressAlg(void *ida_mem, booleantype suppressalg); SUNDIALS_EXPORT int IDASetId(void *ida_mem, N_Vector id); SUNDIALS_EXPORT int IDASetConstraints(void *ida_mem, N_Vector constraints); SUNDIALS_EXPORT int IDASetNonlinearSolver(void *ida_mem, SUNNonlinearSolver NLS); /* Rootfinding initialization function */ SUNDIALS_EXPORT int IDARootInit(void *ida_mem, int nrtfn, IDARootFn g); /* Rootfinding optional input functions */ SUNDIALS_EXPORT int IDASetRootDirection(void *ida_mem, int *rootdir); SUNDIALS_EXPORT int IDASetNoInactiveRootWarn(void *ida_mem); /* Solver function */ SUNDIALS_EXPORT int IDASolve(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask); /* Dense output function */ SUNDIALS_EXPORT int IDAGetDky(void *ida_mem, realtype t, int k, N_Vector dky); /* Optional output functions */ SUNDIALS_EXPORT int IDAGetWorkSpace(void *ida_mem, long int *lenrw, long int *leniw); SUNDIALS_EXPORT int IDAGetNumSteps(void *ida_mem, long int *nsteps); SUNDIALS_EXPORT int IDAGetNumResEvals(void *ida_mem, long int *nrevals); SUNDIALS_EXPORT int IDAGetNumLinSolvSetups(void *ida_mem, long int *nlinsetups); SUNDIALS_EXPORT int IDAGetNumErrTestFails(void *ida_mem, long int *netfails); SUNDIALS_EXPORT int IDAGetNumBacktrackOps(void *ida_mem, long int *nbacktr); SUNDIALS_EXPORT int IDAGetConsistentIC(void *ida_mem, N_Vector yy0_mod, N_Vector yp0_mod); SUNDIALS_EXPORT int IDAGetLastOrder(void *ida_mem, int *klast); SUNDIALS_EXPORT int IDAGetCurrentOrder(void *ida_mem, int *kcur); SUNDIALS_EXPORT int IDAGetActualInitStep(void *ida_mem, realtype *hinused); SUNDIALS_EXPORT int IDAGetLastStep(void *ida_mem, realtype *hlast); SUNDIALS_EXPORT int IDAGetCurrentStep(void *ida_mem, realtype *hcur); SUNDIALS_EXPORT int IDAGetCurrentTime(void *ida_mem, realtype *tcur); SUNDIALS_EXPORT int IDAGetTolScaleFactor(void *ida_mem, realtype *tolsfact); SUNDIALS_EXPORT int IDAGetErrWeights(void *ida_mem, N_Vector eweight); SUNDIALS_EXPORT int IDAGetEstLocalErrors(void *ida_mem, N_Vector ele); SUNDIALS_EXPORT int IDAGetNumGEvals(void *ida_mem, long int *ngevals); SUNDIALS_EXPORT int IDAGetRootInfo(void *ida_mem, int *rootsfound); SUNDIALS_EXPORT int IDAGetIntegratorStats(void *ida_mem, long int *nsteps, long int *nrevals, long int *nlinsetups, long int *netfails, int *qlast, int *qcur, realtype *hinused, realtype *hlast, realtype *hcur, realtype *tcur); SUNDIALS_EXPORT int IDAGetNumNonlinSolvIters(void *ida_mem, long int *nniters); SUNDIALS_EXPORT int IDAGetNumNonlinSolvConvFails(void *ida_mem, long int *nncfails); SUNDIALS_EXPORT int IDAGetNonlinSolvStats(void *ida_mem, long int *nniters, long int *nncfails); SUNDIALS_EXPORT char *IDAGetReturnFlagName(long int flag); /* Free function */ SUNDIALS_EXPORT void IDAFree(void **ida_mem); /* --------------------------------- * Exported Functions -- Quadrature * --------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT int IDAQuadInit(void *ida_mem, IDAQuadRhsFn rhsQ, N_Vector yQ0); SUNDIALS_EXPORT int IDAQuadReInit(void *ida_mem, N_Vector yQ0); /* Tolerance input functions */ SUNDIALS_EXPORT int IDAQuadSStolerances(void *ida_mem, realtype reltolQ, realtype abstolQ); SUNDIALS_EXPORT int IDAQuadSVtolerances(void *ida_mem, realtype reltolQ, N_Vector abstolQ); /* Optional input specification functions */ SUNDIALS_EXPORT int IDASetQuadErrCon(void *ida_mem, booleantype errconQ); /* Extraction and dense output functions */ SUNDIALS_EXPORT int IDAGetQuad(void *ida_mem, realtype *t, N_Vector yQout); SUNDIALS_EXPORT int IDAGetQuadDky(void *ida_mem, realtype t, int k, N_Vector dky); /* Optional output specification functions */ SUNDIALS_EXPORT int IDAGetQuadNumRhsEvals(void *ida_mem, long int *nrhsQevals); SUNDIALS_EXPORT int IDAGetQuadNumErrTestFails(void *ida_mem, long int *nQetfails); SUNDIALS_EXPORT int IDAGetQuadErrWeights(void *ida_mem, N_Vector eQweight); SUNDIALS_EXPORT int IDAGetQuadStats(void *ida_mem, long int *nrhsQevals, long int *nQetfails); /* Free function */ SUNDIALS_EXPORT void IDAQuadFree(void *ida_mem); /* ------------------------------------ * Exported Functions -- Sensitivities * ------------------------------------ */ /* Initialization functions */ SUNDIALS_EXPORT int IDASensInit(void *ida_mem, int Ns, int ism, IDASensResFn resS, N_Vector *yS0, N_Vector *ypS0); SUNDIALS_EXPORT int IDASensReInit(void *ida_mem, int ism, N_Vector *yS0, N_Vector *ypS0); /* Tolerance input functions */ SUNDIALS_EXPORT int IDASensSStolerances(void *ida_mem, realtype reltolS, realtype *abstolS); SUNDIALS_EXPORT int IDASensSVtolerances(void *ida_mem, realtype reltolS, N_Vector *abstolS); SUNDIALS_EXPORT int IDASensEEtolerances(void *ida_mem); /* Initial condition calculation function */ SUNDIALS_EXPORT int IDAGetSensConsistentIC(void *ida_mem, N_Vector *yyS0, N_Vector *ypS0); /* Optional input specification functions */ SUNDIALS_EXPORT int IDASetSensDQMethod(void *ida_mem, int DQtype, realtype DQrhomax); SUNDIALS_EXPORT int IDASetSensErrCon(void *ida_mem, booleantype errconS); SUNDIALS_EXPORT int IDASetSensMaxNonlinIters(void *ida_mem, int maxcorS); SUNDIALS_EXPORT int IDASetSensParams(void *ida_mem, realtype *p, realtype *pbar, int *plist); /* Integrator nonlinear solver specification functions */ SUNDIALS_EXPORT int IDASetNonlinearSolverSensSim(void *ida_mem, SUNNonlinearSolver NLS); SUNDIALS_EXPORT int IDASetNonlinearSolverSensStg(void *ida_mem, SUNNonlinearSolver NLS); /* Enable/disable sensitivities */ SUNDIALS_EXPORT int IDASensToggleOff(void *ida_mem); /* Extraction and dense output functions */ SUNDIALS_EXPORT int IDAGetSens(void *ida_mem, realtype *tret, N_Vector *yySout); SUNDIALS_EXPORT int IDAGetSens1(void *ida_mem, realtype *tret, int is, N_Vector yySret); SUNDIALS_EXPORT int IDAGetSensDky(void *ida_mem, realtype t, int k, N_Vector *dkyS); SUNDIALS_EXPORT int IDAGetSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyS); /* Optional output specification functions */ SUNDIALS_EXPORT int IDAGetSensNumResEvals(void *ida_mem, long int *nresSevals); SUNDIALS_EXPORT int IDAGetNumResEvalsSens(void *ida_mem, long int *nresevalsS); SUNDIALS_EXPORT int IDAGetSensNumErrTestFails(void *ida_mem, long int *nSetfails); SUNDIALS_EXPORT int IDAGetSensNumLinSolvSetups(void *ida_mem, long int *nlinsetupsS); SUNDIALS_EXPORT int IDAGetSensErrWeights(void *ida_mem, N_Vector_S eSweight); SUNDIALS_EXPORT int IDAGetSensStats(void *ida_mem, long int *nresSevals, long int *nresevalsS, long int *nSetfails, long int *nlinsetupsS); SUNDIALS_EXPORT int IDAGetSensNumNonlinSolvIters(void *ida_mem, long int *nSniters); SUNDIALS_EXPORT int IDAGetSensNumNonlinSolvConvFails(void *ida_mem, long int *nSncfails); SUNDIALS_EXPORT int IDAGetSensNonlinSolvStats(void *ida_mem, long int *nSniters, long int *nSncfails); /* Free function */ SUNDIALS_EXPORT void IDASensFree(void *ida_mem); /* ------------------------------------------------------- * Exported Functions -- Sensitivity dependent quadrature * ------------------------------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT int IDAQuadSensInit(void *ida_mem, IDAQuadSensRhsFn resQS, N_Vector *yQS0); SUNDIALS_EXPORT int IDAQuadSensReInit(void *ida_mem, N_Vector *yQS0); /* Tolerance input functions */ SUNDIALS_EXPORT int IDAQuadSensSStolerances(void *ida_mem, realtype reltolQS, realtype *abstolQS); SUNDIALS_EXPORT int IDAQuadSensSVtolerances(void *ida_mem, realtype reltolQS, N_Vector *abstolQS); SUNDIALS_EXPORT int IDAQuadSensEEtolerances(void *ida_mem); /* Optional input specification functions */ SUNDIALS_EXPORT int IDASetQuadSensErrCon(void *ida_mem, booleantype errconQS); /* Extraction and dense output functions */ SUNDIALS_EXPORT int IDAGetQuadSens(void *ida_mem, realtype *tret, N_Vector *yyQSout); SUNDIALS_EXPORT int IDAGetQuadSens1(void *ida_mem, realtype *tret, int is, N_Vector yyQSret); SUNDIALS_EXPORT int IDAGetQuadSensDky(void *ida_mem, realtype t, int k, N_Vector *dkyQS); SUNDIALS_EXPORT int IDAGetQuadSensDky1(void *ida_mem, realtype t, int k, int is, N_Vector dkyQS); /* Optional output specification functions */ SUNDIALS_EXPORT int IDAGetQuadSensNumRhsEvals(void *ida_mem, long int *nrhsQSevals); SUNDIALS_EXPORT int IDAGetQuadSensNumErrTestFails(void *ida_mem, long int *nQSetfails); SUNDIALS_EXPORT int IDAGetQuadSensErrWeights(void *ida_mem, N_Vector *eQSweight); SUNDIALS_EXPORT int IDAGetQuadSensStats(void *ida_mem, long int *nrhsQSevals, long int *nQSetfails); /* Free function */ SUNDIALS_EXPORT void IDAQuadSensFree(void* ida_mem); /* ---------------------------------------- * Exported Functions -- Backward Problems * ---------------------------------------- */ /* Initialization functions */ SUNDIALS_EXPORT int IDAAdjInit(void *ida_mem, long int steps, int interp); SUNDIALS_EXPORT int IDAAdjReInit(void *ida_mem); SUNDIALS_EXPORT void IDAAdjFree(void *ida_mem); /* Backward Problem Setup Functions */ SUNDIALS_EXPORT int IDACreateB(void *ida_mem, int *which); SUNDIALS_EXPORT int IDAInitB(void *ida_mem, int which, IDAResFnB resB, realtype tB0, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDAInitBS(void *ida_mem, int which, IDAResFnBS resS, realtype tB0, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDAReInitB(void *ida_mem, int which, realtype tB0, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDASStolerancesB(void *ida_mem, int which, realtype relTolB, realtype absTolB); SUNDIALS_EXPORT int IDASVtolerancesB(void *ida_mem, int which, realtype relTolB, N_Vector absTolB); SUNDIALS_EXPORT int IDAQuadInitB(void *ida_mem, int which, IDAQuadRhsFnB rhsQB, N_Vector yQB0); SUNDIALS_EXPORT int IDAQuadInitBS(void *ida_mem, int which, IDAQuadRhsFnBS rhsQS, N_Vector yQB0); SUNDIALS_EXPORT int IDAQuadReInitB(void *ida_mem, int which, N_Vector yQB0); SUNDIALS_EXPORT int IDAQuadSStolerancesB(void *ida_mem, int which, realtype reltolQB, realtype abstolQB); SUNDIALS_EXPORT int IDAQuadSVtolerancesB(void *ida_mem, int which, realtype reltolQB, N_Vector abstolQB); /* Consistent IC calculation functions */ SUNDIALS_EXPORT int IDACalcICB (void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0); SUNDIALS_EXPORT int IDACalcICBS(void *ida_mem, int which, realtype tout1, N_Vector yy0, N_Vector yp0, N_Vector *yyS0, N_Vector *ypS0); /* Solver Function For Forward Problems */ SUNDIALS_EXPORT int IDASolveF(void *ida_mem, realtype tout, realtype *tret, N_Vector yret, N_Vector ypret, int itask, int *ncheckPtr); /* Solver Function For Backward Problems */ SUNDIALS_EXPORT int IDASolveB(void *ida_mem, realtype tBout, int itaskB); /* Optional Input Functions For Adjoint Problems */ SUNDIALS_EXPORT int IDAAdjSetNoSensi(void *ida_mem); SUNDIALS_EXPORT int IDASetUserDataB(void *ida_mem, int which, void *user_dataB); SUNDIALS_EXPORT int IDASetMaxOrdB(void *ida_mem, int which, int maxordB); SUNDIALS_EXPORT int IDASetMaxNumStepsB(void *ida_mem, int which, long int mxstepsB); SUNDIALS_EXPORT int IDASetInitStepB(void *ida_mem, int which, realtype hinB); SUNDIALS_EXPORT int IDASetMaxStepB(void *ida_mem, int which, realtype hmaxB); SUNDIALS_EXPORT int IDASetSuppressAlgB(void *ida_mem, int which, booleantype suppressalgB); SUNDIALS_EXPORT int IDASetIdB(void *ida_mem, int which, N_Vector idB); SUNDIALS_EXPORT int IDASetConstraintsB(void *ida_mem, int which, N_Vector constraintsB); SUNDIALS_EXPORT int IDASetQuadErrConB(void *ida_mem, int which, int errconQB); SUNDIALS_EXPORT int IDASetNonlinearSolverB(void *ida_mem, int which, SUNNonlinearSolver NLS); /* Extraction And Dense Output Functions For Backward Problems */ SUNDIALS_EXPORT int IDAGetB(void* ida_mem, int which, realtype *tret, N_Vector yy, N_Vector yp); SUNDIALS_EXPORT int IDAGetQuadB(void *ida_mem, int which, realtype *tret, N_Vector qB); /* Optional Output Functions For Backward Problems */ SUNDIALS_EXPORT void *IDAGetAdjIDABmem(void *ida_mem, int which); SUNDIALS_EXPORT int IDAGetConsistentICB(void *ida_mem, int which, N_Vector yyB0, N_Vector ypB0); SUNDIALS_EXPORT int IDAGetAdjY(void *ida_mem, realtype t, N_Vector yy, N_Vector yp); typedef struct { void *my_addr; void *next_addr; realtype t0; realtype t1; long int nstep; int order; realtype step; } IDAadjCheckPointRec; SUNDIALS_EXPORT int IDAGetAdjCheckPointsInfo(void *ida_mem, IDAadjCheckPointRec *ckpnt); /* Undocumented Optional Output Functions For Backward Problems */ /* ----------------------------------------------------------------- * IDAGetAdjDataPointHermite * ----------------------------------------------------------------- * Returns the 2 vectors stored for cubic Hermite interpolation * at the data point 'which'. The user must allocate space for * yy and yd. Returns IDA_MEM_NULL if ida_mem is NULL, * IDA_ILL_INPUT if the interpolation type previously specified * is not IDA_HERMITE, or IDA_SUCCESS otherwise. * ----------------------------------------------------------------- * IDAGetAdjDataPointPolynomial * ----------------------------------------------------------------- * Returns the vector stored for polynomial interpolation * at the data point 'which'. The user must allocate space for * y. Returns IDA_MEM_NULL if ida_mem is NULL, IDA_ILL_INPUT if * the interpolation type previously specified is not * IDA_POLYNOMIAL, or IDA_SUCCESS otherwise. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetAdjDataPointHermite(void *ida_mem, int which, realtype *t, N_Vector yy, N_Vector yd); SUNDIALS_EXPORT int IDAGetAdjDataPointPolynomial(void *ida_mem, int which, realtype *t, int *order, N_Vector y); /* ----------------------------------------------------------------- * IDAGetAdjCurrentCheckPoint * Returns the address of the 'active' check point. * ----------------------------------------------------------------- */ SUNDIALS_EXPORT int IDAGetAdjCurrentCheckPoint(void *ida_mem, void **addr); #ifdef __cplusplus } #endif #endif StanHeaders/inst/include/stan/0000755000176200001440000000000013766554456016045 5ustar liggesusersStanHeaders/inst/include/stan/math/0000755000176200001440000000000013766604372016767 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/0000755000176200001440000000000013766554456017572 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/scal.hpp0000644000176200001440000001105013766554456021222 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_HPP #define STAN_MATH_REV_SCAL_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/rev/mat.hpp0000644000176200001440000000664313766554456021075 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_HPP #define STAN_MATH_REV_MAT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/rev/arr.hpp0000644000176200001440000000063613766554456021074 0ustar liggesusers#ifndef STAN_MATH_REV_ARR_HPP #define STAN_MATH_REV_ARR_HPP #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/rev/meta.hpp0000644000176200001440000000044413766554456021233 0ustar liggesusers#ifndef STAN_MATH_REV_META_HPP #define STAN_MATH_REV_META_HPP #include #include #include #include #endif StanHeaders/inst/include/stan/math/rev/mat/0000755000176200001440000000000013766604372020344 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/mat/fun/0000755000176200001440000000000013766554456021143 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/mat/fun/initialize_variable.hpp0000644000176200001440000000203013766554456025655 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_INITIALIZE_VARIABLE_HPP #define STAN_MATH_REV_MAT_FUN_INITIALIZE_VARIABLE_HPP #include #include #include #include namespace stan { namespace math { /** * Initialize variable to value. (Function may look pointless, but * its needed to bottom out recursion.) */ inline void initialize_variable(var& variable, const var& value) { variable = value; } /** * Initialize every cell in the matrix to the specified value. * */ template inline void initialize_variable(Eigen::Matrix& matrix, const var& value) { matrix.fill(value); } /** * Initialize the variables in the standard vector recursively. */ template inline void initialize_variable(std::vector& variables, const var& value) { for (size_t i = 0; i < variables.size(); ++i) { initialize_variable(variables[i], value); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/crossprod.hpp0000644000176200001440000000106013766554456023667 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_CROSSPROD_HPP #define STAN_MATH_REV_MAT_FUN_CROSSPROD_HPP #include #include #include namespace stan { namespace math { /** * Returns the result of pre-multiplying a matrix by its * own transpose. * @param M Matrix to multiply. * @return Transpose of M times M */ inline matrix_v crossprod(const matrix_v& M) { return tcrossprod(static_cast(M.transpose())); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/columns_dot_product.hpp0000644000176200001440000000202013766554456025734 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_COLUMNS_DOT_PRODUCT_HPP #define STAN_MATH_REV_MAT_FUN_COLUMNS_DOT_PRODUCT_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { template > inline Eigen::Matrix, 1, C1> columns_dot_product( const Eigen::Matrix& v1, const Eigen::Matrix& v2) { check_matching_sizes("dot_product", "v1", v1, "v2", v2); Eigen::Matrix ret(1, v1.cols()); for (size_type j = 0; j < v1.cols(); ++j) { ret(j) = var(new internal::dot_product_vari(v1.col(j), v2.col(j))); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/positive_ordered_constrain.hpp0000644000176200001440000000537013766554456027307 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_POSITIVE_ORDERED_CONSTRAIN_HPP #define STAN_MATH_REV_MAT_FUN_POSITIVE_ORDERED_CONSTRAIN_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class positive_ordered_constrain_op { int N_; double* exp_x_; public: /** * Return an increasing positive ordered vector derived from the specified * free vector. The returned constrained vector will have the * same dimensionality as the specified free vector. * * @tparam size Number of arguments * @param needs_adj Boolean indicators of if adjoints of arguments will be * needed * @param x Free vector of scalars * @return Positive, increasing ordered vector */ template Eigen::VectorXd operator()(const std::array& needs_adj, const Eigen::VectorXd& x) { N_ = x.size(); Eigen::Matrix y(N_); if (N_ == 0) { return y; } exp_x_ = ChainableStack::instance_->memalloc_.alloc_array(N_); exp_x_[0] = exp(x[0]); y[0] = exp_x_[0]; for (int n = 1; n < N_; ++n) { exp_x_[n] = exp(x[n]); y[n] = y[n - 1] + exp_x_[n]; } return y; } /* * Compute the result of multiply the transpose of the adjoint vector times * the Jacobian of the positive_ordered_constrain operator. * * @tparam size Number of adjoints to return * @param needs_adj Boolean indicators of if adjoints of arguments will be * needed * @param adj Eigen::VectorXd of adjoints at the output of the softmax * @return Eigen::VectorXd of adjoints propagated through softmax operation */ template auto multiply_adjoint_jacobian(const std::array& needs_adj, const Eigen::VectorXd& adj) const { Eigen::VectorXd adj_times_jac(N_); double rolling_adjoint_sum = 0.0; for (int n = N_; --n >= 0;) { rolling_adjoint_sum += adj(n); adj_times_jac(n) = exp_x_[n] * rolling_adjoint_sum; } return std::make_tuple(adj_times_jac); } }; } // namespace internal /** * Return an increasing positive ordered vector derived from the specified * free vector. The returned constrained vector will have the * same dimensionality as the specified free vector. * * @param x Free vector of scalars * @return Positive, increasing ordered vector */ inline Eigen::Matrix positive_ordered_constrain( const Eigen::Matrix& x) { return adj_jac_apply(x); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/rows_dot_product.hpp0000644000176200001440000000171113766554456025254 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_ROWS_DOT_PRODUCT_HPP #define STAN_MATH_REV_MAT_FUN_ROWS_DOT_PRODUCT_HPP #include #include #include #include #include #include #include namespace stan { namespace math { template ...> inline Eigen::Matrix rows_dot_product( const Eigen::Matrix& v1, const Eigen::Matrix& v2) { check_matching_sizes("dot_product", "v1", v1, "v2", v2); Eigen::Matrix ret(v1.rows(), 1); for (size_type j = 0; j < v1.rows(); ++j) { ret(j) = var(new internal::dot_product_vari(v1.row(j), v2.row(j))); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/unit_vector_constrain.hpp0000644000176200001440000000617413766554456026305 0ustar liggesusers#ifndef STAN_MATH_PRIM_MAT_FUN_UNIT_VECTOR_CONSTRAIN_HPP #define STAN_MATH_PRIM_MAT_FUN_UNIT_VECTOR_CONSTRAIN_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class unit_vector_elt_vari : public vari { private: vari** y_; const double* unit_vector_y_; const int size_; const int idx_; const double norm_; public: unit_vector_elt_vari(double val, vari** y, const double* unit_vector_y, int size, int idx, double norm) : vari(val), y_(y), unit_vector_y_(unit_vector_y), size_(size), idx_(idx), norm_(norm) {} void chain() { const double cubed_norm = std::pow(norm_, 3); for (int m = 0; m < size_; ++m) { y_[m]->adj_ -= adj_ * unit_vector_y_[m] * unit_vector_y_[idx_] / cubed_norm; if (m == idx_) y_[m]->adj_ += adj_ / norm_; } } }; } // namespace internal /** * Return the unit length vector corresponding to the free vector y. * See https://en.wikipedia.org/wiki/N-sphere#Generating_random_points * * @param y vector of K unrestricted variables * @return Unit length vector of dimension K * @tparam T Scalar type. **/ template Eigen::Matrix unit_vector_constrain( const Eigen::Matrix& y) { check_vector("unit_vector", "y", y); check_nonzero_size("unit_vector", "y", y); vector_d y_d = y.val(); vari** y_vi_array = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari*) * y.size())); double* unit_vector_y_d_array = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * y_d.size())); Eigen::Map(y_vi_array, y.size()) = y.vi(); const double norm = y_d.norm(); check_positive_finite("unit_vector", "norm", norm); Eigen::Map unit_vecd(unit_vector_y_d_array, y.size()); unit_vecd = y_d / norm; Eigen::Matrix unit_vector_y(y.size()); for (int k = 0; k < y.size(); ++k) unit_vector_y.coeffRef(k) = var(new internal::unit_vector_elt_vari( unit_vecd[k], y_vi_array, unit_vector_y_d_array, y.size(), k, norm)); return unit_vector_y; } /** * Return the unit length vector corresponding to the free vector y. * See https://en.wikipedia.org/wiki/N-sphere#Generating_random_points * * @param y vector of K unrestricted variables * @return Unit length vector of dimension K * @param lp Log probability reference to increment. * @tparam T Scalar type. **/ template Eigen::Matrix unit_vector_constrain( const Eigen::Matrix& y, var& lp) { Eigen::Matrix x = unit_vector_constrain(y); lp -= 0.5 * dot_self(y); return x; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/columns_dot_self.hpp0000644000176200001440000000143313766554456025214 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_COLUMNS_DOT_SELF_HPP #define STAN_MATH_REV_MAT_FUN_COLUMNS_DOT_SELF_HPP #include #include #include #include #include namespace stan { namespace math { /** * Returns the dot product of each column of a matrix with itself. * @param x Matrix. * @tparam T scalar type */ template inline Eigen::Matrix columns_dot_self( const Eigen::Matrix& x) { Eigen::Matrix ret(1, x.cols()); for (size_type i = 0; i < x.cols(); i++) { ret(i) = var(new internal::dot_self_vari(x.col(i))); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/mdivide_left_tri.hpp0000644000176200001440000003215413766554456025172 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_TRI_HPP #define STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_TRI_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class mdivide_left_tri_vv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() double *A_; double *C_; vari **variRefA_; vari **variRefB_; vari **variRefC_; mdivide_left_tri_vv_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), C_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * B.rows() * B.cols()))), variRefA_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * (A.rows() + 1) / 2))), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))) { using Eigen::Map; size_t pos = 0; if (TriView == Eigen::Lower) { for (size_type j = 0; j < M_; j++) { for (size_type i = j; i < M_; i++) { variRefA_[pos++] = A(i, j).vi_; } } } else if (TriView == Eigen::Upper) { for (size_type j = 0; j < M_; j++) { for (size_type i = 0; i < j + 1; i++) { variRefA_[pos++] = A(i, j).vi_; } } } Map c_map(C_, M_, N_); Map a_map(A_, M_, M_); a_map = A.val(); c_map = B.val(); Map(variRefB_, M_, N_) = B.vi(); #ifdef STAN_OPENCL if (A.rows() >= opencl_context.tuning_opts().tri_inverse_size_worth_transfer) { matrix_cl A_cl(a_map, from_eigen_uplo_type(TriView)); matrix_cl C_cl(c_map); C_cl = tri_inverse(A_cl) * C_cl; c_map = from_matrix_cl(C_cl); } else { #endif c_map = a_map.template triangularView().solve(c_map); #ifdef STAN_OPENCL } #endif Map(variRefC_, M_, N_) = c_map.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { using Eigen::Map; matrix_d adjA; matrix_d adjB; #ifdef STAN_OPENCL if (M_ >= opencl_context.tuning_opts().tri_inverse_size_worth_transfer) { matrix_cl A_cl(A_, M_, M_, from_eigen_uplo_type(TriView)); matrix_cl C_cl(C_, M_, N_); matrix_cl variRefC_cl(Map(variRefC_, M_, N_).adj()); matrix_cl adjB_cl = transpose(tri_inverse(A_cl)) * variRefC_cl; matrix_cl adjA_cl = multiply(adjB_cl * transpose(C_cl), -1.0); adjA = from_matrix_cl(adjA_cl); adjB = from_matrix_cl(adjB_cl); } else { #endif adjB = Map(A_, M_, M_) .template triangularView() .transpose() .solve(Map(variRefC_, M_, N_).adj()); adjA = -adjB * Map(C_, M_, N_).transpose(); #ifdef STAN_OPENCL } #endif size_t pos = 0; if (TriView == Eigen::Lower) { for (size_type j = 0; j < adjA.cols(); j++) { for (size_type i = j; i < adjA.rows(); i++) { variRefA_[pos++]->adj_ += adjA(i, j); } } } else if (TriView == Eigen::Upper) { for (size_type j = 0; j < adjA.cols(); j++) { for (size_type i = 0; i < j + 1; i++) { variRefA_[pos++]->adj_ += adjA(i, j); } } } Map(variRefB_, M_, N_).adj() += adjB; } }; template class mdivide_left_tri_dv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() double *A_; double *C_; vari **variRefB_; vari **variRefC_; mdivide_left_tri_dv_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), C_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * B.rows() * B.cols()))), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))) { using Eigen::Map; Map(A_, M_, M_) = A; Map(variRefB_, M_, N_) = B.vi(); Map c_map(C_, M_, N_); c_map = B.val(); #ifdef STAN_OPENCL if (A.rows() >= opencl_context.tuning_opts().tri_inverse_size_worth_transfer) { matrix_cl A_cl(A, from_eigen_uplo_type(TriView)); matrix_cl C_cl(c_map); C_cl = tri_inverse(A_cl) * C_cl; c_map = from_matrix_cl(C_cl); } else { #endif c_map = Map(A_, M_, M_) .template triangularView() .solve(c_map); #ifdef STAN_OPENCL } #endif Map(variRefC_, M_, N_) = c_map.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { using Eigen::Map; #ifdef STAN_OPENCL if (M_ >= opencl_context.tuning_opts().tri_inverse_size_worth_transfer) { matrix_cl A_cl(A_, M_, M_, from_eigen_uplo_type(TriView)); matrix_cl C_cl(Map(variRefC_, M_, N_).adj()); A_cl = transpose(tri_inverse(A_cl)); matrix_cl res_cl = A_cl * C_cl; Map(variRefB_, M_, N_).adj() += from_matrix_cl(res_cl); } else { #endif Map(variRefB_, M_, N_).adj() += Map(A_, M_, M_) .template triangularView() .transpose() .solve(Map(variRefC_, M_, N_).adj()); #ifdef STAN_OPENCL } #endif } }; template class mdivide_left_tri_vd_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() double *A_; double *C_; vari **variRefA_; vari **variRefC_; mdivide_left_tri_vd_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), C_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * B.rows() * B.cols()))), variRefA_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * (A.rows() + 1) / 2))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))) { using Eigen::Map; using Eigen::Matrix; size_t pos = 0; if (TriView == Eigen::Lower) { for (size_type j = 0; j < M_; j++) { for (size_type i = j; i < M_; i++) { variRefA_[pos++] = A(i, j).vi_; } } } else if (TriView == Eigen::Upper) { for (size_type j = 0; j < M_; j++) { for (size_type i = 0; i < j + 1; i++) { variRefA_[pos++] = A(i, j).vi_; } } } Map Ad(A_, M_, M_); Map Cd(C_, M_, N_); Ad = A.val(); #ifdef STAN_OPENCL if (M_ >= opencl_context.tuning_opts().tri_inverse_size_worth_transfer) { matrix_cl A_cl(Ad, from_eigen_uplo_type(TriView)); matrix_cl B_cl(B); B_cl = tri_inverse(A_cl) * B_cl; Cd = from_matrix_cl(B_cl); } else { #endif Cd = Ad.template triangularView().solve(B); #ifdef STAN_OPENCL } #endif Map(variRefC_, M_, N_) = Cd.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { using Eigen::Map; using Eigen::Matrix; Matrix adjA(M_, M_); Matrix adjC(M_, N_); adjC = Map(variRefC_, M_, N_).adj(); #ifdef STAN_OPENCL if (M_ >= opencl_context.tuning_opts().tri_inverse_size_worth_transfer) { matrix_cl A_cl(A_, M_, M_, from_eigen_uplo_type(TriView)); matrix_cl C_cl(C_, M_, N_); matrix_cl adjC_cl(adjC); A_cl = transpose(tri_inverse(A_cl)); matrix_cl adjA_cl = multiply(A_cl * (adjC_cl * transpose(C_cl)), -1.0); adjA = from_matrix_cl(adjA_cl); } else { #endif adjA.noalias() = -Map >(A_, M_, M_) .template triangularView() .transpose() .solve(adjC * Map >(C_, M_, N_).transpose()); #ifdef STAN_OPENCL } #endif size_t pos = 0; if (TriView == Eigen::Lower) { for (size_type j = 0; j < adjA.cols(); j++) { for (size_type i = j; i < adjA.rows(); i++) { variRefA_[pos++]->adj_ += adjA(i, j); } } } else if (TriView == Eigen::Upper) { for (size_type j = 0; j < adjA.cols(); j++) { for (size_type i = 0; i < j + 1; i++) { variRefA_[pos++]->adj_ += adjA(i, j); } } } } }; } // namespace internal template inline Eigen::Matrix mdivide_left_tri( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left_tri", "A", A); check_multiplicable("mdivide_left_tri", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_tri_vv_vari *baseVari = new internal::mdivide_left_tri_vv_vari(A, b); res.vi() = Eigen::Map(&(baseVari->variRefC_[0]), b.rows(), b.cols()); return res; } template inline Eigen::Matrix mdivide_left_tri( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left_tri", "A", A); check_multiplicable("mdivide_left_tri", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_tri_dv_vari *baseVari = new internal::mdivide_left_tri_dv_vari(A, b); res.vi() = Eigen::Map(&(baseVari->variRefC_[0]), b.rows(), b.cols()); return res; } template inline Eigen::Matrix mdivide_left_tri( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left_tri", "A", A); check_multiplicable("mdivide_left_tri", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_tri_vd_vari *baseVari = new internal::mdivide_left_tri_vd_vari(A, b); res.vi() = Eigen::Map(&(baseVari->variRefC_[0]), b.rows(), b.cols()); return res; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/stan_print.hpp0000644000176200001440000000052113766554456024033 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_STAN_PRINT_HPP #define STAN_MATH_REV_MAT_FUN_STAN_PRINT_HPP #include #include #include namespace stan { namespace math { inline void stan_print(std::ostream* o, const var& x) { *o << x.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/mdivide_left_ldlt.hpp0000644000176200001440000002116513766554456025333 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_LDLT_HPP #define STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_LDLT_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class mdivide_left_ldlt_alloc : public chainable_alloc { public: virtual ~mdivide_left_ldlt_alloc() {} /** * This share_ptr is used to prevent copying the LDLT factorizations * for mdivide_left_ldlt(ldltA, b) when ldltA is a LDLT_factor. * The pointer is shared with the LDLT_factor class. **/ boost::shared_ptr > > ldltP_; Eigen::Matrix C_; }; /** * The vari for mdivide_left_ldlt(A, b) which handles the chain() call * for all elements of the result. This vari follows the pattern * used in the other matrix operations where there is one "master" * vari whose value is never used and a large number of "slave" varis * whose chain() functions are never called because their adjoints are * set by the "mater" vari. * * This class handles the var/var case. **/ template class mdivide_left_ldlt_vv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() vari **variRefB_; vari **variRefC_; mdivide_left_ldlt_alloc *alloc_; const LDLT_alloc *alloc_ldlt_; mdivide_left_ldlt_vv_vari(const LDLT_factor &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), alloc_(new mdivide_left_ldlt_alloc()), alloc_ldlt_(A.alloc_) { Eigen::Map(variRefB_, M_, N_) = B.vi(); alloc_->C_ = B.val(); alloc_ldlt_->ldlt_.solveInPlace(alloc_->C_); Eigen::Map(variRefC_, M_, N_) = alloc_->C_.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { matrix_d adjB = Eigen::Map(variRefC_, M_, N_).adj(); alloc_ldlt_->ldlt_.solveInPlace(adjB); const_cast(alloc_ldlt_->variA_).adj() -= adjB * alloc_->C_.transpose(); Eigen::Map(variRefB_, M_, N_).adj() += adjB; } }; /** * The vari for mdivide_left_ldlt(A, b) which handles the chain() call * for all elements of the result. This vari follows the pattern * used in the other matrix operations where there is one "master" * vari whose value is never used and a large number of "slave" varis * whose chain() functions are never called because their adjoints are * set by the "mater" vari. * * This class handles the double/var case. **/ template class mdivide_left_ldlt_dv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() vari **variRefB_; vari **variRefC_; mdivide_left_ldlt_alloc *alloc_; mdivide_left_ldlt_dv_vari(const LDLT_factor &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), alloc_(new mdivide_left_ldlt_alloc()) { Eigen::Map(variRefB_, M_, N_) = B.vi(); alloc_->C_ = B.val(); alloc_->ldltP_ = A.ldltP_; alloc_->ldltP_->solveInPlace(alloc_->C_); Eigen::Map(variRefC_, M_, N_) = alloc_->C_.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { matrix_d adjB = Eigen::Map(variRefC_, M_, N_).adj(); alloc_->ldltP_->solveInPlace(adjB); Eigen::Map(variRefB_, M_, N_).adj() += adjB; } }; /** * The vari for mdivide_left_ldlt(A, b) which handles the chain() call * for all elements of the result. This vari follows the pattern * used in the other matrix operations where there is one "master" * vari whose value is never used and a large number of "slave" varis * whose chain() functions are never called because their adjoints are * set by the "mater" vari. * * This class handles the var/double case. **/ template class mdivide_left_ldlt_vd_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() vari **variRefC_; mdivide_left_ldlt_alloc *alloc_; const LDLT_alloc *alloc_ldlt_; mdivide_left_ldlt_vd_vari(const LDLT_factor &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), alloc_(new mdivide_left_ldlt_alloc()), alloc_ldlt_(A.alloc_) { alloc_->C_ = B; alloc_ldlt_->ldlt_.solveInPlace(alloc_->C_); Eigen::Map(variRefC_, M_, N_) = alloc_->C_.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { matrix_d adjC = Eigen::Map(variRefC_, M_, N_).adj(); const_cast(alloc_ldlt_->variA_).adj() -= alloc_ldlt_->ldlt_.solve(adjC * alloc_->C_.transpose()); } }; } // namespace internal /** * Returns the solution of the system Ax=b given an LDLT_factor of A * @param A LDLT_factor * @param b Right hand side matrix or vector. * @return x = b A^-1, solution of the linear system. * @throws std::domain_error if rows of b don't match the size of A. */ template inline Eigen::Matrix mdivide_left_ldlt( const LDLT_factor &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_multiplicable("mdivide_left_ldlt", "A", A, "b", b); internal::mdivide_left_ldlt_vv_vari *baseVari = new internal::mdivide_left_ldlt_vv_vari(A, b); res.vi() = Eigen::Map(baseVari->variRefC_, res.rows(), res.cols()); return res; } /** * Returns the solution of the system Ax=b given an LDLT_factor of A * @param A LDLT_factor * @param b Right hand side matrix or vector. * @return x = b A^-1, solution of the linear system. * @throws std::domain_error if rows of b don't match the size of A. */ template inline Eigen::Matrix mdivide_left_ldlt( const LDLT_factor &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_multiplicable("mdivide_left_ldlt", "A", A, "b", b); internal::mdivide_left_ldlt_vd_vari *baseVari = new internal::mdivide_left_ldlt_vd_vari(A, b); res.vi() = Eigen::Map(baseVari->variRefC_, res.rows(), res.cols()); return res; } /** * Returns the solution of the system Ax=b given an LDLT_factor of A * @param A LDLT_factor * @param b Right hand side matrix or vector. * @return x = b A^-1, solution of the linear system. * @throws std::domain_error if rows of b don't match the size of A. */ template inline Eigen::Matrix mdivide_left_ldlt( const LDLT_factor &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_multiplicable("mdivide_left_ldlt", "A", A, "b", b); internal::mdivide_left_ldlt_dv_vari *baseVari = new internal::mdivide_left_ldlt_dv_vari(A, b); res.vi() = Eigen::Map(baseVari->variRefC_, res.rows(), res.cols()); return res; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/Eigen_NumTraits.hpp0000644000176200001440000002314713766554456024720 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_EIGEN_NUMTRAITS_HPP #define STAN_MATH_REV_MAT_FUN_EIGEN_NUMTRAITS_HPP #include #include #include #include #include namespace Eigen { /** * Numerical traits template override for Eigen for automatic * gradient variables. * * Documentation here: * http://eigen.tuxfamily.org/dox/structEigen_1_1NumTraits.html */ template <> struct NumTraits : GenericNumTraits { using Real = stan::math::var; using NonInteger = stan::math::var; using Nested = stan::math::var; /** * Return the precision for stan::math::var delegates * to precision for douboe. * * @return precision */ static inline stan::math::var dummy_precision() { return NumTraits::dummy_precision(); } enum { /** * stan::math::var is not complex. */ IsComplex = 0, /** * stan::math::var is not an integer. */ IsInteger = 0, /** * stan::math::var is signed. */ IsSigned = 1, /** * stan::math::var does not require initialization. */ RequireInitialization = 0, /** * Twice the cost of copying a double. */ ReadCost = 2 * NumTraits::ReadCost, /** * This is just forward cost, but it's the cost of a single * addition (plus memory overhead) in the forward direction. */ AddCost = NumTraits::AddCost, /** * Multiply cost is single multiply going forward, but there's * also memory allocation cost. */ MulCost = NumTraits::MulCost }; /** * Return the number of decimal digits that can be represented * without change. Delegates to * std::numeric_limits::digits10(). */ static int digits10() { return std::numeric_limits::digits10; } }; /** * Scalar product traits specialization for Eigen for reverse-mode * autodiff variables. */ template struct ScalarBinaryOpTraits { using ReturnType = stan::math::var; }; /** * Scalar product traits specialization for Eigen for reverse-mode * autodiff variables. */ template struct ScalarBinaryOpTraits { using ReturnType = stan::math::var; }; namespace internal { /** * Partial specialization of Eigen's remove_all struct to stop * Eigen removing pointer from vari* variables */ template <> struct remove_all { using type = stan::math::vari*; }; /** * Specialization of matrix-vector products for reverse-mode * autodiff variables. * * @tparam Index index type * @tparam LhsMapper left-hand side data and stride * @tparam CongjuageLhs left-hand side conjugacy flag * @tparam CongjuageRhs right-hand side conjugacy flag * @tparam RhsMapper right-hand side data and stride * @tparam Version integer version number */ template struct general_matrix_vector_product { using LhsScalar = stan::math::var; using RhsScalar = stan::math::var; using ResScalar = stan::math::var; enum { LhsStorageOrder = ColMajor }; EIGEN_DONT_INLINE static void run(Index rows, Index cols, const LhsMapper& lhsMapper, const RhsMapper& rhsMapper, ResScalar* res, Index resIncr, const ResScalar& alpha) { const LhsScalar* lhs = lhsMapper.data(); const Index lhsStride = lhsMapper.stride(); const RhsScalar* rhs = rhsMapper.data(); const Index rhsIncr = rhsMapper.stride(); run(rows, cols, lhs, lhsStride, rhs, rhsIncr, res, resIncr, alpha); } EIGEN_DONT_INLINE static void run(Index rows, Index cols, const LhsScalar* lhs, Index lhsStride, const RhsScalar* rhs, Index rhsIncr, ResScalar* res, Index resIncr, const ResScalar& alpha) { using stan::math::gevv_vvv_vari; using stan::math::var; for (Index i = 0; i < rows; ++i) { res[i * resIncr] += var( new gevv_vvv_vari(&alpha, &lhs[i], lhsStride, rhs, rhsIncr, cols)); } } }; template struct general_matrix_vector_product { using LhsScalar = stan::math::var; using RhsScalar = stan::math::var; using ResScalar = stan::math::var; enum { LhsStorageOrder = RowMajor }; EIGEN_DONT_INLINE static void run(Index rows, Index cols, const LhsMapper& lhsMapper, const RhsMapper& rhsMapper, ResScalar* res, Index resIncr, const RhsScalar& alpha) { const LhsScalar* lhs = lhsMapper.data(); const Index lhsStride = lhsMapper.stride(); const RhsScalar* rhs = rhsMapper.data(); const Index rhsIncr = rhsMapper.stride(); run(rows, cols, lhs, lhsStride, rhs, rhsIncr, res, resIncr, alpha); } EIGEN_DONT_INLINE static void run(Index rows, Index cols, const LhsScalar* lhs, Index lhsStride, const RhsScalar* rhs, Index rhsIncr, ResScalar* res, Index resIncr, const RhsScalar& alpha) { for (Index i = 0; i < rows; i++) { res[i * resIncr] += stan::math::var(new stan::math::gevv_vvv_vari( &alpha, (static_cast(LhsStorageOrder) == static_cast(ColMajor)) ? (&lhs[i]) : (&lhs[i * lhsStride]), (static_cast(LhsStorageOrder) == static_cast(ColMajor)) ? (lhsStride) : (1), rhs, rhsIncr, cols)); } } }; #if EIGEN_VERSION_AT_LEAST(3, 3, 8) template struct general_matrix_matrix_product< Index, stan::math::var, LhsStorageOrder, ConjugateLhs, stan::math::var, RhsStorageOrder, ConjugateRhs, ColMajor, ResInnerStride> { #else template struct general_matrix_matrix_product { #endif using LhsScalar = stan::math::var; using RhsScalar = stan::math::var; using ResScalar = stan::math::var; using Traits = gebp_traits; using LhsMapper = const_blas_data_mapper; using RhsMapper = const_blas_data_mapper; EIGEN_DONT_INLINE #if EIGEN_VERSION_AT_LEAST(3, 3, 8) static void run(Index rows, Index cols, Index depth, const LhsScalar* lhs, Index lhsStride, const RhsScalar* rhs, Index rhsStride, ResScalar* res, Index resIncr, Index resStride, const ResScalar& alpha, level3_blocking& /* blocking */, GemmParallelInfo* /* info = 0 */) #else static void run(Index rows, Index cols, Index depth, const LhsScalar* lhs, Index lhsStride, const RhsScalar* rhs, Index rhsStride, ResScalar* res, Index resStride, const ResScalar& alpha, level3_blocking& /* blocking */, GemmParallelInfo* /* info = 0 */) #endif { for (Index i = 0; i < cols; i++) { general_matrix_vector_product< Index, LhsScalar, LhsMapper, LhsStorageOrder, ConjugateLhs, RhsScalar, RhsMapper, ConjugateRhs>::run(rows, depth, lhs, lhsStride, &rhs[static_cast(RhsStorageOrder) == static_cast(ColMajor) ? i * rhsStride : i], static_cast(RhsStorageOrder) == static_cast(ColMajor) ? 1 : rhsStride, &res[i * resStride], 1, alpha); } } EIGEN_DONT_INLINE static void run(Index rows, Index cols, Index depth, const LhsMapper& lhsMapper, const RhsMapper& rhsMapper, ResScalar* res, Index resStride, const ResScalar& alpha, level3_blocking& blocking, GemmParallelInfo* info = 0) { const LhsScalar* lhs = lhsMapper.data(); const Index lhsStride = lhsMapper.stride(); const RhsScalar* rhs = rhsMapper.data(); const Index rhsStride = rhsMapper.stride(); run(rows, cols, depth, lhs, lhsStride, rhs, rhsStride, res, resStride, alpha, blocking, info); } }; } // namespace internal } // namespace Eigen #endif StanHeaders/inst/include/stan/math/rev/mat/fun/log_softmax.hpp0000644000176200001440000000542513766554456024204 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LOG_SOFTMAX_HPP #define STAN_MATH_REV_MAT_FUN_LOG_SOFTMAX_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class log_softmax_elt_vari : public vari { private: vari** alpha_; const double* softmax_alpha_; const int size_; // array sizes const int idx_; // in in softmax output public: log_softmax_elt_vari(double val, vari** alpha, const double* softmax_alpha, int size, int idx) : vari(val), alpha_(alpha), softmax_alpha_(softmax_alpha), size_(size), idx_(idx) {} void chain() { for (int m = 0; m < size_; ++m) { if (m == idx_) { alpha_[m]->adj_ += adj_ * (1 - softmax_alpha_[m]); } else { alpha_[m]->adj_ -= adj_ * softmax_alpha_[m]; } } } }; } // namespace internal /** * Return the softmax of the specified Eigen vector. Softmax is * guaranteed to return a simplex. * * The gradient calculations are unfolded. * * @param alpha Unconstrained input vector. * @return Softmax of the input. * @throw std::domain_error If the input vector is size 0. */ inline Eigen::Matrix log_softmax( const Eigen::Matrix& alpha) { const int a_size = alpha.size(); check_nonzero_size("log_softmax", "alpha", alpha); // TODO(carpenter): replace with array alloc vari** alpha_vi_array = reinterpret_cast(vari::operator new(sizeof(vari*) * a_size)); Eigen::Map(alpha_vi_array, a_size) = alpha.vi(); vector_d alpha_d = alpha.val(); // fold logic of math::softmax() and math::log_softmax() // to save computations vector_d diff = (alpha_d.array() - alpha_d.maxCoeff()); vector_d softmax_alpha_d = diff.array().exp(); double sum = softmax_alpha_d.sum(); softmax_alpha_d.array() /= sum; vector_d log_softmax_alpha_d = diff.array() - std::log(sum); // end fold // TODO(carpenter): replace with array alloc double* softmax_alpha_d_array = reinterpret_cast(vari::operator new(sizeof(double) * a_size)); Eigen::Map(softmax_alpha_d_array, a_size) = softmax_alpha_d; vector_v log_softmax_alpha(a_size); for (int k = 0; k < a_size; ++k) { log_softmax_alpha(k) = var(new internal::log_softmax_elt_vari( log_softmax_alpha_d[k], alpha_vi_array, softmax_alpha_d_array, a_size, k)); } return log_softmax_alpha; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/multiply_lower_tri_self_transpose.hpp0000644000176200001440000000310013766554456030722 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MULTIPLY_LOWER_TRI_SELF_TRANSPOSE_HPP #define STAN_MATH_REV_MAT_FUN_MULTIPLY_LOWER_TRI_SELF_TRANSPOSE_HPP #include #include #include #include #include #include namespace stan { namespace math { inline matrix_v multiply_lower_tri_self_transpose(const matrix_v& L) { // check_square("multiply_lower_tri_self_transpose", // L, "L", (double*)0); int K = L.rows(); int J = L.cols(); matrix_v LLt(K, K); if (K == 0) { return LLt; } // if (K == 1) { // LLt(0, 0) = L(0, 0) * L(0, 0); // return LLt; // } int Knz; if (K >= J) { Knz = (K - J) * J + (J * (J + 1)) / 2; } else { // if (K < J) Knz = (K * (K + 1)) / 2; } vari** vs = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(Knz * sizeof(vari*))); int pos = 0; for (int m = 0; m < K; ++m) { for (int n = 0; n < ((J < (m + 1)) ? J : (m + 1)); ++n) { vs[pos++] = L(m, n).vi_; } } for (int m = 0, mpos = 0; m < K; ++m, mpos += (J < m) ? J : m) { LLt(m, m) = var( new internal::dot_self_vari(vs + mpos, (J < (m + 1)) ? J : (m + 1))); for (int n = 0, npos = 0; n < m; ++n, npos += (J < n) ? J : n) { LLt(m, n) = LLt(n, m) = var(new internal::dot_product_vari( vs + mpos, vs + npos, (J < (n + 1)) ? J : (n + 1))); } } return LLt; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/sd.hpp0000644000176200001440000000461213766554456022265 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_SD_HPP #define STAN_MATH_REV_MAT_FUN_SD_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { // if x.size() = N, and x[i] = x[j] = // then lim sd(x) -> 0 [ d/dx[n] sd(x) ] = sqrt(N) / N inline var calc_sd(size_t size, const var* dtrs) { using std::sqrt; vari** varis = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(size * sizeof(vari*))); double* partials = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(size * sizeof(double))); Eigen::Map varis_map(varis, size); Eigen::Map dtrs_map(dtrs, size); Eigen::Map partials_map(partials, size); double size_m1 = size - 1; varis_map = dtrs_map.vi(); vector_d dtrs_val = dtrs_map.val(); double mean = dtrs_val.mean(); vector_d diff = dtrs_val.array() - mean; double sum_of_squares = diff.squaredNorm(); double sd = sqrt(sum_of_squares / size_m1); if (sum_of_squares < 1e-20) { partials_map.fill(inv_sqrt(static_cast(size))); } else { partials_map = diff.array() / (sd * size_m1); } return var(new stored_gradient_vari(sd, size, varis, partials)); } } // namespace internal /** * Return the sample standard deviation of the specified standard * vector. Raise domain error if size is not greater than zero. * * @param[in] v a vector * @return sample standard deviation of specified vector */ inline var sd(const std::vector& v) { check_nonzero_size("sd", "v", v); if (v.size() == 1) { return 0; } return internal::calc_sd(v.size(), &v[0]); } /* * Return the sample standard deviation of the specified vector, * row vector, or matrix. Raise domain error if size is not * greater than zero. * * @tparam R number of rows * @tparam C number of columns * @param[in] m input matrix * @return sample standard deviation of specified matrix */ template var sd(const Eigen::Matrix& m) { check_nonzero_size("sd", "m", m); if (m.size() == 1) { return 0; } return internal::calc_sd(m.size(), &m(0)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/mdivide_left_spd.hpp0000644000176200001440000001677213766554456025172 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_SPD_HPP #define STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_SPD_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class mdivide_left_spd_alloc : public chainable_alloc { public: virtual ~mdivide_left_spd_alloc() {} Eigen::LLT > llt_; Eigen::Matrix C_; }; template class mdivide_left_spd_vv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() vari **variRefA_; vari **variRefB_; vari **variRefC_; mdivide_left_spd_alloc *alloc_; mdivide_left_spd_vv_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), variRefA_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * A.cols()))), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), alloc_(new mdivide_left_spd_alloc()) { Eigen::Map(variRefA_, M_, M_) = A.vi(); Eigen::Map(variRefB_, M_, N_) = B.vi(); alloc_->C_ = B.val(); alloc_->llt_ = A.val().llt(); alloc_->llt_.solveInPlace(alloc_->C_); Eigen::Map(variRefC_, M_, N_) = alloc_->C_.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { matrix_d adjB = Eigen::Map(variRefC_, M_, N_).adj(); alloc_->llt_.solveInPlace(adjB); Eigen::Map(variRefA_, M_, M_).adj() -= adjB * alloc_->C_.transpose(); Eigen::Map(variRefB_, M_, N_).adj() += adjB; } }; template class mdivide_left_spd_dv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() vari **variRefB_; vari **variRefC_; mdivide_left_spd_alloc *alloc_; mdivide_left_spd_dv_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), alloc_(new mdivide_left_spd_alloc()) { alloc_->C_ = B.val(); Eigen::Map(variRefB_, M_, N_) = B.vi(); alloc_->llt_ = A.llt(); alloc_->llt_.solveInPlace(alloc_->C_); Eigen::Map(variRefC_, M_, N_) = alloc_->C_.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { matrix_d adjB = Eigen::Map(variRefC_, M_, N_).adj(); alloc_->llt_.solveInPlace(adjB); Eigen::Map(variRefB_, M_, N_).adj() += adjB; } }; template class mdivide_left_spd_vd_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() vari **variRefA_; vari **variRefC_; mdivide_left_spd_alloc *alloc_; mdivide_left_spd_vd_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), variRefA_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * A.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), alloc_(new mdivide_left_spd_alloc()) { Eigen::Map(variRefA_, M_, M_) = A.vi(); alloc_->llt_ = A.val().llt(); alloc_->C_ = alloc_->llt_.solve(B); Eigen::Map(variRefC_, M_, N_) = alloc_->C_.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { matrix_d adjC = Eigen::Map(variRefC_, M_, N_).adj(); Eigen::Map(variRefA_, M_, M_).adj() -= alloc_->llt_.solve(adjC * alloc_->C_.transpose()); } }; } // namespace internal template inline Eigen::Matrix mdivide_left_spd( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left_spd", "A", A); check_multiplicable("mdivide_left_spd", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_spd_vv_vari *baseVari = new internal::mdivide_left_spd_vv_vari(A, b); res.vi() = Eigen::Map(&baseVari->variRefC_[0], b.rows(), b.cols()); return res; } template inline Eigen::Matrix mdivide_left_spd( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left_spd", "A", A); check_multiplicable("mdivide_left_spd", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_spd_vd_vari *baseVari = new internal::mdivide_left_spd_vd_vari(A, b); res.vi() = Eigen::Map(&baseVari->variRefC_[0], b.rows(), b.cols()); return res; } template inline Eigen::Matrix mdivide_left_spd( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left_spd", "A", A); check_multiplicable("mdivide_left_spd", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_spd_dv_vari *baseVari = new internal::mdivide_left_spd_dv_vari(A, b); res.vi() = Eigen::Map(&baseVari->variRefC_[0], b.rows(), b.cols()); return res; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/ordered_constrain.hpp0000644000176200001440000000535013766554456025363 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_ORDERED_CONSTRAIN_HPP #define STAN_MATH_REV_MAT_FUN_ORDERED_CONSTRAIN_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class ordered_constrain_op { int N_; double* exp_x_; public: /** * Return an increasing ordered vector derived from the specified * free vector. The returned constrained vector will have the * same dimensionality as the specified free vector. * * @tparam size Number of arguments * @param needs_adj Boolean indicators of if adjoints of arguments will be * needed * @param x Free vector of scalars * @return Increasing ordered vector */ template Eigen::VectorXd operator()(const std::array& needs_adj, const Eigen::VectorXd& x) { N_ = x.size(); Eigen::Matrix y(N_); if (N_ == 0) { return y; } exp_x_ = ChainableStack::instance_->memalloc_.alloc_array(N_ - 1); y[0] = x[0]; for (int n = 1; n < N_; ++n) { exp_x_[n - 1] = exp(x[n]); y[n] = y[n - 1] + exp_x_[n - 1]; } return y; } /* * Compute the result of multiply the transpose of the adjoint vector times * the Jacobian of the ordered_constrain operator. * * @tparam size Number of adjoints to return * @param needs_adj Boolean indicators of if adjoints of arguments will be * needed * @param adj Eigen::VectorXd of adjoints at the output of the softmax * @return Eigen::VectorXd of adjoints propagated through softmax operation */ template auto multiply_adjoint_jacobian(const std::array& needs_adj, const Eigen::VectorXd& adj) const { Eigen::VectorXd adj_times_jac(N_); double rolling_adjoint_sum = 0.0; if (N_ > 0) { for (int n = N_ - 1; n > 0; --n) { rolling_adjoint_sum += adj(n); adj_times_jac(n) = exp_x_[n - 1] * rolling_adjoint_sum; } adj_times_jac(0) = rolling_adjoint_sum + adj(0); } return std::make_tuple(adj_times_jac); } }; } // namespace internal /** * Return an increasing ordered vector derived from the specified * free vector. The returned constrained vector will have the * same dimensionality as the specified free vector. * * @param x Free vector of scalars * @return Increasing ordered vector */ inline Eigen::Matrix ordered_constrain( const Eigen::Matrix& x) { return adj_jac_apply(x); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/LDLT_alloc.hpp0000644000176200001440000000270213766554456023566 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LDLT_ALLOC_HPP #define STAN_MATH_REV_MAT_FUN_LDLT_ALLOC_HPP #include #include #include namespace stan { namespace math { /** * This object stores the actual (double typed) LDLT factorization of * an Eigen::Matrix along with pointers to its vari's which allow the * *ldlt_ functions to save memory. It is derived from a chainable_alloc * object so that it is allocated on the stack but does not have a chain() * function called. * * This class should only be instantiated as part of an LDLT_factor object * and is only used in *ldlt_ functions. **/ template class LDLT_alloc : public chainable_alloc { public: LDLT_alloc() : N_(0) {} explicit LDLT_alloc(const Eigen::Matrix &A) : N_(0) { compute(A); } /** * Compute the LDLT factorization and store pointers to the * vari's of the matrix entries to be used when chain() is * called elsewhere. **/ inline void compute(const Eigen::Matrix &A) { N_ = A.rows(); variA_ = A.vi(); ldlt_.compute(A.val()); } // Compute the log(abs(det(A))). This is just a convenience function. inline double log_abs_det() const { return ldlt_.vectorD().array().log().sum(); } size_t N_; Eigen::LDLT > ldlt_; Eigen::Matrix variA_; }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/sum.hpp0000644000176200001440000000274513766554456022470 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_SUM_HPP #define STAN_MATH_REV_MAT_FUN_SUM_HPP #include #include #include #include namespace stan { namespace math { /** * Class for representing sums with constructors for Eigen. * The chain() method and member variables are * managed by the superclass sum_v_vari. */ class sum_eigen_v_vari : public sum_v_vari { protected: template inline static double sum_of_val(const Eigen::DenseBase& v) { return Eigen::Ref(v).val().sum(); } public: template explicit sum_eigen_v_vari(const Eigen::Matrix& v1) : sum_v_vari( sum_of_val(v1), reinterpret_cast(ChainableStack::instance_->memalloc_.alloc( v1.size() * sizeof(vari*))), v1.size()) { Eigen::Map(v_, v1.rows(), v1.cols()) = v1.vi(); } }; /** * Returns the sum of the coefficients of the specified * matrix, column vector or row vector. * * @tparam R Row type for matrix. * @tparam C Column type for matrix. * @param m Specified matrix or vector. * @return Sum of coefficients of matrix. */ template inline var sum(const Eigen::Matrix& m) { if (m.size() == 0) { return 0.0; } return var(new sum_eigen_v_vari(m)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/dot_product.hpp0000644000176200001440000001717413766554456024214 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_DOT_PRODUCT_HPP #define STAN_MATH_REV_MAT_FUN_DOT_PRODUCT_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template struct dot_product_store_type; template <> struct dot_product_store_type { using type = vari**; }; template <> struct dot_product_store_type { using type = double*; }; template class dot_product_vari : public vari { protected: typename dot_product_store_type::type v1_; typename dot_product_store_type::type v2_; size_t length_; inline static double var_dot(vari** v1, vari** v2, size_t length) { Eigen::Map vd1(v1, length); Eigen::Map vd2(v2, length); return vd1.val().dot(vd2.val()); } inline static double var_dot(const T1* v1, const T2* v2, size_t length) { Eigen::Map> vd1(v1, length); Eigen::Map> vd2(v2, length); return vd1.val().dot(vd2.val()); } template inline static double var_dot(const Eigen::DenseBase& v1, const Eigen::DenseBase& v2) { vector_d vd1 = Eigen::Ref>(v1) .val(); vector_d vd2 = Eigen::Ref>(v2) .val(); return vd1.dot(vd2); } inline void chain(vari** v1, vari** v2) { Eigen::Map vd1(v1, length_); Eigen::Map vd2(v2, length_); vd1.adj() += adj_ * vd2.val(); vd2.adj() += adj_ * vd1.val(); } inline void chain(double* v1, vari** v2) { Eigen::Map(v2, length_).adj() += adj_ * Eigen::Map(v1, length_); } inline void chain(vari** v1, double* v2) { Eigen::Map(v1, length_).adj() += adj_ * Eigen::Map(v2, length_); } inline void initialize(vari**& mem_v, const var* inv, vari** shared = nullptr) { if (shared == nullptr) { mem_v = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(vari*))); Eigen::Map(mem_v, length_) = Eigen::Map(inv, length_).vi(); } else { mem_v = shared; } } template inline void initialize(vari**& mem_v, const Eigen::DenseBase& inv, vari** shared = nullptr) { if (shared == nullptr) { mem_v = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(vari*))); Eigen::Map(mem_v, length_) = Eigen::Ref(inv).vi(); } else { mem_v = shared; } } inline void initialize(double*& mem_d, const double* ind, double* shared = nullptr) { if (shared == nullptr) { mem_d = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(double))); for (size_t i = 0; i < length_; i++) { mem_d[i] = ind[i]; } } else { mem_d = shared; } } template inline void initialize(double*& mem_d, const Eigen::DenseBase& ind, double* shared = nullptr) { if (shared == nullptr) { mem_d = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(double))); Eigen::Map(mem_d, length_) = Eigen::Ref(ind); } else { mem_d = shared; } } public: dot_product_vari(typename dot_product_store_type::type v1, typename dot_product_store_type::type v2, size_t length) : vari(var_dot(v1, v2, length)), v1_(v1), v2_(v2), length_(length) {} dot_product_vari(const T1* v1, const T2* v2, size_t length, dot_product_vari* shared_v1 = NULL, dot_product_vari* shared_v2 = NULL) : vari(var_dot(v1, v2, length)), length_(length) { if (shared_v1 == NULL) { initialize(v1_, v1); } else { initialize(v1_, v1, shared_v1->v1_); } if (shared_v2 == NULL) { initialize(v2_, v2); } else { initialize(v2_, v2, shared_v2->v2_); } } template dot_product_vari(const Eigen::DenseBase& v1, const Eigen::DenseBase& v2, dot_product_vari* shared_v1 = NULL, dot_product_vari* shared_v2 = NULL) : vari(var_dot(v1, v2)), length_(v1.size()) { if (shared_v1 == NULL) { initialize(v1_, v1); } else { initialize(v1_, v1, shared_v1->v1_); } if (shared_v2 == NULL) { initialize(v2_, v2); } else { initialize(v2_, v2, shared_v2->v2_); } } template dot_product_vari(const Eigen::Matrix& v1, const Eigen::Matrix& v2, dot_product_vari* shared_v1 = NULL, dot_product_vari* shared_v2 = NULL) : vari(var_dot(v1, v2)), length_(v1.size()) { if (shared_v1 == NULL) { initialize(v1_, v1); } else { initialize(v1_, v1, shared_v1->v1_); } if (shared_v2 == NULL) { initialize(v2_, v2); } else { initialize(v2_, v2, shared_v2->v2_); } } virtual void chain() { chain(v1_, v2_); } }; } // namespace internal /** * Returns the dot product. * * @param[in] v1 First column vector. * @param[in] v2 Second column vector. * @return Dot product of the vectors. * @throw std::domain_error if length of v1 is not equal to length of v2. */ template > inline return_type_t dot_product(const Eigen::Matrix& v1, const Eigen::Matrix& v2) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); check_matching_sizes("dot_product", "v1", v1, "v2", v2); return var(new internal::dot_product_vari(v1, v2)); } /** * Returns the dot product. * * @param[in] v1 First array. * @param[in] v2 Second array. * @param[in] length Length of both arrays. * @return Dot product of the arrays. */ template > inline return_type_t dot_product(const T1* v1, const T2* v2, size_t length) { return var(new internal::dot_product_vari(v1, v2, length)); } /** * Returns the dot product. * * @param[in] v1 First vector. * @param[in] v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error if sizes of v1 and v2 do not match. */ template > inline return_type_t dot_product(const std::vector& v1, const std::vector& v2) { check_matching_sizes("dot_product", "v1", v1, "v2", v2); return var(new internal::dot_product_vari(&v1[0], &v2[0], v1.size())); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/trace_gen_inv_quad_form_ldlt.hpp0000644000176200001440000000301213766554456027527 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TRACE_GEN_INV_QUAD_FORM_LDLT_HPP #define STAN_MATH_REV_MAT_FUN_TRACE_GEN_INV_QUAD_FORM_LDLT_HPP #include #include #include #include #include #include #include namespace stan { namespace math { /** * Compute the trace of an inverse quadratic form. I.E., this computes * trace(D B^T A^-1 B) * where D is a square matrix and the LDLT_factor of A is provided. **/ template ...> inline var trace_gen_inv_quad_form_ldlt(const Eigen::Matrix &D, const LDLT_factor &A, const Eigen::Matrix &B) { check_square("trace_gen_inv_quad_form_ldlt", "D", D); check_multiplicable("trace_gen_inv_quad_form_ldlt", "A", A, "B", B); check_multiplicable("trace_gen_inv_quad_form_ldlt", "B", B, "D", D); internal::trace_inv_quad_form_ldlt_impl *_impl = new internal::trace_inv_quad_form_ldlt_impl( D, A, B); return var( new internal::trace_inv_quad_form_ldlt_vari( _impl)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/scale_matrix_exp_multiply.hpp0000644000176200001440000000272013766554456027143 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_SCALE_MATRIX_EXP_MULTIPLY_HPP #define STAN_MATH_REV_MAT_FUN_SCALE_MATRIX_EXP_MULTIPLY_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Return product of exp(At) and B, where A is a NxN matrix, * B is a NxCb matrix, and t is a double * * @tparam Ta scalar type matrix A * @tparam Tb scalar type matrix B * @tparam Cb Columns matrix B * @param[in] A Matrix * @param[in] B Matrix * @param[in] t double * @return exponential of At multiplies B */ template inline Eigen::Matrix::type, -1, Cb> scale_matrix_exp_multiply(const double& t, const Eigen::Matrix& A, const Eigen::Matrix& B) { check_nonzero_size("scale_matrix_exp_multiply", "input matrix", A); check_nonzero_size("scale_matrix_exp_multiply", "input matrix", B); check_multiplicable("scale_matrix_exp_multiply", "A", A, "B", B); check_square("scale_matrix_exp_multiply", "input matrix", A); return multiply(matrix_exp(multiply(A, t)), B); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/trace_quad_form.hpp0000644000176200001440000000655213766554456025017 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TRACE_QUAD_FORM_HPP #define STAN_MATH_REV_MAT_FUN_TRACE_QUAD_FORM_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class trace_quad_form_vari_alloc : public chainable_alloc { public: trace_quad_form_vari_alloc(const Eigen::Matrix& A, const Eigen::Matrix& B) : A_(A), B_(B) {} double compute() { return trace_quad_form(value_of(A_), value_of(B_)); } Eigen::Matrix A_; Eigen::Matrix B_; }; template class trace_quad_form_vari : public vari { protected: static inline void chainA(Eigen::Matrix& A, const Eigen::Matrix& Bd, double adjC) {} static inline void chainB(Eigen::Matrix& B, const Eigen::Matrix& Ad, const Eigen::Matrix& Bd, double adjC) {} static inline void chainA(Eigen::Matrix& A, const Eigen::Matrix& Bd, double adjC) { A.adj() += adjC * Bd * Bd.transpose(); } static inline void chainB(Eigen::Matrix& B, const Eigen::Matrix& Ad, const Eigen::Matrix& Bd, double adjC) { B.adj() += adjC * (Ad + Ad.transpose()) * Bd; } inline void chainAB(Eigen::Matrix& A, Eigen::Matrix& B, const Eigen::Matrix& Ad, const Eigen::Matrix& Bd, double adjC) { chainA(A, Bd, adjC); chainB(B, Ad, Bd, adjC); } public: explicit trace_quad_form_vari( trace_quad_form_vari_alloc* impl) : vari(impl->compute()), impl_(impl) {} virtual void chain() { chainAB(impl_->A_, impl_->B_, value_of(impl_->A_), value_of(impl_->B_), adj_); } trace_quad_form_vari_alloc* impl_; }; } // namespace internal template > inline return_type_t trace_quad_form( const Eigen::Matrix& A, const Eigen::Matrix& B) { check_square("trace_quad_form", "A", A); check_multiplicable("trace_quad_form", "A", A, "B", B); internal::trace_quad_form_vari_alloc* baseVari = new internal::trace_quad_form_vari_alloc(A, B); return var( new internal::trace_quad_form_vari(baseVari)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/mdivide_left.hpp0000644000176200001440000002071213766554456024311 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_HPP #define STAN_MATH_REV_MAT_FUN_MDIVIDE_LEFT_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class mdivide_left_vv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() double *A_; double *C_; vari **variRefA_; vari **variRefB_; vari **variRefC_; mdivide_left_vv_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), C_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * B.rows() * B.cols()))), variRefA_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * A.cols()))), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))) { using Eigen::Map; Map Ad(A_, M_, M_); Map Cd(C_, M_, N_); Ad = A.val(); Cd = Ad.colPivHouseholderQr().solve(B.val()); Map(variRefA_, M_, M_) = A.vi(); Map(variRefB_, M_, N_) = B.vi(); Map(variRefC_, M_, N_) = Cd.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { using Eigen::Map; matrix_d adjB = Map(A_, M_, M_) .transpose() .colPivHouseholderQr() .solve(Map(variRefC_, M_, N_).adj()); Map(variRefA_, M_, M_).adj() -= adjB * Map(C_, M_, N_).transpose(); Map(variRefB_, M_, N_).adj() += adjB; } }; template class mdivide_left_dv_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() double *A_; double *C_; vari **variRefB_; vari **variRefC_; mdivide_left_dv_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), C_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * B.rows() * B.cols()))), variRefB_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))) { using Eigen::Map; Map Ad(A_, M_, M_); Map Cd(C_, M_, N_); Ad = A; Cd = Ad.colPivHouseholderQr().solve(B.val()); Map(variRefB_, M_, N_) = B.vi(); Map(variRefC_, M_, N_) = Cd.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { using Eigen::Map; Map(variRefB_, M_, N_).adj() += Map(A_, M_, M_) .transpose() .colPivHouseholderQr() .solve(Map(variRefC_, M_, N_).adj()); } }; template class mdivide_left_vd_vari : public vari { public: int M_; // A.rows() = A.cols() = B.rows() int N_; // B.cols() double *A_; double *C_; vari **variRefA_; vari **variRefC_; mdivide_left_vd_vari(const Eigen::Matrix &A, const Eigen::Matrix &B) : vari(0.0), M_(A.rows()), N_(B.cols()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), C_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * B.rows() * B.cols()))), variRefA_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * A.cols()))), variRefC_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * B.rows() * B.cols()))) { using Eigen::Map; Map(variRefA_, M_, M_) = A.vi(); Map Ad(A_, M_, M_); Map Cd(C_, M_, N_); Ad = A.val(); Cd = Ad.colPivHouseholderQr().solve(B); Map(variRefC_, M_, N_) = Cd.unaryExpr([](double x) { return new vari(x, false); }); } virtual void chain() { using Eigen::Map; matrix_d adjC = Map(variRefC_, M_, N_).adj(); Map(variRefA_, M_, M_).adj() -= Map(A_, M_, M_) .transpose() .colPivHouseholderQr() .solve(adjC * Map(C_, M_, N_).transpose()); } }; } // namespace internal template inline Eigen::Matrix mdivide_left( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left", "A", A); check_multiplicable("mdivide_left", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_vv_vari *baseVari = new internal::mdivide_left_vv_vari(A, b); res.vi() = Eigen::Map(baseVari->variRefC_, res.rows(), res.cols()); return res; } template inline Eigen::Matrix mdivide_left( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left", "A", A); check_multiplicable("mdivide_left", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_vd_vari *baseVari = new internal::mdivide_left_vd_vari(A, b); res.vi() = Eigen::Map(baseVari->variRefC_, res.rows(), res.cols()); return res; } template inline Eigen::Matrix mdivide_left( const Eigen::Matrix &A, const Eigen::Matrix &b) { Eigen::Matrix res(b.rows(), b.cols()); check_square("mdivide_left", "A", A); check_multiplicable("mdivide_left", "A", A, "b", b); // NOTE: this is not a memory leak, this vari is used in the // expression graph to evaluate the adjoint, but is not needed // for the returned matrix. Memory will be cleaned up with the // arena allocator. internal::mdivide_left_dv_vari *baseVari = new internal::mdivide_left_dv_vari(A, b); res.vi() = Eigen::Map(baseVari->variRefC_, res.rows(), res.cols()); return res; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/trace_gen_quad_form.hpp0000644000176200001440000001021613766554456025640 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TRACE_GEN_QUAD_FORM_HPP #define STAN_MATH_REV_MAT_FUN_TRACE_GEN_QUAD_FORM_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class trace_gen_quad_form_vari_alloc : public chainable_alloc { public: trace_gen_quad_form_vari_alloc(const Eigen::Matrix& D, const Eigen::Matrix& A, const Eigen::Matrix& B) : D_(D), A_(A), B_(B) {} double compute() { return trace_gen_quad_form(value_of(D_), value_of(A_), value_of(B_)); } Eigen::Matrix D_; Eigen::Matrix A_; Eigen::Matrix B_; }; template class trace_gen_quad_form_vari : public vari { protected: static inline void computeAdjoints(double adj, const Eigen::Matrix& D, const Eigen::Matrix& A, const Eigen::Matrix& B, Eigen::Matrix* varD, Eigen::Matrix* varA, Eigen::Matrix* varB) { Eigen::Matrix AtB; Eigen::Matrix BD; if (varB || varA) { BD.noalias() = B * D; } if (varB || varD) { AtB.noalias() = A.transpose() * B; } if (varB) { (*varB).adj() += adj * (A * BD + AtB * D.transpose()); } if (varA) { (*varA).adj() += adj * (B * BD.transpose()); } if (varD) { (*varD).adj() += adj * (B.transpose() * AtB); } } public: explicit trace_gen_quad_form_vari( trace_gen_quad_form_vari_alloc* impl) : vari(impl->compute()), impl_(impl) {} virtual void chain() { computeAdjoints(adj_, value_of(impl_->D_), value_of(impl_->A_), value_of(impl_->B_), reinterpret_cast*>( std::is_same::value ? (&impl_->D_) : NULL), reinterpret_cast*>( std::is_same::value ? (&impl_->A_) : NULL), reinterpret_cast*>( std::is_same::value ? (&impl_->B_) : NULL)); } trace_gen_quad_form_vari_alloc* impl_; }; } // namespace internal template > inline var trace_gen_quad_form(const Eigen::Matrix& D, const Eigen::Matrix& A, const Eigen::Matrix& B) { check_square("trace_gen_quad_form", "A", A); check_square("trace_gen_quad_form", "D", D); check_multiplicable("trace_gen_quad_form", "A", A, "B", B); check_multiplicable("trace_gen_quad_form", "B", B, "D", D); internal::trace_gen_quad_form_vari_alloc* baseVari = new internal::trace_gen_quad_form_vari_alloc(D, A, B); return var(new internal::trace_gen_quad_form_vari(baseVari)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/divide.hpp0000644000176200001440000000146113766554456023122 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_DIVIDE_HPP #define STAN_MATH_REV_MAT_FUN_DIVIDE_HPP #include #include #include #include #include namespace stan { namespace math { /** * Return the division of the specified column vector by * the specified scalar. * @param[in] v Specified vector. * @param[in] c Specified scalar. * @return Vector divided by the scalar. */ template > inline Eigen::Matrix divide(const Eigen::Matrix& v, const T2& c) { return to_var(v) / to_var(c); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/LDLT_factor.hpp0000644000176200001440000001111113766554456023744 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LDLT_FACTOR_HPP #define STAN_MATH_REV_MAT_FUN_LDLT_FACTOR_HPP #include #include #include #include #include namespace stan { namespace math { /** * A template specialization of src/stan/math/matrix/LDLT_factor.hpp for * var which can be used with all the *_ldlt functions. * * The usage pattern is: * * ~~~ * Eigen::Matrix A1, A2; * * LDLT_factor ldlt_A1(A1); * LDLT_factor ldlt_A2; * ldlt_A2.compute(A2); * ~~~ * * Now, the caller should check that ldlt_A1.success() and ldlt_A2.success() * are true or abort accordingly. Alternatively, call check_ldlt_factor(). * The behaviour of using an LDLT_factor without success() returning true is * undefined. * * Note that ldlt_A1 and ldlt_A2 are completely equivalent. They simply * demonstrate two different ways to construct the factorization. * * Now, the caller can use the LDLT_factor objects as needed. For instance * * ~~~ * x1 = mdivide_left_ldlt(ldlt_A1, b1); * x2 = mdivide_right_ldlt(b2, ldlt_A2); * * d1 = log_determinant_ldlt(ldlt_A1); * d2 = log_determinant_ldlt(ldlt_A2); * ~~~ * */ template class LDLT_factor { public: /** * Default constructor. The caller *MUST* call compute() after this. Any * calls which use the LDLT_factor without calling compute() run the risk * of crashing Stan from within Eigen. */ LDLT_factor() : alloc_(new LDLT_alloc()) {} explicit LDLT_factor(const Eigen::Matrix &A) : alloc_(new LDLT_alloc()) { compute(A); } /** * Use the LDLT_factor object to factorize a new matrix. After calling * this function, the user should call success() to check that the * factorization was successful. If the factorization is not successful, * the LDLT_factor is not valid and other functions should not be used. * * @param A A symmetric positive definite matrix to factorize */ inline void compute(const Eigen::Matrix &A) { check_square("comute", "A", A); alloc_->compute(A); } /** * Compute the actual numerical result of inv(A)*b. Note that this isn't * meant to handle any of the autodiff. This is a convenience function * for the actual implementations in mdivide_left_ldlt. * * Precondition: success() must return true. If success() returns false, * this function runs the risk of crashing Stan from within Eigen. * * @param b The right handside. Note that this is templated such that * Eigen's expression-templating magic can work properly here. */ #if EIGEN_VERSION_AT_LEAST(3, 3, 0) template inline const Eigen::Solve >, Rhs> solve(const Eigen::MatrixBase &b) const { return alloc_->ldlt_.solve(b); } #else template inline const Eigen::internal::solve_retval< Eigen::LDLT >, Rhs> solve(const Eigen::MatrixBase &b) const { return alloc_->ldlt_.solve(b); } #endif /** * Determine whether the most recent factorization succeeded. This should * always be called after the object is constructed (with a matrix) or * after compute() is called. */ inline bool success() const { bool ret; ret = alloc_->N_ != 0; ret = ret && alloc_->ldlt_.info() == Eigen::Success; ret = ret && alloc_->ldlt_.isPositive(); ret = ret && (alloc_->ldlt_.vectorD().array() > 0).all(); return ret; } /** * The entries of the diagonal matrix D. They should be strictly positive * for a positive definite matrix. * * Precondition: success() must return true. If success() returns false, * this function runs the risk of crashing Stan from within Eigen. */ inline Eigen::VectorXd vectorD() const { return alloc_->ldlt_.vectorD(); } inline size_t rows() const { return alloc_->N_; } inline size_t cols() const { return alloc_->N_; } using size_type = size_t; using value_type = var; /** * The LDLT_alloc object actually contains the factorization but is * derived from the chainable_alloc class so that it is allocated on the * vari stack. This ensures that it's lifespan is longer than the * LDLT_factor object which created it. This is needed because the * factorization is required during the chain() calls which happen * after an LDLT_factor object will most likely have been destroyed. */ LDLT_alloc *alloc_; }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/matrix_exp_multiply.hpp0000644000176200001440000000250213766554456025772 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MATRIX_EXP_MULTIPLY_HPP #define STAN_MATH_REV_MAT_FUN_MATRIX_EXP_MULTIPLY_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Wrapper of matrix_exp_action function for a more literal name * @tparam Ta scalar type matrix A * @tparam Tb scalar type matrix B * @tparam Cb Columns matrix B * @param[in] A Matrix * @param[in] B Matrix * @return exponential of A multiplies B */ template inline Eigen::Matrix::type, -1, Cb> matrix_exp_multiply(const Eigen::Matrix& A, const Eigen::Matrix& B) { check_nonzero_size("matrix_exp_multiply", "input matrix", A); check_nonzero_size("matrix_exp_multiply", "input matrix", B); check_multiplicable("matrix_exp_multiply", "A", A, "B", B); check_square("matrix_exp_multiply", "input matrix", A); return multiply(matrix_exp(A), B); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/typedefs.hpp0000644000176200001440000000224613766554456023503 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TYPEDEFS_HPP #define STAN_MATH_REV_MAT_FUN_TYPEDEFS_HPP #include #include #include namespace stan { namespace math { using size_type = Eigen::Matrix::Index; /** * The type of a matrix holding var * values. */ using matrix_v = Eigen::Matrix; /** * The type of a (column) vector holding var * values. */ using vector_v = Eigen::Matrix; /** * The type of a row vector holding var * values. */ using row_vector_v = Eigen::Matrix; /** * The type of a matrix holding vari* * values. */ using matrix_vi = Eigen::Matrix; /** * The type of a (column) vector holding vari* * values. */ using vector_vi = Eigen::Matrix; /** * The type of a row vector holding vari* * values. */ using row_vector_vi = Eigen::Matrix; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/gp_periodic_cov.hpp0000644000176200001440000003316113766554456025013 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_GP_PERIODIC_COV_HPP #define STAN_MATH_REV_MAT_FUN_GP_PERIODIC_COV_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * This is a subclass of the vari class for precomputed * gradients of gp_periodic_cov. * * The class stores the double values for the distance * matrix, sine, cosine and sine squared of the latter, * pointers to the varis for the covariance * matrix, along with a pointer to the vari for sigma, * the vari for l and the vari for p. * * The elements of periodic covariance matrix \f$ \mathbf{K} \f$ using the * input \f$ \mathbf{X} \f$ are defined as * \f$ \mathbf{K}_{ij} = k(\mathbf{X}_i,\mathbf{X}_j), \f$ where * \f$ \mathbf{X}_i \f$ is the \f$i\f$-th row of \f$ \mathbf{X} \f$ and \n * \f$ k(\mathbf{x},\mathbf{x}^\prime) = * \sigma^2 \exp\left(-\frac{2\sin^2(\pi * |\mathbf{x}-\mathbf{x}^\prime|/p)}{\ell^2}\right), \f$ \n where \f$ \sigma^2 * \f$, \f$ \ell \f$ and \f$ p \f$ are the signal variance, length-scale and * period. * * The partial derivatives w.r.t. the parameters are the following:\n * * \f$ \frac{\partial k}{\partial \sigma} = \frac{2k}{\sigma} \f$\n * \f$ \frac{\partial k}{\partial \ell} = \frac{4k}{\ell^3} * \sin^2(\pi|\mathbf{x}-\mathbf{x}^\prime|/p) \f$\n \f$ \frac{\partial * k}{\partial p} = \frac{2k\pi|\mathbf{x}-\mathbf{x}^\prime|}{\ell^2p^2} * \sin(2\pi|\mathbf{x}-\mathbf{x}^\prime|/p) \f$\n * * @tparam T_x type of std::vector elements of x. * T_x can be a scalar, an Eigen::Vector, or an Eigen::RowVector. * @tparam T_sigma type of sigma * @tparam T_l type of length-scale * @tparam T_p type of period */ template class gp_periodic_cov_vari : public vari { public: const size_t size_; const size_t size_ltri_; const double l_d_; const double sigma_d_; const double p_d_; const double sigma_sq_d_; double *dist_; double *sin_2_dist_; double *sin_dist_sq_; vari *l_vari_; vari *sigma_vari_; vari *p_vari_; vari **cov_lower_; vari **cov_diag_; /** * Constructor for gp_periodic_cov. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled by the second argument to * vari's constructor. * * @param x std::vector of input elements. * Assumes that all elements of x have the same size. * @param sigma standard deviation of the signal * @param l length-scale * @param p period */ gp_periodic_cov_vari(const std::vector &x, const T_sigma &sigma, const T_l &l, const T_p &p) : vari(0.0), size_(x.size()), size_ltri_(size_ * (size_ - 1) / 2), l_d_(value_of(l)), sigma_d_(value_of(sigma)), p_d_(value_of(p)), sigma_sq_d_(sigma_d_ * sigma_d_), dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), sin_2_dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), sin_dist_sq_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), l_vari_(l.vi_), sigma_vari_(sigma.vi_), p_vari_(p.vi_), cov_lower_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), cov_diag_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { double neg_two_inv_l_sq = -2.0 / (l_d_ * l_d_); double pi_div_p = pi() / p_d_; size_t pos = 0; for (size_t j = 0; j < size_; ++j) { for (size_t i = j + 1; i < size_; ++i) { double dist = distance(x[i], x[j]); double sin_dist = sin(pi_div_p * dist); double sin_dist_sq = square(sin_dist); dist_[pos] = dist; sin_2_dist_[pos] = sin(2.0 * pi_div_p * dist); sin_dist_sq_[pos] = sin_dist_sq; cov_lower_[pos] = new vari( sigma_sq_d_ * std::exp(sin_dist_sq * neg_two_inv_l_sq), false); ++pos; } cov_diag_[j] = new vari(sigma_sq_d_, false); } } virtual void chain() { double adjl = 0; double adjsigma = 0; double adjp = 0; for (size_t i = 0; i < size_ltri_; ++i) { vari *el_low = cov_lower_[i]; double prod_add = el_low->adj_ * el_low->val_; adjl += prod_add * sin_dist_sq_[i]; adjsigma += prod_add; adjp += prod_add * sin_2_dist_[i] * dist_[i]; } for (size_t i = 0; i < size_; ++i) { vari *el = cov_diag_[i]; adjsigma += el->adj_ * el->val_; } double l_d_sq = l_d_ * l_d_; l_vari_->adj_ += adjl * 4 / (l_d_sq * l_d_); sigma_vari_->adj_ += adjsigma * 2 / sigma_d_; p_vari_->adj_ += adjp * 2 * pi() / l_d_sq / (p_d_ * p_d_); } }; /** * This is a subclass of the vari class for precomputed * gradients of gp_periodic_cov. * * The class stores the double values for the distance * matrix, sine, cosine and sine squared of the latter, * pointers to the varis for the covariance * matrix, along with a pointer to the vari for sigma, * the vari for l and the vari for p. * * The elements of periodic covariance matrix \f$ \mathbf{K} \f$ using the * input \f$ \mathbf{X} \f$ are defined as * \f$ \mathbf{K}_{ij} = k(\mathbf{X}_i,\mathbf{X}_j), \f$ where * \f$ \mathbf{X}_i \f$ is the \f$i\f$-th row of \f$ \mathbf{X} \f$ and \n * \f$ k(\mathbf{x},\mathbf{x}^\prime) = * \sigma^2 \exp\left(-\frac{2\sin^2(\pi * |\mathbf{x}-\mathbf{x}^\prime|/p)}{\ell^2}\right), \f$ \n where \f$ \sigma^2 * \f$, \f$ \ell \f$ and \f$ p \f$ are the signal variance, length-scale and * period. * * The partial derivatives w.r.t. the parameters are the following:\n * * \f$ \frac{\partial k}{\partial \sigma} = \frac{2k}{\sigma} \f$\n * \f$ \frac{\partial k}{\partial \ell} = \frac{4k}{\ell^3} * \sin^2(\pi|\mathbf{x}-\mathbf{x}^\prime|/p) \f$\n \f$ \frac{\partial * k}{\partial p} = \frac{2k\pi|\mathbf{x}-\mathbf{x}^\prime|}{\ell^2p^2} * \sin(2\pi|\mathbf{x}-\mathbf{x}^\prime|/p) \f$\n * @tparam T_x type of std::vector elements of x * T_x can be a scalar, an Eigen::Vector, or an Eigen::RowVector. * @tparam T_l type of length-scale * @tparam T_p type of period */ template class gp_periodic_cov_vari : public vari { public: const size_t size_; const size_t size_ltri_; const double l_d_; const double sigma_d_; const double p_d_; const double sigma_sq_d_; double *dist_; double *sin_2_dist_; double *sin_dist_sq_; vari *l_vari_; vari *p_vari_; vari **cov_lower_; vari **cov_diag_; /** * Constructor for gp_periodic_cov. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled by the second argument to * vari's constructor. * * @param x std::vector of input elements. * Assumes that all elements of x have the same size. * @param sigma standard deviation of the signal * @param l length-scale * @param p period */ gp_periodic_cov_vari(const std::vector &x, double sigma, const T_l &l, const T_p &p) : vari(0.0), size_(x.size()), size_ltri_(size_ * (size_ - 1) / 2), l_d_(value_of(l)), sigma_d_(sigma), p_d_(value_of(p)), sigma_sq_d_(sigma_d_ * sigma_d_), dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), sin_2_dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), sin_dist_sq_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), l_vari_(l.vi_), p_vari_(p.vi_), cov_lower_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), cov_diag_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { double neg_two_inv_l_sq = -2.0 / (l_d_ * l_d_); double pi_div_p = pi() / p_d_; size_t pos = 0; for (size_t j = 0; j < size_; ++j) { for (size_t i = j + 1; i < size_; ++i) { double dist = distance(x[i], x[j]); double sin_dist = sin(pi_div_p * dist); double sin_dist_sq = square(sin_dist); dist_[pos] = dist; sin_2_dist_[pos] = sin(2.0 * pi_div_p * dist); sin_dist_sq_[pos] = sin_dist_sq; cov_lower_[pos] = new vari( sigma_sq_d_ * std::exp(sin_dist_sq * neg_two_inv_l_sq), false); ++pos; } cov_diag_[j] = new vari(sigma_sq_d_, false); } } virtual void chain() { double adjl = 0; double adjp = 0; for (size_t i = 0; i < size_ltri_; ++i) { vari *el_low = cov_lower_[i]; double prod_add = el_low->adj_ * el_low->val_; adjl += prod_add * sin_dist_sq_[i]; adjp += prod_add * sin_2_dist_[i] * dist_[i]; } double l_d_sq = l_d_ * l_d_; l_vari_->adj_ += adjl * 4 / (l_d_sq * l_d_); p_vari_->adj_ += adjp * 2 * pi() / l_d_sq / (p_d_ * p_d_); } }; /** * Returns a periodic covariance matrix \f$ \mathbf{K} \f$ using the input \f$ * \mathbf{X} \f$. The elements of \f$ \mathbf{K} \f$ are defined as \f$ * \mathbf{K}_{ij} = k(\mathbf{X}_i,\mathbf{X}_j), \f$ where \f$ \mathbf{X}_i * \f$ is the \f$i\f$-th row of \f$ \mathbf{X} \f$ and \n \f$ * k(\mathbf{x},\mathbf{x}^\prime) = \sigma^2 \exp\left(-\frac{2\sin^2(\pi * |\mathbf{x}-\mathbf{x}^\prime|/p)}{\ell^2}\right), \f$ \n where \f$ \sigma^2 * \f$, \f$ \ell \f$ and \f$ p \f$ are the signal variance, length-scale and * period. * * @param x std::vector of input elements. * Assumes that all elements of x have the same size. * @param sigma standard deviation of the signal * @param l length-scale * @param p period * @return periodic covariance matrix * @throw std::domain_error if sigma <= 0, l <= 0, p <= 0, or * x is nan or infinite */ template inline typename std::enable_if< std::is_same::type, double>::value, Eigen::Matrix>::type gp_periodic_cov(const std::vector &x, const var &sigma, const var &l, const var &p) { const char *fun = "gp_periodic_cov"; check_positive(fun, "signal standard deviation", sigma); check_positive(fun, "length-scale", l); check_positive(fun, "period", p); size_t x_size = x.size(); for (size_t i = 0; i < x_size; ++i) { check_not_nan(fun, "element of x", x[i]); } Eigen::Matrix cov(x_size, x_size); if (x_size == 0) { return cov; } gp_periodic_cov_vari *baseVari = new gp_periodic_cov_vari(x, sigma, l, p); size_t pos = 0; for (size_t j = 0; j < x_size; ++j) { for (size_t i = (j + 1); i < x_size; ++i) { cov.coeffRef(i, j).vi_ = baseVari->cov_lower_[pos]; cov.coeffRef(j, i).vi_ = cov.coeffRef(i, j).vi_; ++pos; } cov.coeffRef(j, j).vi_ = baseVari->cov_diag_[j]; } return cov; } /** * Returns a periodic covariance matrix \f$ \mathbf{K} \f$ using the input \f$ * \mathbf{X} \f$. The elements of \f$ \mathbf{K} \f$ are defined as \f$ * \mathbf{K}_{ij} = k(\mathbf{X}_i,\mathbf{X}_j), \f$ where \f$ \mathbf{X}_i * \f$ is the \f$i\f$-th row of \f$ \mathbf{X} \f$ and \n \f$ * k(\mathbf{x},\mathbf{x}^\prime) = \sigma^2 \exp\left(-\frac{2\sin^2(\pi * |\mathbf{x}-\mathbf{x}^\prime|/p)}{\ell^2}\right), \f$ \n where \f$ \sigma^2 * \f$, \f$ \ell \f$ and \f$ p \f$ are the signal variance, length-scale and * period. * * @param x std::vector of input elements. * Assumes that all elements of x have the same size. * @param sigma standard deviation of the signal * @param l length-scale * @param p period * @return periodic covariance matrix * @throw std::domain_error if sigma <= 0, l <= 0, p <= 0, or * x is nan or infinite */ template inline typename std::enable_if< std::is_same::type, double>::value, Eigen::Matrix>::type gp_periodic_cov(const std::vector &x, double sigma, const var &l, const var &p) { const char *fun = "gp_periodic_cov"; check_positive(fun, "signal standard deviation", sigma); check_positive(fun, "length-scale", l); check_positive(fun, "period", p); size_t x_size = x.size(); for (size_t i = 0; i < x_size; ++i) { check_not_nan(fun, "element of x", x[i]); } Eigen::Matrix cov(x_size, x_size); if (x_size == 0) { return cov; } gp_periodic_cov_vari *baseVari = new gp_periodic_cov_vari(x, sigma, l, p); size_t pos = 0; for (size_t j = 0; j < x_size - 1; ++j) { for (size_t i = (j + 1); i < x_size; ++i) { cov.coeffRef(i, j).vi_ = baseVari->cov_lower_[pos]; cov.coeffRef(j, i).vi_ = cov.coeffRef(i, j).vi_; ++pos; } cov.coeffRef(j, j).vi_ = baseVari->cov_diag_[j]; } cov.coeffRef(x_size - 1, x_size - 1).vi_ = baseVari->cov_diag_[x_size - 1]; return cov; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/quad_form.hpp0000644000176200001440000001110513766554456023627 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_QUAD_FORM_HPP #define STAN_MATH_REV_MAT_FUN_QUAD_FORM_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class quad_form_vari_alloc : public chainable_alloc { private: inline void compute(const Eigen::Matrix& A, const Eigen::Matrix& B) { matrix_d Cd = B.transpose() * A * B; for (int j = 0; j < C_.cols(); j++) { for (int i = 0; i < C_.rows(); i++) { if (sym_) { C_(i, j) = var(new vari(0.5 * (Cd(i, j) + Cd(j, i)), false)); } else { C_(i, j) = var(new vari(Cd(i, j), false)); } } } } public: quad_form_vari_alloc(const Eigen::Matrix& A, const Eigen::Matrix& B, bool symmetric = false) : A_(A), B_(B), C_(B_.cols(), B_.cols()), sym_(symmetric) { compute(value_of(A), value_of(B)); } Eigen::Matrix A_; Eigen::Matrix B_; Eigen::Matrix C_; bool sym_; }; template class quad_form_vari : public vari { protected: inline void chainA(Eigen::Matrix& A, const Eigen::Matrix& Bd, const Eigen::Matrix& adjC) {} inline void chainB(Eigen::Matrix& B, const Eigen::Matrix& Ad, const Eigen::Matrix& Bd, const Eigen::Matrix& adjC) {} inline void chainA(Eigen::Matrix& A, const Eigen::Matrix& Bd, const Eigen::Matrix& adjC) { A.adj() += Bd * adjC * Bd.transpose(); } inline void chainB(Eigen::Matrix& B, const Eigen::Matrix& Ad, const Eigen::Matrix& Bd, const Eigen::Matrix& adjC) { B.adj() += Ad * Bd * adjC.transpose() + Ad.transpose() * Bd * adjC; } inline void chainAB(Eigen::Matrix& A, Eigen::Matrix& B, const Eigen::Matrix& Ad, const Eigen::Matrix& Bd, const Eigen::Matrix& adjC) { chainA(A, Bd, adjC); chainB(B, Ad, Bd, adjC); } public: quad_form_vari(const Eigen::Matrix& A, const Eigen::Matrix& B, bool symmetric = false) : vari(0.0) { impl_ = new quad_form_vari_alloc(A, B, symmetric); } virtual void chain() { matrix_d adjC = impl_->C_.adj(); chainAB(impl_->A_, impl_->B_, value_of(impl_->A_), value_of(impl_->B_), adjC); } quad_form_vari_alloc* impl_; }; } // namespace internal template inline typename std::enable_if::value || std::is_same::value, Eigen::Matrix >::type quad_form(const Eigen::Matrix& A, const Eigen::Matrix& B) { check_square("quad_form", "A", A); check_multiplicable("quad_form", "A", A, "B", B); internal::quad_form_vari* baseVari = new internal::quad_form_vari(A, B); return baseVari->impl_->C_; } template inline typename std::enable_if< std::is_same::value || std::is_same::value, var>::type quad_form(const Eigen::Matrix& A, const Eigen::Matrix& B) { check_square("quad_form", "A", A); check_multiplicable("quad_form", "A", A, "B", B); internal::quad_form_vari* baseVari = new internal::quad_form_vari(A, B); return baseVari->impl_->C_(0, 0); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/grad.hpp0000644000176200001440000000166713766554456022603 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_GRAD_HPP #define STAN_MATH_REV_MAT_FUN_GRAD_HPP #include #include #include #include namespace stan { namespace math { /** * Propagate chain rule to calculate gradients starting from * the specified variable. Resizes the input vector to be the * correct size. * * The grad() function does not itself recover any memory. use * recover_memory() or * recover_memory_nested() to recover memory. * * @param[in] v Value of function being differentiated * @param[in] x Variables being differentiated with respect to * @param[out] g Gradient, d/dx v, evaluated at x. */ inline void grad(var& v, Eigen::Matrix& x, Eigen::VectorXd& g) { grad(v.vi_); g = x.adj(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/dot_self.hpp0000644000176200001440000000451013766554456023453 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_DOT_SELF_HPP #define STAN_MATH_REV_MAT_FUN_DOT_SELF_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class dot_self_vari : public vari { protected: vari** v_; size_t size_; public: dot_self_vari(vari** v, size_t size) : vari(var_dot_self(v, size)), v_(v), size_(size) {} template explicit dot_self_vari(const Eigen::DenseBase& v) : vari(var_dot_self(v)), size_(v.size()) { v_ = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(size_ * sizeof(vari*))); Eigen::Map(v_, size_) = Eigen::Ref(v).vi(); } template explicit dot_self_vari(const Eigen::Matrix& v) : vari(var_dot_self(v)), size_(v.size()) { v_ = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(size_ * sizeof(vari*))); Eigen::Map(v_, v.rows(), v.cols()) = v.vi(); } inline static double square(double x) { return square(x); } inline static double var_dot_self(vari** v, size_t size) { return Eigen::Map(v, size).val().squaredNorm(); } template double var_dot_self(const Eigen::DenseBase& v) { return Eigen::Ref(v).val().squaredNorm(); } template inline static double var_dot_self(const Eigen::Matrix& v) { return v.val().squaredNorm(); } virtual void chain() { Eigen::Map v_map(v_, size_); v_map.adj() += adj_ * 2.0 * v_map.val(); } }; } // namespace internal /** * Returns the dot product of a vector with itself. * * @param[in] v Vector. * @return Dot product of the vector with itself. * @tparam R number of rows or Eigen::Dynamic for * dynamic; one of R or C must be 1 * @tparam C number of rows or Eigen::Dyanmic for * dynamic; one of R or C must be 1 */ template inline var dot_self(const Eigen::Matrix& v) { check_vector("dot_self", "v", v); return var(new internal::dot_self_vari(v)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/cholesky_decompose.hpp0000644000176200001440000003511213766554456025535 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_CHOLESKY_DECOMPOSE_HPP #define STAN_MATH_REV_MAT_FUN_CHOLESKY_DECOMPOSE_HPP #include #include #include #include #include #include #include #include #include #include #include #ifdef STAN_OPENCL #include #endif #include #include namespace stan { namespace math { namespace internal { /** * Set the lower right triangular of a var matrix given a set of vari** * * @param L Matrix of vars * @param vari_ref Values to be set in lower right triangular of L. * @return None, L modified by reference. */ inline void set_lower_tri_coeff_ref(Eigen::Matrix& L, vari** vari_ref) { size_t pos = 0; vari* dummy = new vari(0.0, false); for (size_type j = 0; j < L.cols(); ++j) { for (size_type i = j; i < L.cols(); ++i) { L.coeffRef(i, j).vi_ = vari_ref[pos++]; } for (size_type k = 0; k < j; ++k) { L.coeffRef(k, j).vi_ = dummy; } } return; } } // namespace internal class cholesky_block : public vari { public: int M_; int block_size_; using Block_ = Eigen::Block; vari** vari_ref_A_; vari** vari_ref_L_; /** * Constructor for cholesky function. * * Stores varis for A. Instantiates and stores varis for L. * Instantiates and stores dummy vari for upper triangular part of var * result returned in cholesky_decompose function call * * variRefL aren't on the chainable autodiff stack, only used for storage * and computation. Note that varis for L are constructed externally in * cholesky_decompose. * * block_size_ determined using the same calculation Eigen/LLT.h * * @param A matrix * @param L_A matrix, cholesky factor of A */ cholesky_block(const Eigen::Matrix& A, const Eigen::Matrix& L_A) : vari(0.0), M_(A.rows()), vari_ref_A_(ChainableStack::instance_->memalloc_.alloc_array( A.rows() * (A.rows() + 1) / 2)), vari_ref_L_(ChainableStack::instance_->memalloc_.alloc_array( A.rows() * (A.rows() + 1) / 2)) { size_t pos = 0; block_size_ = std::max(M_ / 8, 8); block_size_ = std::min(block_size_, 128); for (size_type j = 0; j < M_; ++j) { for (size_type i = j; i < M_; ++i) { vari_ref_A_[pos] = A.coeffRef(i, j).vi_; vari_ref_L_[pos] = new vari(L_A.coeffRef(i, j), false); ++pos; } } } /** * Symbolic adjoint calculation for cholesky factor A * * @param L cholesky factor * @param L_adj matrix of adjoints of L */ inline void symbolic_rev(Block_& L, Block_& L_adj) { using Eigen::Lower; using Eigen::StrictlyUpper; using Eigen::Upper; L.transposeInPlace(); L_adj = (L * L_adj.triangularView()).eval(); L_adj.triangularView() = L_adj.adjoint().triangularView(); L.triangularView().solveInPlace(L_adj); L.triangularView().solveInPlace(L_adj.transpose()); } /** * Reverse mode differentiation algorithm refernce: * * Iain Murray: Differentiation of the Cholesky decomposition, 2016. * */ virtual void chain() { using Eigen::Block; using Eigen::Lower; using Eigen::MatrixXd; using Eigen::StrictlyUpper; using Eigen::Upper; auto L_adj = Eigen::MatrixXd::Zero(M_, M_).eval(); auto L = Eigen::MatrixXd::Zero(M_, M_).eval(); size_t pos = 0; for (size_type j = 0; j < M_; ++j) { for (size_type i = j; i < M_; ++i) { L_adj.coeffRef(i, j) = vari_ref_L_[pos]->adj_; L.coeffRef(i, j) = vari_ref_L_[pos]->val_; ++pos; } } for (int k = M_; k > 0; k -= block_size_) { int j = std::max(0, k - block_size_); Block_ R = L.block(j, 0, k - j, j); Block_ D = L.block(j, j, k - j, k - j); Block_ B = L.block(k, 0, M_ - k, j); Block_ C = L.block(k, j, M_ - k, k - j); Block_ R_adj = L_adj.block(j, 0, k - j, j); Block_ D_adj = L_adj.block(j, j, k - j, k - j); Block_ B_adj = L_adj.block(k, 0, M_ - k, j); Block_ C_adj = L_adj.block(k, j, M_ - k, k - j); if (C_adj.size() > 0) { C_adj = D.transpose() .triangularView() .solve(C_adj.transpose()) .transpose(); B_adj.noalias() -= C_adj * R; D_adj.noalias() -= C_adj.transpose() * C; } symbolic_rev(D, D_adj); R_adj.noalias() -= C_adj.transpose() * B; R_adj.noalias() -= D_adj.selfadjointView() * R; D_adj.diagonal() *= 0.5; D_adj.triangularView().setZero(); } pos = 0; for (size_type j = 0; j < M_; ++j) { for (size_type i = j; i < M_; ++i) { vari_ref_A_[pos++]->adj_ += L_adj.coeffRef(i, j); } } } }; class cholesky_scalar : public vari { public: int M_; vari** vari_ref_A_; vari** vari_ref_L_; /** * Constructor for cholesky function. * * Stores varis for A Instantiates and stores varis for L Instantiates * and stores dummy vari for upper triangular part of var result returned * in cholesky_decompose function call * * variRefL aren't on the chainable autodiff stack, only used for storage * and computation. Note that varis for L are constructed externally in * cholesky_decompose. * * @param A matrix * @param L_A matrix, cholesky factor of A */ cholesky_scalar(const Eigen::Matrix& A, const Eigen::Matrix& L_A) : vari(0.0), M_(A.rows()), vari_ref_A_(ChainableStack::instance_->memalloc_.alloc_array( A.rows() * (A.rows() + 1) / 2)), vari_ref_L_(ChainableStack::instance_->memalloc_.alloc_array( A.rows() * (A.rows() + 1) / 2)) { size_t accum = 0; size_t accum_i = accum; for (size_type j = 0; j < M_; ++j) { for (size_type i = j; i < M_; ++i) { accum_i += i; size_t pos = j + accum_i; vari_ref_A_[pos] = A.coeffRef(i, j).vi_; vari_ref_L_[pos] = new vari(L_A.coeffRef(i, j), false); } accum += j; accum_i = accum; } } /** * Reverse mode differentiation algorithm refernce: * * Mike Giles. An extended collection of matrix derivative results for * forward and reverse mode AD. Jan. 2008. * * Note algorithm as laid out in Giles is row-major, so Eigen::Matrices * are explicitly storage order RowMajor, whereas Eigen defaults to * ColumnMajor. Also note algorithm starts by calculating the adjoint for * A(M_ - 1, M_ - 1), hence pos on line 94 is decremented to start at pos * = M_ * (M_ + 1) / 2. */ virtual void chain() { using Eigen::Matrix; using Eigen::RowMajor; Matrix adjL(M_, M_); Matrix LA(M_, M_); Matrix adjA(M_, M_); size_t pos = 0; for (size_type i = 0; i < M_; ++i) { for (size_type j = 0; j <= i; ++j) { adjL.coeffRef(i, j) = vari_ref_L_[pos]->adj_; LA.coeffRef(i, j) = vari_ref_L_[pos]->val_; ++pos; } } --pos; for (int i = M_ - 1; i >= 0; --i) { for (int j = i; j >= 0; --j) { if (i == j) { adjA.coeffRef(i, j) = 0.5 * adjL.coeff(i, j) / LA.coeff(i, j); } else { adjA.coeffRef(i, j) = adjL.coeff(i, j) / LA.coeff(j, j); adjL.coeffRef(j, j) -= adjL.coeff(i, j) * LA.coeff(i, j) / LA.coeff(j, j); } for (int k = j - 1; k >= 0; --k) { adjL.coeffRef(i, k) -= adjA.coeff(i, j) * LA.coeff(j, k); adjL.coeffRef(j, k) -= adjA.coeff(i, j) * LA.coeff(i, k); } vari_ref_A_[pos--]->adj_ += adjA.coeffRef(i, j); } } } }; #ifdef STAN_OPENCL class cholesky_opencl : public vari { public: int M_; vari** vari_ref_A_; vari** vari_ref_L_; /** * Constructor for OpenCL cholesky function. * * Stores varis for A. Instantiates and stores varis for L. * Instantiates and stores dummy vari for upper triangular part of var * result returned in cholesky_decompose function call * * variRefL aren't on the chainable autodiff stack, only used for storage * and computation. Note that varis for L are constructed externally in * cholesky_decompose. * * * @param A matrix * @param L_A matrix, cholesky factor of A */ cholesky_opencl(const Eigen::Matrix& A, const Eigen::Matrix& L_A) : vari(0.0), M_(A.rows()), vari_ref_A_(ChainableStack::instance_->memalloc_.alloc_array( A.rows() * (A.rows() + 1) / 2)), vari_ref_L_(ChainableStack::instance_->memalloc_.alloc_array( A.rows() * (A.rows() + 1) / 2)) { size_t pos = 0; for (size_type j = 0; j < M_; ++j) { for (size_type i = j; i < M_; ++i) { vari_ref_A_[pos] = A.coeffRef(i, j).vi_; vari_ref_L_[pos] = new vari(L_A.coeffRef(i, j), false); ++pos; } } } /** * Symbolic adjoint calculation for cholesky factor A * * @param L cholesky factor * @param L_adj matrix of adjoints of L */ inline void symbolic_rev(matrix_cl& L, matrix_cl& L_adj) { L_adj = transpose(L) * L_adj; L_adj.triangular_transpose(); L = transpose(tri_inverse(L)); L_adj = L * transpose(L * L_adj); L_adj.triangular_transpose(); } /** * Reverse mode differentiation algorithm using OpenCL * * Reference: * * Iain Murray: Differentiation of the Cholesky decomposition, 2016. * */ virtual void chain() { const int packed_size = M_ * (M_ + 1) / 2; std::vector L_adj_cpu(packed_size); std::vector L_val_cpu(packed_size); for (size_type j = 0; j < packed_size; ++j) { L_adj_cpu[j] = vari_ref_L_[j]->adj_; L_val_cpu[j] = vari_ref_L_[j]->val_; } matrix_cl L = packed_copy(L_val_cpu, M_); matrix_cl L_adj = packed_copy(L_adj_cpu, M_); int block_size = M_ / opencl_context.tuning_opts().cholesky_rev_block_partition; block_size = std::max(block_size, 8); block_size = std::min( block_size, opencl_context.tuning_opts().cholesky_rev_min_block_size); // The following is an OpenCL implementation of // the chain() function from the cholesky_block // vari class implementation for (int k = M_; k > 0; k -= block_size) { const int j = std::max(0, k - block_size); const int k_j_ind = k - j; const int m_k_ind = M_ - k; matrix_cl R(k_j_ind, j, matrix_cl_view::Lower); matrix_cl D(k_j_ind, k_j_ind, matrix_cl_view::Lower); matrix_cl B(m_k_ind, j); matrix_cl C(m_k_ind, k_j_ind, matrix_cl_view::Lower); matrix_cl R_adj(k_j_ind, j, matrix_cl_view::Lower); matrix_cl D_adj(k_j_ind, k_j_ind, matrix_cl_view::Lower); matrix_cl B_adj(m_k_ind, j); matrix_cl C_adj(m_k_ind, k_j_ind, matrix_cl_view::Lower); R.sub_block(L, j, 0, 0, 0, k_j_ind, j); D.sub_block(L, j, j, 0, 0, k_j_ind, k_j_ind); B.sub_block(L, k, 0, 0, 0, m_k_ind, j); C.sub_block(L, k, j, 0, 0, m_k_ind, k_j_ind); R_adj.sub_block(L_adj, j, 0, 0, 0, k_j_ind, j); D_adj.sub_block(L_adj, j, j, 0, 0, k_j_ind, k_j_ind); B_adj.sub_block(L_adj, k, 0, 0, 0, m_k_ind, j); C_adj.sub_block(L_adj, k, j, 0, 0, m_k_ind, k_j_ind); C_adj = C_adj * tri_inverse(D); B_adj = B_adj - C_adj * R; D_adj = D_adj - transpose(C_adj) * C; symbolic_rev(D, D_adj); R_adj = R_adj - transpose(C_adj) * B - D_adj * R; D_adj = diagonal_multiply(D_adj, 0.5); L_adj.sub_block(R_adj, 0, 0, j, 0, k_j_ind, j); L_adj.sub_block(D_adj, 0, 0, j, j, k_j_ind, k_j_ind); L_adj.sub_block(B_adj, 0, 0, k, 0, m_k_ind, j); L_adj.sub_block(C_adj, 0, 0, k, j, m_k_ind, k_j_ind); } L_adj.view(matrix_cl_view::Lower); L_adj_cpu = packed_copy(L_adj); for (size_type j = 0; j < packed_size; ++j) { vari_ref_A_[j]->adj_ += L_adj_cpu[j]; } } }; #endif /** * Reverse mode specialization of cholesky decomposition * * Internally calls Eigen::LLT rather than using * stan::math::cholesky_decompose in order to use an inplace decomposition. * * Note chainable stack varis are created below in Matrix * * @param A Matrix * @return L cholesky factor of A */ inline Eigen::Matrix cholesky_decompose( const Eigen::Matrix& A) { check_square("cholesky_decompose", "A", A); Eigen::Matrix L_A(value_of_rec(A)); #ifdef STAN_OPENCL L_A = cholesky_decompose(L_A); #else check_symmetric("cholesky_decompose", "A", A); Eigen::LLT, Eigen::Lower> L_factor(L_A); check_pos_definite("cholesky_decompose", "m", L_factor); #endif // Memory allocated in arena. // cholesky_scalar gradient faster for small matrices compared to // cholesky_block vari* dummy = new vari(0.0, false); Eigen::Matrix L(A.rows(), A.cols()); if (L_A.rows() <= 35) { cholesky_scalar* baseVari = new cholesky_scalar(A, L_A); size_t accum = 0; size_t accum_i = accum; for (size_type j = 0; j < L.cols(); ++j) { for (size_type i = j; i < L.cols(); ++i) { accum_i += i; size_t pos = j + accum_i; L.coeffRef(i, j).vi_ = baseVari->vari_ref_L_[pos]; } for (size_type k = 0; k < j; ++k) { L.coeffRef(k, j).vi_ = dummy; } accum += j; accum_i = accum; } } else { #ifdef STAN_OPENCL if (L_A.rows() > opencl_context.tuning_opts().cholesky_size_worth_transfer) { cholesky_opencl* baseVari = new cholesky_opencl(A, L_A); internal::set_lower_tri_coeff_ref(L, baseVari->vari_ref_L_); } else { cholesky_block* baseVari = new cholesky_block(A, L_A); internal::set_lower_tri_coeff_ref(L, baseVari->vari_ref_L_); } #else cholesky_block* baseVari = new cholesky_block(A, L_A); internal::set_lower_tri_coeff_ref(L, baseVari->vari_ref_L_); #endif } return L; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/simplex_constrain.hpp0000644000176200001440000000652513766554456025425 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_SIMPLEX_CONSTRAIN_HPP #define STAN_MATH_REV_MAT_FUN_SIMPLEX_CONSTRAIN_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class simplex_constrain_op { int N_; double* diag_; // diagonal of the Jacobian of the operator double* z_; public: /** * Return the simplex corresponding to the specified free vector. * A simplex is a vector containing values greater than or equal * to 0 that sum to 1. A vector with (K-1) unconstrained values * will produce a simplex of size K. * * The transform is based on a centered stick-breaking process. * * @tparam size Number of adjoints to return * @param needs_adj Boolean indicators of if adjoints of arguments will be * needed * @param y Free vector input of dimensionality K - 1 * @return Simplex of dimensionality K */ template Eigen::VectorXd operator()(const std::array& needs_adj, const Eigen::VectorXd& y) { N_ = y.size(); diag_ = ChainableStack::instance_->memalloc_.alloc_array(N_); z_ = ChainableStack::instance_->memalloc_.alloc_array(N_); Eigen::Matrix x(N_ + 1); double stick_len(1.0); for (int k = 0; k < N_; ++k) { double log_N_minus_k = std::log(N_ - k); z_[k] = inv_logit(y(k) - log_N_minus_k); diag_[k] = stick_len * z_[k] * inv_logit(log_N_minus_k - y(k)); x(k) = stick_len * z_[k]; stick_len -= x(k); } x(N_) = stick_len; return x; } /* * Compute the result of multiply the transpose of the adjoint vector times * the Jacobian of the simplex_constrain operator. * * @tparam size Number of adjoints to return * @param needs_adj Boolean indicators of if adjoints of arguments will be * needed * @param adj Eigen::VectorXd of adjoints at the output of the softmax * @return Eigen::VectorXd of adjoints propagated through softmax operation */ template auto multiply_adjoint_jacobian(const std::array& needs_adj, const Eigen::VectorXd& adj) const { Eigen::VectorXd adj_times_jac(N_); double acc = adj(N_); if (N_ > 0) { adj_times_jac(N_ - 1) = diag_[N_ - 1] * (adj(N_ - 1) - acc); for (int n = N_ - 1; --n >= 0;) { acc = adj(n + 1) * z_[n + 1] + (1 - z_[n + 1]) * acc; adj_times_jac(n) = diag_[n] * (adj(n) - acc); } } return std::make_tuple(adj_times_jac); } }; } // namespace internal /** * Return the simplex corresponding to the specified free vector. * A simplex is a vector containing values greater than or equal * to 0 that sum to 1. A vector with (K-1) unconstrained values * will produce a simplex of size K. * * The transform is based on a centered stick-breaking process. * * @param y Free vector input of dimensionality K - 1 * @return Simplex of dimensionality K */ inline Eigen::Matrix simplex_constrain( const Eigen::Matrix& y) { return adj_jac_apply(y); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/cov_exp_quad.hpp0000644000176200001440000001176213766554456024340 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_COV_EXP_QUAD_HPP #define STAN_MATH_REV_MAT_FUN_COV_EXP_QUAD_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * @deprecated use gp_exp_quad_cov_vari */ template class cov_exp_quad_vari : public vari { public: const size_t size_; const size_t size_ltri_; const double l_d_; const double sigma_d_; const double sigma_sq_d_; double* dist_; vari* l_vari_; vari* sigma_vari_; vari** cov_lower_; vari** cov_diag_; /** * @deprecated use gp_exp_quad_cov_vari */ cov_exp_quad_vari(const std::vector& x, const T_sigma& sigma, const T_l& l) : vari(0.0), size_(x.size()), size_ltri_(size_ * (size_ - 1) / 2), l_d_(value_of(l)), sigma_d_(value_of(sigma)), sigma_sq_d_(sigma_d_ * sigma_d_), dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), l_vari_(l.vi_), sigma_vari_(sigma.vi_), cov_lower_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), cov_diag_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { double inv_half_sq_l_d = 0.5 / (l_d_ * l_d_); size_t pos = 0; for (size_t j = 0; j < size_ - 1; ++j) { for (size_t i = j + 1; i < size_; ++i) { double dist_sq = squared_distance(x[i], x[j]); dist_[pos] = dist_sq; cov_lower_[pos] = new vari( sigma_sq_d_ * std::exp(-dist_sq * inv_half_sq_l_d), false); ++pos; } } for (size_t i = 0; i < size_; ++i) { cov_diag_[i] = new vari(sigma_sq_d_, false); } } virtual void chain() { double adjl = 0; double adjsigma = 0; for (size_t i = 0; i < size_ltri_; ++i) { vari* el_low = cov_lower_[i]; double prod_add = el_low->adj_ * el_low->val_; adjl += prod_add * dist_[i]; adjsigma += prod_add; } for (size_t i = 0; i < size_; ++i) { vari* el = cov_diag_[i]; adjsigma += el->adj_ * el->val_; } l_vari_->adj_ += adjl / (l_d_ * l_d_ * l_d_); sigma_vari_->adj_ += adjsigma * 2 / sigma_d_; } }; /** * @deprecated use gp_exp_quad_cov_vari */ template class cov_exp_quad_vari : public vari { public: const size_t size_; const size_t size_ltri_; const double l_d_; const double sigma_d_; const double sigma_sq_d_; double* dist_; vari* l_vari_; vari** cov_lower_; vari** cov_diag_; /** * @deprecated use gp_exp_quad_cov_vari */ cov_exp_quad_vari(const std::vector& x, double sigma, const T_l& l) : vari(0.0), size_(x.size()), size_ltri_(size_ * (size_ - 1) / 2), l_d_(value_of(l)), sigma_d_(value_of(sigma)), sigma_sq_d_(sigma_d_ * sigma_d_), dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), l_vari_(l.vi_), cov_lower_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), cov_diag_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { double inv_half_sq_l_d = 0.5 / (l_d_ * l_d_); size_t pos = 0; for (size_t j = 0; j < size_ - 1; ++j) { for (size_t i = j + 1; i < size_; ++i) { double dist_sq = squared_distance(x[i], x[j]); dist_[pos] = dist_sq; cov_lower_[pos] = new vari( sigma_sq_d_ * std::exp(-dist_sq * inv_half_sq_l_d), false); ++pos; } } for (size_t i = 0; i < size_; ++i) { cov_diag_[i] = new vari(sigma_sq_d_, false); } } virtual void chain() { double adjl = 0; for (size_t i = 0; i < size_ltri_; ++i) { vari* el_low = cov_lower_[i]; adjl += el_low->adj_ * el_low->val_ * dist_[i]; } l_vari_->adj_ += adjl / (l_d_ * l_d_ * l_d_); } }; /** * @deprecated use gp_exp_quad_cov_vari */ template ::type>> inline Eigen::Matrix cov_exp_quad(const std::vector& x, const var& sigma, const var& l) { return gp_exp_quad_cov(x, sigma, l); } /** * @deprecated use gp_exp_quad_cov_vari */ template ::type>> inline Eigen::Matrix cov_exp_quad(const std::vector& x, double sigma, const var& l) { return gp_exp_quad_cov(x, sigma, l); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/tcrossprod.hpp0000644000176200001440000000312213766554456024054 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TCROSSPROD_HPP #define STAN_MATH_REV_MAT_FUN_TCROSSPROD_HPP #include #include #include #include #include #include #include namespace stan { namespace math { /** * Returns the result of post-multiplying a matrix by its * own transpose. * @param M Matrix to multiply. * @return M times its transpose. */ inline matrix_v tcrossprod(const matrix_v& M) { if (M.rows() == 0) { return matrix_v(0, 0); } // if (M.rows() == 1) // return M * M.transpose(); // WAS JUST THIS // matrix_v result(M.rows(), M.rows()); // return result.setZero().selfadjointView().rankUpdate(M); matrix_v MMt(M.rows(), M.rows()); vari** vs = reinterpret_cast(ChainableStack::instance_->memalloc_.alloc( (M.rows() * M.cols()) * sizeof(vari*))); int pos = 0; for (int m = 0; m < M.rows(); ++m) { for (int n = 0; n < M.cols(); ++n) { vs[pos++] = M(m, n).vi_; } } for (int m = 0; m < M.rows(); ++m) { MMt(m, m) = var(new internal::dot_self_vari(vs + m * M.cols(), M.cols())); } for (int m = 0; m < M.rows(); ++m) { for (int n = 0; n < m; ++n) { MMt(m, n) = var(new internal::dot_product_vari( vs + m * M.cols(), vs + n * M.cols(), M.cols())); MMt(n, m) = MMt(m, n); } } return MMt; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/log_determinant_ldlt.hpp0000644000176200001440000000262413766554456026052 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LOG_DETERMINANT_LDLT_HPP #define STAN_MATH_REV_MAT_FUN_LOG_DETERMINANT_LDLT_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { /** * Returns the log det of the matrix whose LDLT factorization is given * See The Matrix Cookbook's chapter on Derivatives of a Determinant * In this case, it is just the inverse of the underlying matrix * @param A, which is a LDLT_factor * @return ln(det(A)) * @throws never */ template class log_det_ldlt_vari : public vari { public: explicit log_det_ldlt_vari(const LDLT_factor &A) : vari(A.alloc_->log_abs_det()), alloc_ldlt_(A.alloc_) {} virtual void chain() { Eigen::Matrix invA; // If we start computing Jacobians, this may be a bit inefficient invA.setIdentity(alloc_ldlt_->N_, alloc_ldlt_->N_); alloc_ldlt_->ldlt_.solveInPlace(invA); const_cast(alloc_ldlt_->variA_).adj() += adj_ * invA; } const LDLT_alloc *alloc_ldlt_; }; } // namespace internal template var log_determinant_ldlt(LDLT_factor &A) { return var(new internal::log_det_ldlt_vari(A)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/squared_distance.hpp0000644000176200001440000001020513766554456025170 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_SQUARED_DISTANCE_HPP #define STAN_MATH_REV_MAT_FUN_SQUARED_DISTANCE_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class squared_distance_vv_vari : public vari { protected: vari** v1_; vari** v2_; size_t length_; template inline static double var_squared_distance( const Eigen::Matrix& v1, const Eigen::Matrix& v2) { using idx_t = typename index_type::type; return (Eigen::Ref(v1).val() - Eigen::Ref(v2).val()) .squaredNorm(); } public: template squared_distance_vv_vari(const Eigen::Matrix& v1, const Eigen::Matrix& v2) : vari(var_squared_distance(v1, v2)), length_(v1.size()) { v1_ = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(vari*))); v2_ = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(vari*))); Eigen::Map(v1_, length_) = v1.vi(); Eigen::Map(v2_, length_) = v2.vi(); } virtual void chain() { Eigen::Map v1_map(v1_, length_); Eigen::Map v2_map(v2_, length_); vector_d di = 2 * adj_ * (v1_map.val() - v2_map.val()); v1_map.adj() += di; v2_map.adj() -= di; } }; class squared_distance_vd_vari : public vari { protected: vari** v1_; double* v2_; size_t length_; template inline static double var_squared_distance( const Eigen::Matrix& v1, const Eigen::Matrix& v2) { using idx_t = typename index_type::type; return (Eigen::Ref(v1).val() - Eigen::Ref(v2)) .squaredNorm(); } public: template squared_distance_vd_vari(const Eigen::Matrix& v1, const Eigen::Matrix& v2) : vari(var_squared_distance(v1, v2)), length_(v1.size()) { v1_ = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(vari*))); v2_ = reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(length_ * sizeof(double))); Eigen::Map(v1_, length_) = v1.vi(); Eigen::Map(v2_, length_) = v2; } virtual void chain() { Eigen::Map v1_map(v1_, length_); v1_map.adj() += 2 * adj_ * (v1_map.val() - Eigen::Map(v2_, length_)); } }; } // namespace internal template inline var squared_distance(const Eigen::Matrix& v1, const Eigen::Matrix& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); return var(new internal::squared_distance_vv_vari(v1, v2)); } template inline var squared_distance(const Eigen::Matrix& v1, const Eigen::Matrix& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); return var(new internal::squared_distance_vd_vari(v1, v2)); } template inline var squared_distance(const Eigen::Matrix& v1, const Eigen::Matrix& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); return var(new internal::squared_distance_vd_vari(v2, v1)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/log_determinant_spd.hpp0000644000176200001440000000335613766554456025704 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LOG_DETERMINANT_SPD_HPP #define STAN_MATH_REV_MAT_FUN_LOG_DETERMINANT_SPD_HPP #include #include #include #include #include #include #include namespace stan { namespace math { template inline var log_determinant_spd(const Eigen::Matrix& m) { check_square("log_determinant_spd", "m", m); matrix_d m_d = m.val(); Eigen::LDLT ldlt(m_d); if (ldlt.info() != Eigen::Success) { double y = 0; domain_error("log_determinant_spd", "matrix argument", y, "failed LDLT factorization"); } // compute the inverse of A (needed for the derivative) m_d.setIdentity(m.rows(), m.cols()); ldlt.solveInPlace(m_d); if (ldlt.isNegative() || (ldlt.vectorD().array() <= 1e-16).any()) { double y = 0; domain_error("log_determinant_spd", "matrix argument", y, "matrix is negative definite"); } double val = ldlt.vectorD().array().log().sum(); check_finite("log_determinant_spd", "log determininant of the matrix argument", val); vari** operands = ChainableStack::instance_->memalloc_.alloc_array(m.size()); Eigen::Map(operands, m.rows(), m.cols()) = m.vi(); double* gradients = ChainableStack::instance_->memalloc_.alloc_array(m.size()); Eigen::Map(gradients, m.rows(), m.cols()) = m_d; return var( new precomputed_gradients_vari(val, m.size(), operands, gradients)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/inverse.hpp0000644000176200001440000000555513766554456023341 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_INVERSE_HPP #define STAN_MATH_REV_MAT_FUN_INVERSE_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class inverse_vari : public vari { public: int M_; // A.rows() = A.cols() double *A_; double *A_inv_; vari **vari_ref_A_; vari **vari_ref_A_inv_; explicit inverse_vari(const Eigen::Matrix &A) : vari(0.0), M_(A.rows()), A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), A_inv_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(double) * A.rows() * A.cols()))), vari_ref_A_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * A.cols()))), vari_ref_A_inv_(reinterpret_cast( ChainableStack::instance_->memalloc_.alloc(sizeof(vari *) * A.rows() * A.cols()))) { using Eigen::Map; Map Ad(A_, M_, M_); Map A_inv_d(A_inv_, M_, M_); Ad = A.val(); A_inv_d = Ad.inverse(); Map(vari_ref_A_, M_, M_) = A.vi(); Map(vari_ref_A_inv_, M_, M_) = A_inv_d.unaryExpr([](double x) { return new vari(x, false); }); } /** * Reverse mode differentiation algorithm reference: * * Mike Giles. An extended collection of matrix derivative results for * forward and reverse mode AD. Jan. 2008. * * Section 2.2.3 Inverse. */ virtual void chain() { using Eigen::Map; matrix_d adj_A_inv = Map(vari_ref_A_inv_, M_, M_).adj(); Map A_inv_d(A_inv_, M_, M_); matrix_d adjA = A_inv_d.transpose() * adj_A_inv * A_inv_d.transpose(); Map(vari_ref_A_, M_, M_).adj() -= adjA; } }; } // namespace internal /** * Reverse mode specialization of calculating the inverse of the matrix. * * @param m Specified matrix. * @return Inverse of the matrix. */ inline matrix_v inverse(const matrix_v &m) { check_square("inverse", "m", m); check_nonempty("inverse", "m", m); matrix_v res(m.rows(), m.cols()); internal::inverse_vari *baseVari = new internal::inverse_vari(m); res.vi() = Eigen::Map(baseVari->vari_ref_A_inv_, res.rows(), res.cols()); return res; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/determinant.hpp0000644000176200001440000000317313766554456024172 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_DETERMINANT_HPP #define STAN_MATH_REV_MAT_FUN_DETERMINANT_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { template class determinant_vari : public vari { int rows_; int cols_; double* A_; vari** adjARef_; public: explicit determinant_vari(const Eigen::Matrix& A) : vari(determinant_vari_calc(A)), rows_(A.rows()), cols_(A.cols()), A_(reinterpret_cast(ChainableStack::instance_->memalloc_.alloc( sizeof(double) * A.rows() * A.cols()))), adjARef_( reinterpret_cast(ChainableStack::instance_->memalloc_.alloc( sizeof(vari*) * A.rows() * A.cols()))) { Eigen::Map(A_, rows_, cols_) = A.val(); Eigen::Map(adjARef_, rows_, cols_) = A.vi(); } static double determinant_vari_calc(const Eigen::Matrix& A) { return A.val().determinant(); } virtual void chain() { Eigen::Map(adjARef_, rows_, cols_).adj() += (adj_ * val_) * Eigen::Map(A_, rows_, cols_) .inverse() .transpose(); } }; } // namespace internal template inline var determinant(const Eigen::Matrix& m) { check_square("determinant", "m", m); return var(new internal::determinant_vari(m)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/to_var.hpp0000644000176200001440000000577713766554456023166 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TO_VAR_HPP #define STAN_MATH_REV_MAT_FUN_TO_VAR_HPP #include #include #include #include #include #include namespace stan { namespace math { /** * Converts argument to an automatic differentiation variable. * * Returns a var variable with the input value. * * @param[in] m A Matrix with scalars * @return A Matrix with automatic differentiation variables */ inline matrix_v to_var(const matrix_d& m) { matrix_v m_v = m; return m_v; } /** * Specialization of to_var for non-const matrices of vars * * * @param[in,out] m A matrix of automatic differentation variables. * @return The input matrix of automatic differentiation variables. */ inline matrix_v& to_var(matrix_v& m) { return m; } /** * Specialization of to_var for const matrices of vars * * * @param[in,out] m A matrix of automatic differentation variables. * @return The input matrix of automatic differentiation variables. */ inline const matrix_v& to_var(const matrix_v& m) { return m; } /** * Converts argument to an automatic differentiation variable. * * Returns a var variable with the input value. * * @param[in] v A Vector of scalars * @return A Vector of automatic differentiation variables with * values of v */ inline vector_v to_var(const vector_d& v) { vector_v v_v = v; return v_v; } /** * Specialization of to_var for const column vector of vars * * * @param[in,out] v A column vector of automatic differentation variables. * @return The input column vector of automatic differentiation variables. */ inline const vector_v& to_var(const vector_v& v) { return v; } /** * Specialization of to_var for non-const column vector of vars * * * @param[in,out] v A column vector of automatic differentation variables. * @return The input column vector of automatic differentiation variables. */ inline vector_v& to_var(vector_v& v) { return v; } /** * Converts argument to an automatic differentiation variable. * * Returns a var variable with the input value. * * @param[in] rv A row vector of scalars * @return A row vector of automatic differentation variables with * values of rv. */ inline row_vector_v to_var(const row_vector_d& rv) { row_vector_v rv_v = rv; return rv_v; } /** * Specialization of to_var for const row vector of vars * * * @param[in,out] rv A column vector of automatic differentation variables. * @return The input row vector of automatic differentiation variables. */ inline const row_vector_v& to_var(const row_vector_v& rv) { return rv; } /** * Specialization of to_var for non-const row vector of vars * * * @param[in,out] rv A column vector of automatic differentation variables. * @return The input row vector of automatic differentiation variables. */ inline row_vector_v& to_var(row_vector_v& rv) { return rv; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/log_determinant.hpp0000644000176200001440000000216113766554456025027 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LOG_DETERMINANT_HPP #define STAN_MATH_REV_MAT_FUN_LOG_DETERMINANT_HPP #include #include #include #include #include namespace stan { namespace math { template inline var log_determinant(const Eigen::Matrix& m) { using Eigen::Matrix; math::check_square("log_determinant", "m", m); Eigen::FullPivHouseholderQR > hh = m.val().fullPivHouseholderQr(); vari** varis = ChainableStack::instance_->memalloc_.alloc_array(m.size()); Eigen::Map(varis, m.rows(), m.cols()) = m.vi(); double* gradients = ChainableStack::instance_->memalloc_.alloc_array(m.size()); Eigen::Map(gradients, m.rows(), m.cols()) = hh.inverse().transpose(); return var(new precomputed_gradients_vari(hh.logAbsDeterminant(), m.size(), varis, gradients)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/softmax.hpp0000644000176200001440000000446413766554456023345 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_SOFTMAX_HPP #define STAN_MATH_REV_MAT_FUN_SOFTMAX_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class softmax_op { int N_; double* y_; // Holds the results of the softmax public: softmax_op() : N_(0), y_(nullptr) {} /* * Compute the softmax of the unconstrained input vector * * @param alpha Unconstrained input vector. * @return Softmax of the input. */ template Eigen::VectorXd operator()(const std::array& needs_adj, const Eigen::VectorXd& alpha) { N_ = alpha.size(); y_ = ChainableStack::instance_->memalloc_.alloc_array(N_); auto y = softmax(alpha); for (int n = 0; n < N_; ++n) { y_[n] = y(n); } return y; } /* * Compute the result of multiply the transpose of the adjoint vector times * the Jacobian of the softmax operator. It is more efficient to do this * without actually computing the Jacobian and doing the vector-matrix * product. * * @param adj Eigen::VectorXd of adjoints at the output of the softmax * @return Eigen::VectorXd of adjoints propagated through softmax operation */ template std::tuple multiply_adjoint_jacobian( const std::array& needs_adj, const Eigen::VectorXd& adj) const { vector_d adj_times_jac(N_); Eigen::Map y(y_, N_); adj_times_jac = -y * adj.dot(y) + y.cwiseProduct(adj); return std::make_tuple(adj_times_jac); } }; } // namespace internal /** * Return the softmax of the specified Eigen vector. Softmax is * guaranteed to return a simplex. * * @param alpha Unconstrained input vector. * @return Softmax of the input. * @throw std::domain_error If the input vector is size 0. */ inline Eigen::Matrix softmax( const Eigen::Matrix& alpha) { check_nonzero_size("softmax", "alpha", alpha); return adj_jac_apply(alpha); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/gp_exp_quad_cov.hpp0000644000176200001440000002221513766554456025021 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_GP_EXP_QUAD_COV_HPP #define STAN_MATH_REV_MAT_FUN_GP_EXP_QUAD_COV_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * This is a subclass of the vari class for precomputed * gradients of gp_exp_quad_cov. * * The class stores the double values for the distance * matrix, pointers to the varis for the covariance * matrix, along with a pointer to the vari for sigma, * and the vari for length_scale. * * @tparam T_x type of std::vector of elements * @tparam T_sigma type of sigma * @tparam T_l type of length scale */ template class gp_exp_quad_cov_vari : public vari { public: const size_t size_; const size_t size_ltri_; const double l_d_; const double sigma_d_; const double sigma_sq_d_; double *dist_; vari *l_vari_; vari *sigma_vari_; vari **cov_lower_; vari **cov_diag_; /** * Constructor for gp_exp_quad_cov. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param x std::vector input that can be used in square distance * Assumes each element of x is the same size * @param sigma standard deviation * @param length_scale length scale */ gp_exp_quad_cov_vari(const std::vector &x, const T_sigma &sigma, const T_l &length_scale) : vari(0.0), size_(x.size()), size_ltri_(size_ * (size_ - 1) / 2), l_d_(value_of(length_scale)), sigma_d_(value_of(sigma)), sigma_sq_d_(sigma_d_ * sigma_d_), dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), l_vari_(length_scale.vi_), sigma_vari_(sigma.vi_), cov_lower_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), cov_diag_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { double inv_half_sq_l_d = 0.5 / (l_d_ * l_d_); size_t pos = 0; for (size_t j = 0; j < size_ - 1; ++j) { for (size_t i = j + 1; i < size_; ++i) { double dist_sq = squared_distance(x[i], x[j]); dist_[pos] = dist_sq; cov_lower_[pos] = new vari( sigma_sq_d_ * std::exp(-dist_sq * inv_half_sq_l_d), false); ++pos; } } for (size_t i = 0; i < size_; ++i) { cov_diag_[i] = new vari(sigma_sq_d_, false); } } virtual void chain() { double adjl = 0; double adjsigma = 0; for (size_t i = 0; i < size_ltri_; ++i) { vari *el_low = cov_lower_[i]; double prod_add = el_low->adj_ * el_low->val_; adjl += prod_add * dist_[i]; adjsigma += prod_add; } for (size_t i = 0; i < size_; ++i) { vari *el = cov_diag_[i]; adjsigma += el->adj_ * el->val_; } l_vari_->adj_ += adjl / (l_d_ * l_d_ * l_d_); sigma_vari_->adj_ += adjsigma * 2 / sigma_d_; } }; /** * This is a subclass of the vari class for precomputed * gradients of gp_exp_quad_cov. * * The class stores the double values for the distance * matrix, pointers to the varis for the covariance * matrix, along with a pointer to the vari for sigma, * and the vari for length_scale. * * @tparam T_x type of std::vector of elements * @tparam T_l type of length scale */ template class gp_exp_quad_cov_vari : public vari { public: const size_t size_; const size_t size_ltri_; const double l_d_; const double sigma_d_; const double sigma_sq_d_; double *dist_; vari *l_vari_; vari **cov_lower_; vari **cov_diag_; /** * Constructor for gp_exp_quad_cov. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param x std::vector input that can be used in square distance * Assumes each element of x is the same size * @param sigma standard deviation * @param length_scale length scale */ gp_exp_quad_cov_vari(const std::vector &x, double sigma, const T_l &length_scale) : vari(0.0), size_(x.size()), size_ltri_(size_ * (size_ - 1) / 2), l_d_(value_of(length_scale)), sigma_d_(value_of(sigma)), sigma_sq_d_(sigma_d_ * sigma_d_), dist_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), l_vari_(length_scale.vi_), cov_lower_(ChainableStack::instance_->memalloc_.alloc_array( size_ltri_)), cov_diag_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { double inv_half_sq_l_d = 0.5 / (l_d_ * l_d_); size_t pos = 0; for (size_t j = 0; j < size_ - 1; ++j) { for (size_t i = j + 1; i < size_; ++i) { double dist_sq = squared_distance(x[i], x[j]); dist_[pos] = dist_sq; cov_lower_[pos] = new vari( sigma_sq_d_ * std::exp(-dist_sq * inv_half_sq_l_d), false); ++pos; } } for (size_t i = 0; i < size_; ++i) { cov_diag_[i] = new vari(sigma_sq_d_, false); } } virtual void chain() { double adjl = 0; for (size_t i = 0; i < size_ltri_; ++i) { vari *el_low = cov_lower_[i]; adjl += el_low->adj_ * el_low->val_ * dist_[i]; } l_vari_->adj_ += adjl / (l_d_ * l_d_ * l_d_); } }; /** * Returns a squared exponential kernel. * * @param x std::vector input that can be used in square distance * Assumes each element of x is the same size * @param sigma standard deviation * @param length_scale length scale * @return squared distance * @throw std::domain_error if sigma <= 0, l <= 0, or * x is nan or infinite */ template ::type>> inline Eigen::Matrix gp_exp_quad_cov(const std::vector &x, const var &sigma, const var &length_scale) { check_positive("gp_exp_quad_cov", "sigma", sigma); check_positive("gp_exp_quad_cov", "length_scale", length_scale); size_t x_size = x.size(); for (size_t i = 0; i < x_size; ++i) { check_not_nan("gp_exp_quad_cov", "x", x[i]); } Eigen::Matrix cov(x_size, x_size); if (x_size == 0) { return cov; } gp_exp_quad_cov_vari *baseVari = new gp_exp_quad_cov_vari(x, sigma, length_scale); size_t pos = 0; for (size_t j = 0; j < x_size - 1; ++j) { for (size_t i = (j + 1); i < x_size; ++i) { cov.coeffRef(i, j).vi_ = baseVari->cov_lower_[pos]; cov.coeffRef(j, i).vi_ = cov.coeffRef(i, j).vi_; ++pos; } cov.coeffRef(j, j).vi_ = baseVari->cov_diag_[j]; } cov.coeffRef(x_size - 1, x_size - 1).vi_ = baseVari->cov_diag_[x_size - 1]; return cov; } /** * Returns a squared exponential kernel. * * @param x std::vector input that can be used in square distance * Assumes each element of x is the same size * @param sigma standard deviation * @param length_scale length scale * @return squared distance * @throw std::domain_error if sigma <= 0, l <= 0, or * x is nan or infinite */ template ::type>> inline Eigen::Matrix gp_exp_quad_cov(const std::vector &x, double sigma, const var &length_scale) { check_positive("gp_exp_quad_cov", "marginal variance", sigma); check_positive("gp_exp_quad_cov", "length-scale", length_scale); size_t x_size = x.size(); for (size_t i = 0; i < x_size; ++i) { check_not_nan("gp_exp_quad_cov", "x", x[i]); } Eigen::Matrix cov(x_size, x_size); if (x_size == 0) { return cov; } gp_exp_quad_cov_vari *baseVari = new gp_exp_quad_cov_vari(x, sigma, length_scale); size_t pos = 0; for (size_t j = 0; j < x_size - 1; ++j) { for (size_t i = (j + 1); i < x_size; ++i) { cov.coeffRef(i, j).vi_ = baseVari->cov_lower_[pos]; cov.coeffRef(j, i).vi_ = cov.coeffRef(i, j).vi_; ++pos; } cov.coeffRef(j, j).vi_ = baseVari->cov_diag_[j]; } cov.coeffRef(x_size - 1, x_size - 1).vi_ = baseVari->cov_diag_[x_size - 1]; return cov; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/variance.hpp0000644000176200001440000000371113766554456023446 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_VARIANCE_HPP #define STAN_MATH_REV_MAT_FUN_VARIANCE_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { inline var calc_variance(size_t size, const var* dtrs) { vari** varis = ChainableStack::instance_->memalloc_.alloc_array(size); double* partials = ChainableStack::instance_->memalloc_.alloc_array(size); Eigen::Map dtrs_map(dtrs, size); Eigen::Map(varis, size) = dtrs_map.vi(); vector_d dtrs_vals = dtrs_map.val(); vector_d diff = dtrs_vals.array() - dtrs_vals.mean(); double size_m1 = size - 1; Eigen::Map(partials, size) = 2 * diff.array() / size_m1; double variance = diff.squaredNorm() / size_m1; return var(new stored_gradient_vari(variance, size, varis, partials)); } } // namespace internal /** * Return the sample variance of the specified standard * vector. Raise domain error if size is not greater than zero. * * @param[in] v a vector * @return sample variance of specified vector */ inline var variance(const std::vector& v) { check_nonzero_size("variance", "v", v); if (v.size() == 1) { return 0; } return internal::calc_variance(v.size(), &v[0]); } /* * Return the sample variance of the specified vector, row vector, * or matrix. Raise domain error if size is not greater than * zero. * * @tparam R number of rows * @tparam C number of columns * @param[in] m input matrix * @return sample variance of specified matrix */ template var variance(const Eigen::Matrix& m) { check_nonzero_size("variance", "m", m); if (m.size() == 1) { return 0; } return internal::calc_variance(m.size(), &m(0)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/quad_form_sym.hpp0000644000176200001440000000310313766554456024516 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_QUAD_FORM_SYM_HPP #define STAN_MATH_REV_MAT_FUN_QUAD_FORM_SYM_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { template ...> inline Eigen::Matrix quad_form_sym( const Eigen::Matrix& A, const Eigen::Matrix& B) { check_square("quad_form", "A", A); check_symmetric("quad_form_sym", "A", A); check_multiplicable("quad_form_sym", "A", A, "B", B); internal::quad_form_vari* baseVari = new internal::quad_form_vari(A, B, true); return baseVari->impl_->C_; } template ...> inline var quad_form_sym(const Eigen::Matrix& A, const Eigen::Matrix& B) { check_square("quad_form", "A", A); check_symmetric("quad_form_sym", "A", A); check_multiplicable("quad_form_sym", "A", A, "B", B); internal::quad_form_vari* baseVari = new internal::quad_form_vari(A, B, true); return baseVari->impl_->C_(0, 0); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/log_sum_exp.hpp0000644000176200001440000000257413766554456024205 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_LOG_SUM_EXP_HPP #define STAN_MATH_REV_MAT_FUN_LOG_SUM_EXP_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { // these function and the following class just translate // log_sum_exp for std::vector for Eigen::Matrix template inline double log_sum_exp_as_double(const Eigen::Matrix& x) { const double max = x.val().maxCoeff(); if (!std::isfinite(max)) { return max; } return max + std::log((x.val().array() - max).exp().sum()); } class log_sum_exp_matrix_vari : public op_matrix_vari { public: template explicit log_sum_exp_matrix_vari(const Eigen::Matrix& x) : op_matrix_vari(log_sum_exp_as_double(x), x) {} void chain() { Eigen::Map vis_map(vis_, size_); vis_map.adj().array() += adj_ * (vis_map.val().array() - val_).exp(); } }; } // namespace internal /** * Returns the log sum of exponentials. * * @param x matrix */ template inline var log_sum_exp(const Eigen::Matrix& x) { return var(new internal::log_sum_exp_matrix_vari(x)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/trace_inv_quad_form_ldlt.hpp0000644000176200001440000001140313766554456026701 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_TRACE_INV_QUAD_FORM_LDLT_HPP #define STAN_MATH_REV_MAT_FUN_TRACE_INV_QUAD_FORM_LDLT_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template class trace_inv_quad_form_ldlt_impl : public chainable_alloc { protected: inline void initializeB(const Eigen::Matrix &B, bool haveD) { matrix_d Bd = B.val(); variB_ = B.vi(); AinvB_ = ldlt_.solve(Bd); if (haveD) { C_.noalias() = Bd.transpose() * AinvB_; } else { value_ = (Bd.transpose() * AinvB_).trace(); } } inline void initializeB(const Eigen::Matrix &B, bool haveD) { AinvB_ = ldlt_.solve(B); if (haveD) { C_.noalias() = B.transpose() * AinvB_; } else { value_ = (B.transpose() * AinvB_).trace(); } } template inline void initializeD(const Eigen::Matrix &D) { D_ = D.val(); variD_ = D.vi(); } template inline void initializeD(const Eigen::Matrix &D) { D_ = D; } public: template trace_inv_quad_form_ldlt_impl(const Eigen::Matrix &D, const LDLT_factor &A, const Eigen::Matrix &B) : Dtype_(stan::is_var::value), ldlt_(A) { initializeB(B, true); initializeD(D); value_ = (D_ * C_).trace(); } trace_inv_quad_form_ldlt_impl(const LDLT_factor &A, const Eigen::Matrix &B) : Dtype_(2), ldlt_(A) { initializeB(B, false); } const int Dtype_; // 0 = double, 1 = var, 2 = missing LDLT_factor ldlt_; matrix_d D_; matrix_vi variD_; matrix_vi variB_; matrix_d AinvB_; matrix_d C_; double value_; }; template class trace_inv_quad_form_ldlt_vari : public vari { protected: static inline void chainA( double adj, trace_inv_quad_form_ldlt_impl *impl) {} static inline void chainB( double adj, trace_inv_quad_form_ldlt_impl *impl) {} static inline void chainA( double adj, trace_inv_quad_form_ldlt_impl *impl) { Eigen::Matrix aA; if (impl->Dtype_ != 2) { aA.noalias() = -adj * (impl->AinvB_ * impl->D_.transpose() * impl->AinvB_.transpose()); } else { aA.noalias() = -adj * (impl->AinvB_ * impl->AinvB_.transpose()); } impl->ldlt_.alloc_->variA_.adj() += aA; } static inline void chainB( double adj, trace_inv_quad_form_ldlt_impl *impl) { matrix_d aB; if (impl->Dtype_ != 2) { aB.noalias() = adj * impl->AinvB_ * (impl->D_ + impl->D_.transpose()); } else { aB.noalias() = 2 * adj * impl->AinvB_; } impl->variB_.adj() += aB; } public: explicit trace_inv_quad_form_ldlt_vari( trace_inv_quad_form_ldlt_impl *impl) : vari(impl->value_), impl_(impl) {} virtual void chain() { // F = trace(D * B' * inv(A) * B) // aA = -aF * inv(A') * B * D' * B' * inv(A') // aB = aF*(inv(A) * B * D + inv(A') * B * D') // aD = aF*(B' * inv(A) * B) chainA(adj_, impl_); chainB(adj_, impl_); if (impl_->Dtype_ == 1) { impl_->variD_.adj() += adj_ * impl_->C_; } } trace_inv_quad_form_ldlt_impl *impl_; }; } // namespace internal /** * Compute the trace of an inverse quadratic form. I.E., this computes * trace(B^T A^-1 B) * where the LDLT_factor of A is provided. **/ template > inline return_type_t trace_inv_quad_form_ldlt( const LDLT_factor &A, const Eigen::Matrix &B) { check_multiplicable("trace_inv_quad_form_ldlt", "A", A, "B", B); internal::trace_inv_quad_form_ldlt_impl *impl_ = new internal::trace_inv_quad_form_ldlt_impl(A, B); return var( new internal::trace_inv_quad_form_ldlt_vari( impl_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/fun/multiply.hpp0000644000176200001440000005276513766554456023552 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUN_MULTIPLY_HPP #define STAN_MATH_REV_MAT_FUN_MULTIPLY_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * This is a subclass of the vari class for matrix * multiplication A * B where A is N by M and B * is M by K. * * The class stores the structure of each matrix, * the double values of A and B, and pointers to * the varis for A and B if A or B is a var. It * also instantiates and stores pointers to * varis for all elements of A * B. * * @tparam Ta Scalar type for matrix A * @tparam Ra Rows for matrix A * @tparam Ca Columns for matrix A, Rows for matrix B * @tparam Tb Scalar type for matrix B * @tparam Cb Columns for matrix B */ template class multiply_mat_vari : public vari { public: int A_rows_; int A_cols_; int B_cols_; int A_size_; int B_size_; double* Ad_; double* Bd_; vari** variRefA_; vari** variRefB_; vari** variRefAB_; /** * Constructor for multiply_mat_vari. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param A matrix * @param B matrix */ multiply_mat_vari(const Eigen::Matrix& A, const Eigen::Matrix& B) : vari(0.0), A_rows_(A.rows()), A_cols_(A.cols()), B_cols_(B.cols()), A_size_(A.size()), B_size_(B.size()), Ad_(ChainableStack::instance_->memalloc_.alloc_array(A_size_)), Bd_(ChainableStack::instance_->memalloc_.alloc_array(B_size_)), variRefA_( ChainableStack::instance_->memalloc_.alloc_array(A_size_)), variRefB_( ChainableStack::instance_->memalloc_.alloc_array(B_size_)), variRefAB_(ChainableStack::instance_->memalloc_.alloc_array( A_rows_ * B_cols_)) { using Eigen::Map; Map(variRefA_, A_rows_, A_cols_) = A.vi(); Map(variRefB_, A_cols_, B_cols_) = B.vi(); Map Ad(Ad_, A_rows_, A_cols_); Map Bd(Bd_, A_cols_, B_cols_); Ad = A.val(); Bd = B.val(); #ifdef STAN_OPENCL if (Ad.rows() * Ad.cols() * Bd.cols() > opencl_context.tuning_opts().multiply_dim_prod_worth_transfer) { matrix_cl Ad_cl(Ad); matrix_cl Bd_cl(Bd); matrix_cl variRefAB_cl = Ad_cl * Bd_cl; matrix_d temp = from_matrix_cl(variRefAB_cl); Map(variRefAB_, A_rows_, B_cols_) = temp.unaryExpr([](double x) { return new vari(x, false); }); } else { Map(variRefAB_, A_rows_, B_cols_) = (Ad * Bd).unaryExpr([](double x) { return new vari(x, false); }); } #else Map(variRefAB_, A_rows_, B_cols_) = (Ad * Bd).unaryExpr([](double x) { return new vari(x, false); }); #endif } virtual void chain() { using Eigen::Map; matrix_d adjAB(A_rows_, B_cols_); adjAB = Map(variRefAB_, A_rows_, B_cols_).adj(); #ifdef STAN_OPENCL if (A_rows_ * A_cols_ * B_cols_ > opencl_context.tuning_opts().multiply_dim_prod_worth_transfer) { matrix_cl adjAB_cl(adjAB); matrix_cl Ad_cl(Ad_, A_rows_, A_cols_); matrix_cl Bd_cl(Bd_, A_cols_, B_cols_); matrix_cl variRefA_cl = adjAB_cl * transpose(Bd_cl); matrix_cl variRefB_cl = transpose(Ad_cl) * adjAB_cl; matrix_d temp_variRefA = from_matrix_cl(variRefA_cl); matrix_d temp_variRefB = from_matrix_cl(variRefB_cl); Map(variRefA_, A_rows_, A_cols_).adj() += temp_variRefA; Map(variRefB_, A_cols_, B_cols_).adj() += temp_variRefB; } else { Map(variRefA_, A_rows_, A_cols_).adj() += adjAB * Map(Bd_, A_cols_, B_cols_).transpose(); Map(variRefB_, A_cols_, B_cols_).adj() += Map(Ad_, A_rows_, A_cols_).transpose() * adjAB; } #else Map(variRefA_, A_rows_, A_cols_).adj() += adjAB * Map(Bd_, A_cols_, B_cols_).transpose(); Map(variRefB_, A_cols_, B_cols_).adj() += Map(Ad_, A_rows_, A_cols_).transpose() * adjAB; #endif } }; /** * This is a subclass of the vari class for matrix * multiplication A * B where A is 1 by M and B * is M by 1. * * The class stores the structure of each matrix, * the double values of A and B, and pointers to * the varis for A and B if A or B is a var. It * also instantiates and stores pointers to * varis for all elements of A * B. * * @tparam Ta Scalar type for matrix A * @tparam Ca Columns for matrix A, Rows for matrix B * @tparam Tb Scalar type for matrix B */ template class multiply_mat_vari : public vari { public: int size_; double* Ad_; double* Bd_; vari** variRefA_; vari** variRefB_; vari* variRefAB_; /** * Constructor for multiply_mat_vari. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param A row vector * @param B vector */ multiply_mat_vari(const Eigen::Matrix& A, const Eigen::Matrix& B) : vari(0.0), size_(A.cols()), Ad_(ChainableStack::instance_->memalloc_.alloc_array(size_)), Bd_(ChainableStack::instance_->memalloc_.alloc_array(size_)), variRefA_( ChainableStack::instance_->memalloc_.alloc_array(size_)), variRefB_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { using Eigen::Map; Map(variRefA_, size_) = A.vi(); Map(variRefB_, size_) = B.vi(); Map Ad(Ad_, size_); Map Bd(Bd_, size_); Ad = A.val(); Bd = B.val(); variRefAB_ = new vari(Ad * Bd, false); } virtual void chain() { using Eigen::Map; double adjAB = variRefAB_->adj_; Map(variRefA_, size_).adj() += adjAB * Map(Bd_, size_); Map(variRefB_, size_).adj() += Map(Ad_, size_) * adjAB; } }; /** * This is a subclass of the vari class for matrix * multiplication A * B where A is an N by M * matrix of double and B is M by K. * * The class stores the structure of each matrix, * the double values of A and B, and pointers to * the varis for A and B if A or B is a var. It * also instantiates and stores pointers to * varis for all elements of A * B. * * @tparam Ra Rows for matrix A * @tparam Ca Columns for matrix A, Rows for matrix B * @tparam Tb Scalar type for matrix B * @tparam Cb Columns for matrix B */ template class multiply_mat_vari : public vari { public: int A_rows_; int A_cols_; int B_cols_; int A_size_; int B_size_; double* Ad_; double* Bd_; vari** variRefB_; vari** variRefAB_; /** * Constructor for multiply_mat_vari. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param A row vector * @param B vector */ multiply_mat_vari(const Eigen::Matrix& A, const Eigen::Matrix& B) : vari(0.0), A_rows_(A.rows()), A_cols_(A.cols()), B_cols_(B.cols()), A_size_(A.size()), B_size_(B.size()), Ad_(ChainableStack::instance_->memalloc_.alloc_array(A_size_)), Bd_(ChainableStack::instance_->memalloc_.alloc_array(B_size_)), variRefB_( ChainableStack::instance_->memalloc_.alloc_array(B_size_)), variRefAB_(ChainableStack::instance_->memalloc_.alloc_array( A_rows_ * B_cols_)) { using Eigen::Map; Map(variRefB_, A_cols_, B_cols_) = B.vi(); Map Ad(Ad_, A_rows_, A_cols_); Map Bd(Bd_, A_cols_, B_cols_); Ad = A; Bd = B.val(); #ifdef STAN_OPENCL if (Ad.rows() * Ad.cols() * Bd.cols() > opencl_context.tuning_opts().multiply_dim_prod_worth_transfer) { matrix_cl Ad_cl(Ad); matrix_cl Bd_cl(Bd); matrix_cl variRefAB_cl = Ad_cl * Bd_cl; matrix_d temp = from_matrix_cl(variRefAB_cl); Map(variRefAB_, A_rows_, B_cols_) = temp.unaryExpr([](double x) { return new vari(x, false); }); } else { Map(variRefAB_, A_rows_, B_cols_) = (Ad * Bd).unaryExpr([](double x) { return new vari(x, false); }); } #else Map(variRefAB_, A_rows_, B_cols_) = (Ad * Bd).unaryExpr([](double x) { return new vari(x, false); }); #endif } virtual void chain() { using Eigen::Map; matrix_d adjAB = Map(variRefAB_, A_rows_, B_cols_).adj(); #ifdef STAN_OPENCL if (A_rows_ * A_cols_ * B_cols_ > opencl_context.tuning_opts().multiply_dim_prod_worth_transfer) { matrix_cl adjAB_cl(adjAB); matrix_cl Ad_cl(Ad_, A_rows_, A_cols_); matrix_cl variRefB_cl = transpose(Ad_cl) * adjAB_cl; matrix_d temp_variRefB = from_matrix_cl(variRefB_cl); Map(variRefB_, A_cols_, B_cols_).adj() += temp_variRefB; } else { Map(variRefB_, A_cols_, B_cols_).adj() += Map(Ad_, A_rows_, A_cols_).transpose() * adjAB; } #else Map(variRefB_, A_cols_, B_cols_).adj() += Map(Ad_, A_rows_, A_cols_).transpose() * adjAB; #endif } }; /** * This is a subclass of the vari class for matrix * multiplication A * B where A is a double * row vector of length M and B is a vector of * length M. * * The class stores the structure of each matrix, * the double values of A and B, and pointers to * the varis for A and B if A or B is a var. It * also instantiates and stores pointers to * varis for all elements of A * B. * * @tparam Ca Columns for matrix A, Rows for matrix B * @tparam Tb Scalar type for matrix B */ template class multiply_mat_vari : public vari { public: int size_; double* Ad_; double* Bd_; vari** variRefB_; vari* variRefAB_; /** * Constructor for multiply_mat_vari. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param A row vector * @param B vector */ multiply_mat_vari(const Eigen::Matrix& A, const Eigen::Matrix& B) : vari(0.0), size_(A.cols()), Ad_(ChainableStack::instance_->memalloc_.alloc_array(size_)), Bd_(ChainableStack::instance_->memalloc_.alloc_array(size_)), variRefB_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { using Eigen::Map; Map Ad(Ad_, size_); Map Bd(Bd_, size_); Map(variRefB_, size_) = B.vi(); Ad = A; Bd = B.val(); variRefAB_ = new vari(Ad * Bd, false); } virtual void chain() { using Eigen::Map; Map(variRefB_, size_).adj() += Map(Ad_, size_) * variRefAB_->adj_; } }; /** * This is a subclass of the vari class for matrix * multiplication A * B where A is N by M and B * is an M by K matrix of doubles. * * The class stores the structure of each matrix, * the double values of A and B, and pointers to * the varis for A and B if A or B is a var. It * also instantiates and stores pointers to * varis for all elements of A * B. * * @tparam Ta Scalar type for matrix A * @tparam Ra Rows for matrix A * @tparam Ca Columns for matrix A, Rows for matrix B * @tparam Cb Columns for matrix B */ template class multiply_mat_vari : public vari { public: int A_rows_; int A_cols_; int B_cols_; int A_size_; int B_size_; double* Ad_; double* Bd_; vari** variRefA_; vari** variRefAB_; /** * Constructor for multiply_mat_vari. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param A row vector * @param B vector */ multiply_mat_vari(const Eigen::Matrix& A, const Eigen::Matrix& B) : vari(0.0), A_rows_(A.rows()), A_cols_(A.cols()), B_cols_(B.cols()), A_size_(A.size()), B_size_(B.size()), Ad_(ChainableStack::instance_->memalloc_.alloc_array(A_size_)), Bd_(ChainableStack::instance_->memalloc_.alloc_array(B_size_)), variRefA_( ChainableStack::instance_->memalloc_.alloc_array(A_size_)), variRefAB_(ChainableStack::instance_->memalloc_.alloc_array( A_rows_ * B_cols_)) { using Eigen::Map; Map(variRefA_, A_rows_, A_cols_) = A.vi(); Map Ad(Ad_, A_rows_, A_cols_); Map Bd(Bd_, A_cols_, B_cols_); Ad = A.val(); Bd = B.val(); #ifdef STAN_OPENCL if (Ad.rows() * Ad.cols() * Bd.cols() > opencl_context.tuning_opts().multiply_dim_prod_worth_transfer) { matrix_cl Ad_cl(Ad); matrix_cl Bd_cl(Bd); matrix_cl variRefAB_cl = Ad_cl * Bd_cl; matrix_d temp = from_matrix_cl(variRefAB_cl); Map(variRefAB_, A_rows_, B_cols_) = temp.unaryExpr([](double x) { return new vari(x, false); }); } else { Map(variRefAB_, A_rows_, B_cols_) = (Ad * Bd).unaryExpr([](double x) { return new vari(x, false); }); } #else Map(variRefAB_, A_rows_, B_cols_) = (Ad * Bd).unaryExpr([](double x) { return new vari(x, false); }); #endif } virtual void chain() { using Eigen::Map; matrix_d adjAB = Map(variRefAB_, A_rows_, B_cols_).adj(); #ifdef STAN_OPENCL if (A_rows_ * A_cols_ * B_cols_ > opencl_context.tuning_opts().multiply_dim_prod_worth_transfer) { matrix_cl adjAB_cl(adjAB); matrix_cl Bd_cl(Bd_, A_cols_, B_cols_); matrix_cl variRefA_cl = adjAB_cl * transpose(Bd_cl); matrix_d temp_variRefA = from_matrix_cl(variRefA_cl); Map(variRefA_, A_rows_, A_cols_).adj() += temp_variRefA; } else { Map(variRefA_, A_rows_, A_cols_).adj() += adjAB * Map(Bd_, A_cols_, B_cols_).transpose(); } #else Map(variRefA_, A_rows_, A_cols_).adj() += adjAB * Map(Bd_, A_cols_, B_cols_).transpose(); #endif } }; /** * This is a subclass of the vari class for matrix * multiplication A * B where A is a row * vector of length M and B is a vector of length M * of doubles. * * The class stores the structure of each matrix, * the double values of A and B, and pointers to * the varis for A and B if A or B is a var. It * also instantiates and stores pointers to * varis for all elements of A * B. * * @tparam Ta Scalar type for matrix A * @tparam Ra Rows for matrix A * @tparam Ca Columns for matrix A, Rows for matrix B * @tparam Tb Scalar type for matrix B * @tparam Cb Columns for matrix B */ template class multiply_mat_vari : public vari { public: int size_; double* Ad_; double* Bd_; vari** variRefA_; vari* variRefAB_; /** * Constructor for multiply_mat_vari. * * All memory allocated in * ChainableStack's stack_alloc arena. * * It is critical for the efficiency of this object * that the constructor create new varis that aren't * popped onto the var_stack_, but rather are * popped onto the var_nochain_stack_. This is * controlled to the second argument to * vari's constructor. * * @param A row vector * @param B vector */ multiply_mat_vari(const Eigen::Matrix& A, const Eigen::Matrix& B) : vari(0.0), size_(A.cols()), Ad_(ChainableStack::instance_->memalloc_.alloc_array(size_)), Bd_(ChainableStack::instance_->memalloc_.alloc_array(size_)), variRefA_( ChainableStack::instance_->memalloc_.alloc_array(size_)) { using Eigen::Map; Map(variRefA_, size_) = A.vi(); Map Ad(Ad_, size_); Map Bd(Bd_, size_); Ad = A.val(); Bd = B; variRefAB_ = new vari(Ad * Bd, false); } virtual void chain() { using Eigen::Map; Map(variRefA_, size_).adj() += variRefAB_->adj_ * Map(Bd_, size_); } }; /** * Return the product of two scalars. * @tparam T1 scalar type of v * @tparam T2 scalar type of c * @param[in] v First scalar * @param[in] c Specified scalar * @return Product of scalars */ template , typename = require_any_var_t> inline return_type_t multiply(const T1& v, const T2& c) { return v * c; } /** * Return the product of scalar and matrix. * @tparam T1 scalar type v * @tparam T2 scalar type matrix m * @tparam R2 Rows matrix m * @tparam C2 Columns matrix m * @param[in] c Specified scalar * @param[in] m Matrix * @return Product of scalar and matrix */ template > inline Eigen::Matrix multiply(const T1& c, const Eigen::Matrix& m) { // TODO(trangucci) pull out to eliminate overpromotion of one side // move to matrix.hpp w. promotion? return to_var(m) * to_var(c); } /** * Return the product of scalar and matrix. * @tparam T1 scalar type matrix m * @tparam T2 scalar type v * @tparam R1 Rows matrix m * @tparam C1 Columns matrix m * @param[in] c Specified scalar * @param[in] m Matrix * @return Product of scalar and matrix */ template > inline Eigen::Matrix multiply(const Eigen::Matrix& m, const T2& c) { // TODO(trangucci) pull out to eliminate overpromotion of one side // move to matrix.hpp w. promotion? return to_var(m) * to_var(c); } /** * Return the product of two matrices. * @tparam Ta scalar type matrix A * @tparam Ra Rows matrix A * @tparam Ca Columns matrix A * @tparam Tb scalar type matrix B * @tparam RB Rows matrix B * @tparam Cb Columns matrix B * @param[in] A Matrix * @param[in] B Matrix * @return Product of scalar and matrix. */ template > inline Eigen::Matrix multiply(const Eigen::Matrix& A, const Eigen::Matrix& B) { check_multiplicable("multiply", "A", A, "B", B); check_not_nan("multiply", "A", A); check_not_nan("multiply", "B", B); // Memory managed with the arena allocator. multiply_mat_vari* baseVari = new multiply_mat_vari(A, B); Eigen::Matrix AB_v(A.rows(), B.cols()); AB_v.vi() = Eigen::Map(&baseVari->variRefAB_[0], A.rows(), B.cols()); return AB_v; } /** * Return the scalar product of a row vector and * a vector. * @tparam Ta scalar type row vector A * @tparam Ca Columns matrix A * @tparam Tb scalar type vector B * @param[in] A Row vector * @param[in] B Column vector * @return Scalar product of row vector and vector */ template > inline var multiply(const Eigen::Matrix& A, const Eigen::Matrix& B) { check_multiplicable("multiply", "A", A, "B", B); check_not_nan("multiply", "A", A); check_not_nan("multiply", "B", B); // Memory managed with the arena allocator. multiply_mat_vari* baseVari = new multiply_mat_vari(A, B); var AB_v; AB_v.vi_ = baseVari->variRefAB_; return AB_v; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/vectorize/0000755000176200001440000000000013766554456022365 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/mat/vectorize/apply_scalar_unary.hpp0000644000176200001440000000165413766554456026774 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_VECTORIZE_APPLY_SCALAR_UNARY_HPP #define STAN_MATH_REV_MAT_VECTORIZE_APPLY_SCALAR_UNARY_HPP #include #include namespace stan { namespace math { /** * Template specialization to var for vectorizing a unary scalar * function. This is a base scalar specialization. It applies * the function specified by the template parameter to the * argument. * * @tparam F Type of function to apply. */ template struct apply_scalar_unary { /** * Function return type, which is var. */ using return_t = var; /** * Apply the function specified by F to the specified argument. * * @param x Argument variable. * @return Function applied to the variable. */ static inline return_t apply(const var& x) { return F::fun(x); } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/meta/0000755000176200001440000000000013766554456021301 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/mat/meta/operands_and_partials.hpp0000644000176200001440000001172713766554456026356 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_META_OPERANDS_AND_PARTIALS_HPP #define STAN_MATH_REV_MAT_META_OPERANDS_AND_PARTIALS_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { // Vectorized Univariate template <> class ops_partials_edge> { public: using Op = std::vector; using partials_t = Eigen::VectorXd; partials_t partials_; // For univariate use-cases broadcast_array partials_vec_; // For multivariate explicit ops_partials_edge(const Op& op) : partials_(partials_t::Zero(op.size())), partials_vec_(partials_), operands_(op) {} private: template friend class stan::math::operands_and_partials; const Op& operands_; void dump_partials(double* partials) { for (int i = 0; i < this->partials_.size(); ++i) { partials[i] = this->partials_[i]; } } void dump_operands(vari** varis) { for (size_t i = 0; i < this->operands_.size(); ++i) { varis[i] = this->operands_[i].vi_; } } int size() { return this->operands_.size(); } }; template class ops_partials_edge> { public: using Op = Eigen::Matrix; using partials_t = Eigen::Matrix; partials_t partials_; // For univariate use-cases broadcast_array partials_vec_; // For multivariate explicit ops_partials_edge(const Op& ops) : partials_(partials_t::Zero(ops.rows(), ops.cols())), partials_vec_(partials_), operands_(ops) {} private: template friend class stan::math::operands_and_partials; const Op& operands_; void dump_operands(vari** varis) { for (int i = 0; i < this->operands_.size(); ++i) { varis[i] = this->operands_(i).vi_; } } void dump_partials(double* partials) { for (int i = 0; i < this->partials_.size(); ++i) { partials[i] = this->partials_(i); } } int size() { return this->operands_.size(); } }; // SPECIALIZATIONS FOR MULTIVARIATE VECTORIZATIONS // (i.e. nested containers) template class ops_partials_edge>> { public: using Op = std::vector>; using partial_t = Eigen::Matrix; std::vector partials_vec_; explicit ops_partials_edge(const Op& ops) : partials_vec_(ops.size()), operands_(ops) { for (size_t i = 0; i < ops.size(); ++i) { partials_vec_[i] = partial_t::Zero(ops[i].rows(), ops[i].cols()); } } private: template friend class stan::math::operands_and_partials; const Op& operands_; void dump_partials(double* partials) { int p_i = 0; for (size_t i = 0; i < this->partials_vec_.size(); ++i) { for (int j = 0; j < this->partials_vec_[i].size(); ++j, ++p_i) { partials[p_i] = this->partials_vec_[i](j); } } } void dump_operands(vari** varis) { int p_i = 0; for (size_t i = 0; i < this->operands_.size(); ++i) { for (int j = 0; j < this->operands_[i].size(); ++j, ++p_i) { varis[p_i] = this->operands_[i](j).vi_; } } } int size() { if (unlikely(this->operands_.size() == 0)) { return 0; } return this->operands_.size() * this->operands_[0].size(); } }; template <> class ops_partials_edge>> { public: using Op = std::vector>; using partial_t = std::vector; std::vector partials_vec_; explicit ops_partials_edge(const Op& ops) : partials_vec_(length(ops)), operands_(ops) { for (size_t i = 0; i < length(ops); ++i) { partials_vec_[i] = partial_t(length(ops[i]), 0.0); } } private: template friend class stan::math::operands_and_partials; const Op& operands_; void dump_partials(double* partials) { int p_i = 0; for (size_t i = 0; i < this->partials_vec_.size(); ++i) { for (size_t j = 0; j < this->partials_vec_[i].size(); ++j, ++p_i) { partials[p_i] = this->partials_vec_[i][j]; } } } void dump_operands(vari** varis) { int p_i = 0; for (size_t i = 0; i < this->operands_.size(); ++i) { for (size_t j = 0; j < this->operands_[i].size(); ++j, ++p_i) { varis[p_i] = this->operands_[i][j].vi_; } } } int size() { if (unlikely(this->operands_.size() == 0)) { return 0; } return this->operands_.size() * this->operands_[0].size(); } }; } // namespace internal } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/0000755000176200001440000000000013766554456022033 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/mat/functor/kinsol_data.hpp0000644000176200001440000001052413766554456025036 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_KINSOL_DATA_HPP #define STAN_MATH_REV_MAT_FUNCTOR_KINSOL_DATA_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Default Jacobian builder using revser-mode autodiff. */ struct kinsol_J_f { template inline int operator()(const F& f, const Eigen::VectorXd& x, const Eigen::VectorXd& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs, const double x_sun[], SUNMatrix J) const { size_t N = x.size(); const std::vector x_vec(x_sun, x_sun + N); system_functor system(f, x, y, dat, dat_int, msgs); Eigen::VectorXd fx; Eigen::MatrixXd Jac; jacobian(system, to_vector(x_vec), fx, Jac); for (int i = 0; i < Jac.rows(); i++) for (int j = 0; j < Jac.cols(); j++) SM_ELEMENT_D(J, i, j) = Jac(i, j); return 0; } }; /** * KINSOL algebraic system data holder. * Based on cvodes_ode_data. * * @tparam F1 functor type for system function. * @tparam F2 functor type for jacobian function. Default is 0. * If 0, use rev mode autodiff to compute the Jacobian. */ template class kinsol_system_data { const F1& f_; const F2& J_f_; const Eigen::VectorXd& x_; const Eigen::VectorXd& y_; const size_t N_; const std::vector& dat_; const std::vector& dat_int_; std::ostream* msgs_; typedef kinsol_system_data system_data; public: N_Vector nv_x_; SUNMatrix J_; SUNLinearSolver LS_; void* kinsol_memory_; /* Constructor */ kinsol_system_data(const F1& f, const F2& J_f, const Eigen::VectorXd& x, const Eigen::VectorXd& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs) : f_(f), J_f_(J_f), x_(x), y_(y), dat_(dat), dat_int_(dat_int), msgs_(msgs), N_(x.size()), nv_x_(N_VMake_Serial(N_, &to_array_1d(x_)[0])), J_(SUNDenseMatrix(N_, N_)), LS_(SUNLinSol_Dense(nv_x_, J_)), kinsol_memory_(KINCreate()) {} ~kinsol_system_data() { N_VDestroy_Serial(nv_x_); SUNLinSolFree(LS_); SUNMatDestroy(J_); KINFree(&kinsol_memory_); } /* Implements the user-defined function passed to KINSOL. */ static int kinsol_f_system(N_Vector x, N_Vector f, void* user_data) { const system_data* explicit_system = static_cast(user_data); Eigen::VectorXd x_eigen( Eigen::Map(NV_DATA_S(x), explicit_system->N_)); Eigen::Map(N_VGetArrayPointer(f), explicit_system->N_) = explicit_system->f_(x_eigen, explicit_system->y_, explicit_system->dat_, explicit_system->dat_int_, explicit_system->msgs_); return 0; } /** * Implements the function of type CVDlsJacFn which is the user-defined * callbacks for KINSOL to calculate the jacobian of the system. * The Jacobian is stored in column major format. * * REMARK - tmp1 and tmp2 are pointers to memory allocated for variables * of type N_Vector which can be used by KINJacFN (the function which * computes the Jacobian) as temporary storage or work space. * See * https://computation.llnl.gov/sites/default/files/public/kin_guide-dev.pdf, * page 55. */ static int kinsol_jacobian(N_Vector x, N_Vector f, SUNMatrix J, void* user_data, N_Vector tmp1, N_Vector tmp2) { const system_data* explicit_system = static_cast(user_data); return explicit_system->J_f_(explicit_system->f_, explicit_system->x_, explicit_system->y_, explicit_system->dat_, explicit_system->dat_int_, explicit_system->msgs_, NV_DATA_S(x), J); } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/map_rect_reduce.hpp0000644000176200001440000001115113766554456025664 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_MAP_RECT_REDUCE_HPP #define STAN_MATH_REV_MAT_FUNCTOR_MAP_RECT_REDUCE_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template struct map_rect_reduce { matrix_d operator()(const vector_d& shared_params, const vector_d& job_specific_params, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs = nullptr) const { const size_type num_shared_params = shared_params.rows(); const size_type num_job_specific_params = job_specific_params.rows(); matrix_d out(1 + num_shared_params + num_job_specific_params, 0); try { start_nested(); vector_v shared_params_v = to_var(shared_params); vector_v job_specific_params_v = to_var(job_specific_params); vector_v fx_v = F()(shared_params_v, job_specific_params_v, x_r, x_i, msgs); const size_type size_f = fx_v.rows(); out.resize(Eigen::NoChange, size_f); for (size_type i = 0; i < size_f; ++i) { out(0, i) = fx_v(i).val(); set_zero_all_adjoints_nested(); fx_v(i).grad(); for (size_type j = 0; j < num_shared_params; ++j) { out(1 + j, i) = shared_params_v(j).vi_->adj_; } for (size_type j = 0; j < num_job_specific_params; ++j) { out(1 + num_shared_params + j, i) = job_specific_params_v(j).vi_->adj_; } } recover_memory_nested(); } catch (const std::exception& e) { recover_memory_nested(); throw; } return out; } }; template struct map_rect_reduce { matrix_d operator()(const vector_d& shared_params, const vector_d& job_specific_params, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs = nullptr) const { const size_type num_job_specific_params = job_specific_params.rows(); matrix_d out(1 + num_job_specific_params, 0); try { start_nested(); vector_v job_specific_params_v = to_var(job_specific_params); vector_v fx_v = F()(shared_params, job_specific_params_v, x_r, x_i, msgs); const size_type size_f = fx_v.rows(); out.resize(Eigen::NoChange, size_f); for (size_type i = 0; i < size_f; ++i) { out(0, i) = fx_v(i).val(); set_zero_all_adjoints_nested(); fx_v(i).grad(); for (size_type j = 0; j < num_job_specific_params; ++j) { out(1 + j, i) = job_specific_params_v(j).vi_->adj_; } } recover_memory_nested(); } catch (const std::exception& e) { recover_memory_nested(); throw; } return out; } }; template struct map_rect_reduce { matrix_d operator()(const vector_d& shared_params, const vector_d& job_specific_params, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs = nullptr) const { const size_type num_shared_params = shared_params.rows(); matrix_d out(1 + num_shared_params, 0); try { start_nested(); vector_v shared_params_v = to_var(shared_params); vector_v fx_v = F()(shared_params_v, job_specific_params, x_r, x_i, msgs); const size_type size_f = fx_v.rows(); out.resize(Eigen::NoChange, size_f); for (size_type i = 0; i < size_f; ++i) { out(0, i) = fx_v(i).val(); set_zero_all_adjoints_nested(); fx_v(i).grad(); for (size_type j = 0; j < num_shared_params; ++j) { out(1 + j, i) = shared_params_v(j).vi_->adj_; } } recover_memory_nested(); } catch (const std::exception& e) { recover_memory_nested(); throw; } return out; } }; } // namespace internal } // namespace math } // namespace stan #ifdef STAN_REGISTER_MPI_MAP_RECT_ALL #undef STAN_REGISTER_MPI_MAP_RECT_ALL #define STAN_REGISTER_MPI_MAP_RECT_ALL(CALLID, FUNCTOR) \ STAN_REGISTER_MPI_MAP_RECT(CALLID, FUNCTOR, double, double) \ STAN_REGISTER_MPI_MAP_RECT(CALLID, FUNCTOR, double, var) \ STAN_REGISTER_MPI_MAP_RECT(CALLID, FUNCTOR, var, double) \ STAN_REGISTER_MPI_MAP_RECT(CALLID, FUNCTOR, var, var) #endif #endif StanHeaders/inst/include/stan/math/rev/mat/functor/cvodes_ode_data.hpp0000644000176200001440000001633013766554456025652 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_CVODES_ODE_DATA_HPP #define STAN_MATH_REV_MAT_FUNCTOR_CVODES_ODE_DATA_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * CVODES ode data holder object which is used during CVODES * integration for CVODES callbacks. * * @tparam F type of functor for the base ode system. * @tparam T_initial type of initial values * @tparam T_param type of parameters */ template class cvodes_ode_data { const F& f_; const std::vector& y0_; const std::vector& theta_; const std::vector theta_dbl_; const size_t N_; const size_t M_; const std::vector& x_; const std::vector& x_int_; std::ostream* msgs_; const size_t S_; using ode_data = cvodes_ode_data; using initial_var = stan::is_var; using param_var = stan::is_var; public: const coupled_ode_system coupled_ode_; std::vector coupled_state_; N_Vector nv_state_; N_Vector* nv_state_sens_; SUNMatrix A_; SUNLinearSolver LS_; /** * Construct CVODES ode data object to enable callbacks from * CVODES during ODE integration. Static callbacks are defined * for the ODE RHS (cv_rhs), the ODE sensitivity * RHS (cv_rhs_sens) and for the ODE Jacobian wrt * to the states (cv_jacobian_states). * * The callbacks required by CVODES are detailled in * https://computation.llnl.gov/sites/default/files/public/cvs_guide.pdf * * Note: The supplied callbacks do always return 0 which flags to * CVODES that the function was successfully evaluated. Errors are * handled within Stan using exceptions such that any thrown error * leads to the termination of the ODE integration. * * @param[in] f ode functor. * @param[in] y0 initial state of the base ode. * @param[in] theta parameters of the base ode. * @param[in] x continuous data vector for the ODE. * @param[in] x_int integer data vector for the ODE. * @param[in] msgs stream to which messages are printed. */ cvodes_ode_data(const F& f, const std::vector& y0, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs) : f_(f), y0_(y0), theta_(theta), theta_dbl_(value_of(theta)), N_(y0.size()), M_(theta.size()), x_(x), x_int_(x_int), msgs_(msgs), S_((initial_var::value ? N_ : 0) + (param_var::value ? M_ : 0)), coupled_ode_(f, y0, theta, x, x_int, msgs), coupled_state_(coupled_ode_.initial_state()), nv_state_(N_VMake_Serial(N_, &coupled_state_[0])), nv_state_sens_(nullptr), A_(SUNDenseMatrix(N_, N_)), LS_(SUNDenseLinearSolver(nv_state_, A_)) { if (S_ > 0) { nv_state_sens_ = N_VCloneVectorArrayEmpty_Serial(S_, nv_state_); for (std::size_t i = 0; i < S_; i++) { NV_DATA_S(nv_state_sens_[i]) = &coupled_state_[N_] + i * N_; } } } ~cvodes_ode_data() { SUNLinSolFree(LS_); SUNMatDestroy(A_); N_VDestroy_Serial(nv_state_); if (S_ > 0) { N_VDestroyVectorArray_Serial(nv_state_sens_, S_); } } /** * Implements the function of type CVRhsFn which is the user-defined * ODE RHS passed to CVODES. */ static int cv_rhs(realtype t, N_Vector y, N_Vector ydot, void* user_data) { const ode_data* explicit_ode = static_cast(user_data); explicit_ode->rhs(t, NV_DATA_S(y), NV_DATA_S(ydot)); return 0; } /** * Implements the function of type CVSensRhsFn which is the * RHS of the sensitivity ODE system. */ static int cv_rhs_sens(int Ns, realtype t, N_Vector y, N_Vector ydot, N_Vector* yS, N_Vector* ySdot, void* user_data, N_Vector tmp1, N_Vector tmp2) { const ode_data* explicit_ode = static_cast(user_data); explicit_ode->rhs_sens(t, NV_DATA_S(y), yS, ySdot); return 0; } /** * Implements the function of type CVDlsJacFn which is the * user-defined callback for CVODES to calculate the jacobian of the * ode_rhs wrt to the states y. The jacobian is stored in column * major format. */ static int cv_jacobian_states(realtype t, N_Vector y, N_Vector fy, SUNMatrix J, void* user_data, N_Vector tmp1, N_Vector tmp2, N_Vector tmp3) { const ode_data* explicit_ode = static_cast(user_data); return explicit_ode->jacobian_states(t, NV_DATA_S(y), J); } private: /** * Calculates the ODE RHS, dy_dt, using the user-supplied functor at * the given time t and state y. */ inline void rhs(double t, const double y[], double dy_dt[]) const { const std::vector y_vec(y, y + N_); const std::vector& dy_dt_vec = f_(t, y_vec, theta_dbl_, x_, x_int_, msgs_); check_size_match("cvodes_ode_data", "dz_dt", dy_dt_vec.size(), "states", N_); std::move(dy_dt_vec.begin(), dy_dt_vec.end(), dy_dt); } /** * Calculates the jacobian of the ODE RHS wrt to its states y at the * given time-point t and state y. * Note that the jacobian of the ODE system is the coupled ode system for * varying states evaluated at the state y whenever we choose state * y to be the initial of the coupled ode system. */ inline int jacobian_states(double t, const double y[], SUNMatrix J) const { start_nested(); const std::vector y_vec_var(y, y + N_); coupled_ode_system ode_jacobian(f_, y_vec_var, theta_dbl_, x_, x_int_, msgs_); std::vector&& jacobian_y = std::vector(ode_jacobian.size()); ode_jacobian(ode_jacobian.initial_state(), jacobian_y, t); std::move(jacobian_y.begin() + N_, jacobian_y.end(), SM_DATA_D(J)); recover_memory_nested(); return 0; } /** * Calculates the RHS of the sensitivity ODE system which * corresponds to the coupled ode system from which the first N * states are omitted, since the first N states are the ODE RHS * which CVODES separates from the main ODE RHS. */ inline void rhs_sens(double t, const double y[], N_Vector* yS, N_Vector* ySdot) const { std::vector z(coupled_state_.size()); std::vector&& dz_dt = std::vector(coupled_state_.size()); std::copy(y, y + N_, z.begin()); for (std::size_t s = 0; s < S_; s++) { std::copy(NV_DATA_S(yS[s]), NV_DATA_S(yS[s]) + N_, z.begin() + (s + 1) * N_); } coupled_ode_(z, dz_dt, t); for (std::size_t s = 0; s < S_; s++) { std::move(dz_dt.begin() + (s + 1) * N_, dz_dt.begin() + (s + 2) * N_, NV_DATA_S(ySdot[s])); } } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/adj_jac_apply.hpp0000644000176200001440000005145113766554456025332 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_ADJ_JAC_APPLY_HPP #define STAN_MATH_REV_MAT_FUNCTOR_ADJ_JAC_APPLY_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { /** * Invoke the functor f with arguments given in t and indexed in the index * sequence I * * @tparam F Type of functor * @tparam Tuple Type of tuple containing arguments * @tparam I Index sequence going from 0 to std::tuple_size::value - 1 * inclusive * @param f functor callable * @param t tuple of arguments * @param i placeholder variable for index sequence */ template constexpr auto apply_impl(const F& f, const Tuple& t, std::index_sequence i) { return f(std::get(t)...); } /** * Call the functor f with the tuple of arguments t, like: * * f(std::get<0>(t), std::get<1>(t), ...) * * TODO: replace this with implementation in C++ std when C++17 is available * * @tparam F Type of functor * @tparam Tuple Type of tuple containing arguments * @param f functor callable * @param t tuple of arguments */ template constexpr auto apply(const F& f, const Tuple& t) { return apply_impl(f, t, std::make_index_sequence{}>{}); } /** * Store the adjoint in y_vi[0] in y_adj * * @tparam size dimensionality of M * @param[in] y_vi pointer to pointer to vari * @param[in] M * @param[out] y_adj reference to variable where adjoint is to be stored */ template void build_y_adj(vari** y_vi, const std::array& M, double& y_adj) { y_adj = y_vi[0]->adj_; } /** * Store the adjoints from y_vi in y_adj * * @tparam size dimensionality of M * @param[in] y_vi pointer to pointers to varis * @param[in] M shape of y_adj * @param[out] y_adj reference to std::vector where adjoints are to be stored */ template void build_y_adj(vari** y_vi, const std::array& M, std::vector& y_adj) { y_adj.resize(M[0]); for (size_t m = 0; m < y_adj.size(); ++m) { y_adj[m] = y_vi[m]->adj_; } } /** * Store the adjoints from y_vi in y_adj * * @tparam size dimensionality of M * @param[in] y_vi pointer to pointers to varis * @param[in] M shape of y_adj * @param[out] y_adj reference to Eigen::Matrix where adjoints are to be stored */ template void build_y_adj(vari** y_vi, const std::array& M, Eigen::Matrix& y_adj) { y_adj.resize(M[0], M[1]); for (int m = 0; m < y_adj.size(); ++m) { y_adj(m) = y_vi[m]->adj_; } } /** * Compute the dimensionality of the given template argument. The * definition of dimensionality is deferred to specializations. By * default don't have a value (fail to compile) */ template struct compute_dims {}; /** * Compute the dimensionality of the given template argument. Double * types hav dimensionality zero. */ template <> struct compute_dims { static constexpr size_t value = 0; }; /** * Compute the dimensionality of the given template argument. * std::vector has dimension 1 */ template struct compute_dims> { static constexpr size_t value = 1; }; /** * compute the dimensionality of the given template argument. * Eigen::Matrix types all have dimension two */ template struct compute_dims> { static constexpr size_t value = 2; }; } // namespace internal /** * adj_jac_vari interfaces a user supplied functor with the reverse mode * autodiff. It allows someone to implement functions with custom reverse mode * autodiff without having to deal with autodiff types. * * The requirements on the functor F are described in the documentation for * adj_jac_apply * * Targs (the input argument types) can be any mix of double, var, or * Eigen::Matrices with double or var scalar components * * @tparam F class of functor * @tparam Targs Types of arguments */ template struct adj_jac_vari : public vari { std::array is_var_; using FReturnType = std::result_of_t; F f_; std::array offsets_; vari** x_vis_; std::array::value> M_; vari** y_vi_; /** * count_memory returns count (the first argument) + the number of varis used * in the second argument + the number of arguments used to encode the * variadic tail args. * * The adj_jac_vari constructor uses this to figure out how much space to * allocate in x_vis_. * * The array offsets_ is populated with values to indicate where in x_vis_ the * vari pointers for each argument will be stored. * * Each of the arguments can be an Eigen::Matrix with var or double scalar * types, a std::vector with var, double, or int scalar types, or a var, a * double, or an int. * * @tparam R Eigen Matrix row type * @tparam C Eigen Matrix column type * @tparam Pargs Types of rest of arguments * @param count rolling count of number of varis that must be allocated * @param x next argument to have its varis counted * @param args the rest of the arguments (that will be iterated through * recursively) */ template size_t count_memory(size_t count, const Eigen::Matrix& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; count += x.size(); return count_memory(count, args...); } template size_t count_memory(size_t count, const Eigen::Matrix& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; return count_memory(count, args...); } template size_t count_memory(size_t count, const std::vector& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; count += x.size(); return count_memory(count, args...); } template size_t count_memory(size_t count, const std::vector& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; return count_memory(count, args...); } template size_t count_memory(size_t count, const std::vector& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; return count_memory(count, args...); } template size_t count_memory(size_t count, const var& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; count += 1; return count_memory(count, args...); } template size_t count_memory(size_t count, const double& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; return count_memory(count, args...); } template size_t count_memory(size_t count, const int& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; offsets_[t] = count; return count_memory(count, args...); } size_t count_memory(size_t count) { return count; } /** * prepare_x_vis populates x_vis_ with the varis from each of its * input arguments. The vari pointers for argument n are copied into x_vis_ at * the index starting at offsets_[n]. For Eigen::Matrix types, this copying is * done in with column major ordering. * * Each of the arguments can be an Eigen::Matrix with var or double scalar * types, a std::vector with var, double, or int scalar types, or a var, a * double, or an int. * * @tparam R Eigen Matrix row type * @tparam C Eigen Matrix column type * @tparam Pargs Types of the rest of the arguments to be processed * @param x next argument to have its vari pointers copied if necessary * @param args the rest of the arguments (that will be iterated through * recursively) */ template void prepare_x_vis(const Eigen::Matrix& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; for (int i = 0; i < x.size(); ++i) { x_vis_[offsets_[t] + i] = x(i).vi_; } prepare_x_vis(args...); } template void prepare_x_vis(const Eigen::Matrix& x, const Pargs&... args) { prepare_x_vis(args...); } template void prepare_x_vis(const std::vector& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; for (size_t i = 0; i < x.size(); ++i) { x_vis_[offsets_[t] + i] = x[i].vi_; } prepare_x_vis(args...); } template void prepare_x_vis(const std::vector& x, const Pargs&... args) { prepare_x_vis(args...); } template void prepare_x_vis(const std::vector& x, const Pargs&... args) { prepare_x_vis(args...); } template void prepare_x_vis(const var& x, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; x_vis_[offsets_[t]] = x.vi_; prepare_x_vis(args...); } template void prepare_x_vis(const double& x, const Pargs&... args) { prepare_x_vis(args...); } template void prepare_x_vis(const int& x, const Pargs&... args) { prepare_x_vis(args...); } /** * Initializes is_var_ with true if the scalar type in each argument * is a var (and false if not) */ adj_jac_vari() : vari(std::numeric_limits::quiet_NaN()), // The val_ in this // vari is unused is_var_({{is_var::type>::value...}}), x_vis_(nullptr), y_vi_(nullptr) {} /** * Return a var with a new vari holding the given value * * @param val_y output of F::operator() * @return var */ var build_return_varis_and_vars(const double& val_y) { y_vi_ = ChainableStack::instance_->memalloc_.alloc_array(1); y_vi_[0] = new vari(val_y, false); return y_vi_[0]; } /** * Return a std::vector of vars created from newly allocated varis initialized * with the values of val_y * * @param val_y output of F::operator() * @return std::vector of vars */ std::vector build_return_varis_and_vars( const std::vector& val_y) { M_[0] = val_y.size(); std::vector var_y(M_[0]); y_vi_ = ChainableStack::instance_->memalloc_.alloc_array(var_y.size()); for (size_t m = 0; m < var_y.size(); ++m) { y_vi_[m] = new vari(val_y[m], false); var_y[m] = y_vi_[m]; } return var_y; } /** * Return an Eigen::Matrix of vars created from newly allocated varis * initialized with the values of val_y. The shape of the new matrix comes * from M_ * * @tparam R Eigen row type * @tparam C Eigen column type * @param val_y output of F::operator() * @return Eigen::Matrix of vars */ template Eigen::Matrix build_return_varis_and_vars( const Eigen::Matrix& val_y) { M_[0] = val_y.rows(); M_[1] = val_y.cols(); Eigen::Matrix var_y(M_[0], M_[1]); y_vi_ = ChainableStack::instance_->memalloc_.alloc_array(var_y.size()); for (int m = 0; m < var_y.size(); ++m) { y_vi_[m] = new vari(val_y(m), false); var_y(m) = y_vi_[m]; } return var_y; } void prepare_x_vis() {} /** * The adj_jac_vari functor * 1. Initializes an instance of the user defined functor F * 2. Calls operator() on the F instance with the double values from the * input args * 3. Saves copies of the varis pointed to by the input vars for subsequent * calls to chain * 4. Calls build_return_varis_and_vars to construct the appropriate output * data structure of vars * * Each of the arguments can be an Eigen::Matrix with var or double scalar * types, a std::vector with var, double, or int scalar types, or a var, a * double, or an int. * * @param args Input arguments * @return Output of f_ as vars */ auto operator()(const Targs&... args) { x_vis_ = ChainableStack::instance_->memalloc_.alloc_array( count_memory(0, args...)); prepare_x_vis(args...); return build_return_varis_and_vars(f_(is_var_, value_of(args)...)); } /** * Accumulate, if necessary, the values of y_adj_jac into the * adjoints of the varis pointed to by the appropriate elements * of x_vis_. Recursively calls accumulate_adjoints on the rest of the * arguments. * * @tparam R Eigen Matrix row type * @tparam C Eigen Matrix column type * @tparam Pargs Types of the rest of adjoints to accumulate * @param y_adj_jac set of values to be accumulated in adjoints * @param args the rest of the arguments (that will be iterated through * recursively) */ template void accumulate_adjoints(const Eigen::Matrix& y_adj_jac, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; if (is_var_[t]) { for (int n = 0; n < y_adj_jac.size(); ++n) { x_vis_[offsets_[t] + n]->adj_ += y_adj_jac(n); } } accumulate_adjoints(args...); } /** * Accumulate, if necessary, the values of y_adj_jac into the * adjoints of the varis pointed to by the appropriate elements * of x_vis_. Recursively calls accumulate_adjoints on the rest of the * arguments. * * @tparam Pargs Types of the rest of adjoints to accumulate * @param y_adj_jac set of values to be accumulated in adjoints * @param args the rest of the arguments (that will be iterated through * recursively) */ template void accumulate_adjoints(const std::vector& y_adj_jac, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; if (is_var_[t]) { for (size_t n = 0; n < y_adj_jac.size(); ++n) { x_vis_[offsets_[t] + n]->adj_ += y_adj_jac[n]; } } accumulate_adjoints(args...); } /** * Recursively call accumulate_adjoints with args. There are no adjoints to * accumulate for std::vector arguments. * * @tparam Pargs Types of the rest of adjoints to accumulate * @param y_adj_jac ignored * @param args the rest of the arguments (that will be iterated through * recursively) */ template void accumulate_adjoints(const std::vector& y_adj_jac, const Pargs&... args) { accumulate_adjoints(args...); } /** * Accumulate, if necessary, the value of y_adj_jac into the * adjoint of the vari pointed to by the appropriate element * of x_vis_. Recursively calls accumulate_adjoints on the rest of the * arguments. * * @tparam Pargs Types of the rest of adjoints to accumulate * @param y_adj_jac next set of adjoints to be accumulated * @param args the rest of the arguments (that will be iterated through * recursively) */ template void accumulate_adjoints(const double& y_adj_jac, const Pargs&... args) { static constexpr int t = sizeof...(Targs) - sizeof...(Pargs) - 1; if (is_var_[t]) { x_vis_[offsets_[t]]->adj_ += y_adj_jac; } accumulate_adjoints(args...); } /** * Recursively call accumulate_adjoints with args. There are no adjoints to * accumulate for int arguments. * * @tparam Pargs Types of the rest of adjoints to accumulate * @param y_adj_jac ignored * @param args the rest of the arguments (that will be iterated through * recursively) */ template void accumulate_adjoints(const int& y_adj_jac, const Pargs&... args) { accumulate_adjoints(args...); } void accumulate_adjoints() {} /** * Propagate the adjoints at the output varis (y_vi_) back to the input * varis (x_vis_) by: * 1. packing the adjoints in an appropriate container using build_y_adj * 2. using the multiply_adjoint_jacobian function of the user defined functor * to compute what the adjoints on x_vis_ should be * 3. accumulating the adjoints into the varis pointed to by elements of * x_vis_ using accumulate_adjoints * * This operation may be called multiple times during the life of the vari */ void chain() { FReturnType y_adj; internal::build_y_adj(y_vi_, M_, y_adj); auto y_adj_jacs = f_.multiply_adjoint_jacobian(is_var_, y_adj); internal::apply( [this](auto&&... args) { this->accumulate_adjoints(args...); }, y_adj_jacs); } }; /** * Return the result of applying the function defined by a nullary construction * of F to the specified input argument * * adj_jac_apply makes it possible to write efficient reverse-mode * autodiff code without ever touching Stan's autodiff internals * * Mathematically, to use a function in reverse mode autodiff, you need to be * able to evaluate the function (y = f(x)) and multiply the Jacobian of that * function (df(x)/dx) by a vector. * * As an example, pretend there exists some large, complicated function, L(x1, * x2), which contains our smaller function f(x1, x2). The goal of autodiff is * to compute the partials dL/dx1 and dL/dx2. If we break the large function * into pieces: * * y = f(x1, x2) * L = g(y) * * If we were given dL/dy we could compute dL/dx1 by the product dL/dy * dy/dx1 * or dL/dx2 by the product dL/dy * dy/dx2 * * Because y = f(x1, x2), dy/dx1 is just df(x1, x2)/dx1, the Jacobian of the * function we're trying to define with x2 held fixed. A similar thing happens * for dy/dx2. In vector form, * * dL/dx1 = (dL/dy)' * df(x1, x2)/dx1 and * dL/dx2 = (dL/dy)' * df(x1, x2)/dx2 * * So implementing f(x1, x2) and the products above are all that is required * mathematically to implement reverse-mode autodiff for a function. * * adj_jac_apply takes as a template argument a functor F that supplies the * non-static member functions (leaving exact template arguments off): * * (required) Eigen::VectorXd operator()(const std::array& * needs_adj, const T1& x1..., const T2& x2, ...) * * where there can be any number of input arguments x1, x2, ... and T1, T2, ... * can be either doubles or any Eigen::Matrix type with double scalar values. * needs_adj is an array of size equal to the number of input arguments * indicating whether or not the adjoint^T Jacobian product must be computed for * each input argument. This argument is passed to operator() so that any * unnecessary preparatory calculations for multiply_adjoint_jacobian can be * avoided if possible. * * (required) std::tuple multiply_adjoint_jacobian(const * std::array& needs_adj, const Eigen::VectorXd& adj) * * where T1, T2, etc. are the same types as in operator(), needs_adj is the same * as in operator(), and adj is the vector dL/dy. * * operator() is responsible for computing f(x) and multiply_adjoint_jacobian is * responsible for computing the necessary adjoint transpose Jacobian products * (which frequently does not require the calculation of the full Jacobian). * * operator() will be called before multiply_adjoint_jacobian is called, and is * only called once in the lifetime of the functor multiply_adjoint_jacobian is * called after operator() and may be called multiple times for any single * functor * * The functor supplied to adj_jac_apply must be careful to allocate any * variables it defines in the autodiff arena because its destructor will * never be called and memory will leak if allocated anywhere else. * * Targs (the input argument types) can be any mix of doubles, vars, ints, * std::vectors with double, var, or int scalar components, or * Eigen::Matrix s of any shape with var or double scalar components * * @tparam F functor to be connected to the autodiff stack * @tparam Targs types of arguments to pass to functor * @param args input to the functor * @return the result of the specified operation wrapped up in vars */ template auto adj_jac_apply(const Targs&... args) { auto vi = new adj_jac_vari(); return (*vi)(args...); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/idas_system.hpp0000644000176200001440000002426113766554456025075 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_IDAS_RESIDUAL_HPP #define STAN_MATH_REV_MAT_FUNCTOR_IDAS_RESIDUAL_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #define CHECK_IDAS_CALL(call) idas_check(call, #call) /** * check IDAS return flag & throw runtime error * * @param[in] flag routine return flag * @param[in] func routine name */ inline void idas_check(int flag, const char* func) { if (flag < 0) { std::ostringstream ss; ss << func << " failed with error flag " << flag; throw std::runtime_error(ss.str()); } } /** * copy NV_Vector* array to Eigen::MatrixXd * * @param[in] nv N_Vector* array. * @param[in] nv_size length of nv. * @return Eigen::MatrixXd. */ inline Eigen::MatrixXd matrix_d_from_NVarray(const N_Vector* nv, const size_t& nv_size) { size_t m = nv_size; size_t n = NV_LENGTH_S(nv[0]); stan::math::matrix_d res(n, m); for (size_t j = 0; j < m; ++j) { auto nvp = N_VGetArrayPointer(nv[j]); for (size_t i = 0; i < n; ++i) { res(i, j) = nvp[i]; } } return res; } /** * copy Eigen::MatrixXd to NV_Vector* array. * * @param[in] mat Eigen::MatrixXd to be converted * @param[out] nv N_Vector* array * @param[in] nv_size length of nv */ inline void matrix_d_to_NVarray(const Eigen::MatrixXd& mat, N_Vector* nv, const size_t& nv_size) { size_t m = nv_size; size_t n = NV_LENGTH_S(nv[0]); for (size_t j = 0; j < m; ++j) { auto nvp = N_VGetArrayPointer(nv[j]); for (size_t i = 0; i < n; ++i) { nvp[i] = mat(i, j); } } } namespace stan { namespace math { /** * IDAS DAE system that contains informtion on residual * equation functor, sensitivity residual equation functor, * as well as initial conditions. This is a base type that * is intended to contain common values used by forward * sensitivity system. * * @tparam F type of functor for DAE residual * @tparam Tyy scalar type of initial unknown values * @tparam Typ scalar type of initial unknown's derivative values * @tparam Tpar scalar type of parameters */ template class idas_system { protected: const F& f_; const std::vector& yy_; const std::vector& yp_; std::vector yy_val_; // workspace std::vector yp_val_; // workspace const std::vector& theta_; const std::vector& x_r_; const std::vector& x_i_; const size_t N_; const size_t M_; const size_t ns_; // nb. of sensi params N_Vector nv_yy_; N_Vector nv_yp_; std::vector rr_val_; // workspace N_Vector nv_rr_; N_Vector id_; void* mem_; std::ostream* msgs_; public: static constexpr bool is_var_yy0 = stan::is_var::value; static constexpr bool is_var_yp0 = stan::is_var::value; static constexpr bool is_var_par = stan::is_var::value; static constexpr bool need_sens = is_var_yy0 || is_var_yp0 || is_var_par; using scalar_type = typename stan::return_type::type; using return_type = std::vector >; /** * Construct IDAS DAE system from initial condition and parameters * * @param[in] f DAE residual functor * @param[in] eq_id array for DAE's variable ID(1 for * * derivative variables, 0 for algebraic variables). * @param[in] yy0 initial condiiton * @param[in] yp0 initial condiiton for derivatives * @param[in] theta parameters of the base DAE. * @param[in] x_r continuous data vector for the DAE. * @param[in] x_i integer data vector for the DAE. * @param[in] msgs stream to which messages are printed. */ idas_system(const F& f, const std::vector& eq_id, const std::vector& yy0, const std::vector& yp0, const std::vector& theta, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs) : f_(f), yy_(yy0), yp_(yp0), yy_val_(value_of(yy0)), yp_val_(value_of(yp0)), theta_(theta), x_r_(x_r), x_i_(x_i), N_(yy0.size()), M_(theta.size()), ns_((is_var_yy0 ? N_ : 0) + (is_var_yp0 ? N_ : 0) + (is_var_par ? M_ : 0)), nv_yy_(N_VMake_Serial(N_, yy_val_.data())), nv_yp_(N_VMake_Serial(N_, yp_val_.data())), rr_val_(N_, 0.0), nv_rr_(N_VMake_Serial(N_, rr_val_.data())), id_(N_VNew_Serial(N_)), mem_(IDACreate()), msgs_(msgs) { if (nv_yy_ == NULL || nv_yp_ == NULL) { throw std::runtime_error("N_VMake_Serial failed to allocate memory"); } if (mem_ == NULL) { throw std::runtime_error("IDACreate failed to allocate memory"); } static const char* caller = "idas_system"; check_finite(caller, "initial state", yy0); check_finite(caller, "derivative initial state", yp0); check_finite(caller, "parameter vector", theta); check_finite(caller, "continuous data", x_r); check_nonzero_size(caller, "initial state", yy0); check_nonzero_size(caller, "derivative initial state", yp0); check_consistent_sizes(caller, "initial state", yy0, "derivative initial state", yp0); check_consistent_sizes(caller, "initial state", yy0, "derivative-algebra id", eq_id); check_greater_or_equal(caller, "derivative-algebra id", eq_id, 0); check_less_or_equal(caller, "derivative-algebra id", eq_id, 1); for (size_t i = 0; i < N_; ++i) { NV_Ith_S(id_, i) = eq_id[i]; } } /** * destructor to deallocate IDAS solution memory and workspace. */ ~idas_system() { N_VDestroy_Serial(nv_yy_); N_VDestroy_Serial(nv_yp_); N_VDestroy_Serial(nv_rr_); N_VDestroy_Serial(id_); IDAFree(&mem_); } /** * return reference to current N_Vector of unknown variable * * @return reference to current N_Vector of unknown variable */ N_Vector& nv_yy() { return nv_yy_; } /** * return reference to current N_Vector of derivative variable * * @return reference to current N_Vector of derivative variable */ N_Vector& nv_yp() { return nv_yp_; } /** * return reference to current N_Vector of residual workspace * * @return reference to current N_Vector of residual workspace */ N_Vector& nv_rr() { return nv_rr_; } /** * return reference to DAE variable IDs * * @return reference to DAE variable IDs. */ N_Vector& id() { return id_; } /** * return reference to current solution vector value * * @return reference to current solution vector value */ const std::vector& yy_val() { return yy_val_; } /** * return reference to current solution derivative vector value * * @return reference to current solution derivative vector value */ const std::vector& yp_val() { return yp_val_; } /** * return reference to initial condition * * @return reference to initial condition */ const std::vector& yy0() const { return yy_; } /** * return reference to derivative initial condition * * @return reference to derivative initial condition */ const std::vector& yp0() const { return yp_; } /** * return reference to parameter * * @return reference to parameter */ const std::vector& theta() const { return theta_; } /** * return a vector of vars for that contains the initial * condition and parameters in case they are vars. The * sensitivity with respect to this vector will be * calculated by IDAS. * * @return vector of vars */ std::vector vars() const { std::vector res; if (is_var_yy0) { res.insert(res.end(), yy0().begin(), yy0().end()); } if (is_var_yp0) { res.insert(res.end(), yp0().begin(), yp0().end()); } if (is_var_par) { res.insert(res.end(), theta().begin(), theta().end()); } return res; } /** * return number of unknown variables */ const size_t n() { return N_; } /** * return number of sensitivity parameters */ const size_t ns() { return ns_; } /** * return size of DAE system for primary and sensitivity unknowns */ const size_t n_sys() { return N_ * (ns_ + 1); } /** * return theta size */ const size_t n_par() { return theta_.size(); } /** * return IDAS memory handle */ void* mem() { return mem_; } /** * return reference to DAE functor */ const F& f() { return f_; } /** * return a closure for IDAS residual callback */ IDAResFn residual() { // a non-capture lambda return [](double t, N_Vector yy, N_Vector yp, N_Vector rr, void* user_data) -> int { using DAE = idas_system; DAE* dae = static_cast(user_data); size_t N = NV_LENGTH_S(yy); auto yy_val = N_VGetArrayPointer(yy); std::vector yy_vec(yy_val, yy_val + N); auto yp_val = N_VGetArrayPointer(yp); std::vector yp_vec(yp_val, yp_val + N); auto res = dae->f_(t, yy_vec, yp_vec, dae->theta_, dae->x_r_, dae->x_i_, dae->msgs_); for (size_t i = 0; i < N; ++i) { NV_Ith_S(rr, i) = value_of(res[i]); } return 0; }; } void check_ic_consistency(const double& t0, const double& tol) { const std::vector theta_d(value_of(theta_)); const std::vector yy_d(value_of(yy_)); const std::vector yp_d(value_of(yp_)); static const char* caller = "idas_integrator"; std::vector res(f_(t0, yy_d, yp_d, theta_d, x_r_, x_i_, msgs_)); double res0 = std::sqrt(dot_self(res)); check_less_or_equal(caller, "DAE residual at t0", res0, tol); } }; // TODO(yizhang): adjoint system construction } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/algebra_system.hpp0000644000176200001440000001427413766554456025555 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_ALGEBRA_SYSTEM_HPP #define STAN_MATH_REV_MAT_FUNCTOR_ALGEBRA_SYSTEM_HPP #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * A functor that allows us to treat either x or y as * the independent variable. If x_is_iv = true, than the * Jacobian is computed w.r.t x, else it is computed * w.r.t y. * @tparam F type for algebraic system functor * @tparam T0 type for unknowns * @tparam T1 type for auxiliary parameters * @tparam x_is_iv true if x is the independent variable */ template struct system_functor { /** algebraic system functor */ F f_; /** unknowns */ Eigen::Matrix x_; /** auxiliary parameters */ Eigen::Matrix y_; /** real data */ std::vector dat_; /** integer data */ std::vector dat_int_; /** stream message */ std::ostream* msgs_; system_functor() {} system_functor(const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs) : f_(f), x_(x), y_(y), dat_(dat), dat_int_(dat_int), msgs_(msgs) {} /** * An operator that takes in an independent variable. The * independent variable is either passed as the unknown x, * or the auxiliary parameter y. The x_is_iv template parameter * allows us to determine whether the jacobian is computed * with respect to x or y. * @tparam T the scalar type of the independent variable */ template inline Eigen::Matrix operator()( const Eigen::Matrix& iv) const { if (x_is_iv) { return f_(iv, y_, dat_, dat_int_, msgs_); } else { return f_(x_, iv, dat_, dat_int_, msgs_); } } }; /** * A structure which gets passed to Eigen's dogleg * algebraic solver. * @tparam T scalar type of independent variable. * @tparam NX number of rows * @tparam NY number of columns */ template struct nlo_functor { const int m_inputs, m_values; nlo_functor() : m_inputs(NX), m_values(NY) {} nlo_functor(int inputs, int values) : m_inputs(inputs), m_values(values) {} int inputs() const { return m_inputs; } int values() const { return m_values; } }; /** * A functor with the required operators to call Eigen's * algebraic solver. * It is also used in the vari classes of the algebraic solvers * to compute the requisite sensitivities. * @tparam S wrapper around the algebraic system functor. Has the * signature required for jacobian (i.e takes only one argument). * @tparam F algebraic system functor * @tparam T0 scalar type for unknowns * @tparam T1 scalar type for auxiliary parameters */ template struct hybrj_functor_solver : nlo_functor { /** Wrapper around algebraic system */ S fs_; /** number of unknowns */ int x_size_; /** Jacobian of algebraic function wrt unknowns */ Eigen::MatrixXd J_; hybrj_functor_solver(const S& fs, const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs) : fs_(f, x, y, dat, dat_int, msgs), x_size_(x.size()) {} /** * Computes the value the algebraic function, f, when pluging in the * independent variables, and the Jacobian w.r.t unknowns. Required * by Eigen. * @param [in] iv independent variables * @param [in, out] fvec value of algebraic function when plugging in iv. */ int operator()(const Eigen::VectorXd& iv, Eigen::VectorXd& fvec) { jacobian(fs_, iv, fvec, J_); return 0; } /** * Assign the Jacobian to fjac (signature required by Eigen). Required * by Eigen. * @param [in] iv independent variables. * @param [in, out] fjac matrix container for jacobian */ int df(const Eigen::VectorXd& iv, Eigen::MatrixXd& fjac) const { fjac = J_; return 0; } /** * Performs the same task as the operator(), but returns the * Jacobian, instead of saving it inside an argument * passed by reference. * @param [in] iv indepdent variable. */ Eigen::MatrixXd get_jacobian(const Eigen::VectorXd& iv) { Eigen::VectorXd fvec; jacobian(fs_, iv, fvec, J_); return J_; } /** * Performs the same task as df(), but returns the value of * algebraic function, instead of saving it inside an * argument passed by reference. * @tparam [in] iv independent variable. */ Eigen::VectorXd get_value(const Eigen::VectorXd& iv) const { return fs_(iv); } }; template void algebra_solver_check(const Eigen::Matrix& x, const Eigen::Matrix y, const std::vector& dat, const std::vector& dat_int, double function_tolerance, long int max_num_steps) { // NOLINT(runtime/int) check_nonzero_size("algebra_solver", "initial guess", x); check_finite("algebra_solver", "initial guess", x); check_finite("algebra_solver", "parameter vector", y); check_finite("algebra_solver", "continuous data", dat); check_finite("algebra_solver", "integer data", dat_int); check_nonnegative("algebra_solver", "function_tolerance", function_tolerance); check_positive("algebra_solver", "max_num_steps", max_num_steps); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/integrate_dae.hpp0000644000176200001440000000433713766554456025346 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_INTEGRATOR_DAE_HPP #define STAN_MATH_REV_MAT_FUNCTOR_INTEGRATOR_DAE_HPP #include #include #include #include #include namespace stan { namespace math { /** * Return the solutions for a semi-explicit DAE system with residual * specified by functor F, * given the specified consistent initial state yy0 and yp0. * * @tparam DAE type of DAE system * @tparam Tpar scalar type of parameter theta * @param[in] f functor for the base ordinary differential equation * @param[in] yy0 initial state * @param[in] yp0 initial derivative state * @param[in] t0 initial time * @param[in] ts times of the desired solutions, in strictly * increasing order, all greater than the initial time * @param[in] theta parameters * @param[in] x_r real data * @param[in] x_i int data * @param[in] rtol relative tolerance passed to IDAS, requred <10^-3 * @param[in] atol absolute tolerance passed to IDAS, problem-dependent * @param[in] max_num_steps maximal number of admissable steps * between time-points * @param[in] msgs message * @return a vector of states, each state being a vector of the * same size as the state variable, corresponding to a time in ts. */ template std::vector > integrate_dae( const F& f, const std::vector& yy0, const std::vector& yp0, double t0, const std::vector& ts, const std::vector& theta, const std::vector& x_r, const std::vector& x_i, const double rtol, const double atol, const int64_t max_num_steps = idas_integrator::IDAS_MAX_STEPS, std::ostream* msgs = nullptr) { /* it doesn't matter here what values \c eq_id has, as we don't allow yy0 or yp0 to be parameters */ const std::vector dummy_eq_id(yy0.size(), 0); stan::math::idas_integrator solver(rtol, atol, max_num_steps); stan::math::idas_forward_system dae{ f, dummy_eq_id, yy0, yp0, theta, x_r, x_i, msgs}; dae.check_ic_consistency(t0, atol); return solver.integrate(dae, t0, ts); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/map_rect_concurrent.hpp0000644000176200001440000000505613766554456026606 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_MAP_RECT_CONCURRENT_HPP #define STAN_MATH_REV_MAT_FUNCTOR_MAP_RECT_CONCURRENT_HPP #include #include #include #include #include #include #ifdef STAN_THREADS #include #include #endif #include #include namespace stan { namespace math { namespace internal { template Eigen::Matrix::type, Eigen::Dynamic, 1> map_rect_concurrent( const Eigen::Matrix& shared_params, const std::vector>& job_params, const std::vector>& x_r, const std::vector>& x_i, std::ostream* msgs) { using ReduceF = map_rect_reduce; using CombineF = map_rect_combine; const int num_jobs = job_params.size(); const vector_d shared_params_dbl = value_of(shared_params); std::vector job_output(num_jobs); std::vector world_f_out(num_jobs, 0); auto execute_chunk = [&](std::size_t start, std::size_t end) -> void { for (std::size_t i = start; i != end; ++i) { job_output[i] = ReduceF()(shared_params_dbl, value_of(job_params[i]), x_r[i], x_i[i], msgs); world_f_out[i] = job_output[i].cols(); } }; #ifdef STAN_THREADS tbb::parallel_for(tbb::blocked_range(0, num_jobs), [&](const tbb::blocked_range& r) { execute_chunk(r.begin(), r.end()); }); #else execute_chunk(0, num_jobs); #endif // collect results const int num_world_output = std::accumulate(world_f_out.begin(), world_f_out.end(), 0); matrix_d world_output(job_output[0].rows(), num_world_output); int offset = 0; for (const auto& job : job_output) { const int num_job_outputs = job.cols(); world_output.block(0, offset, world_output.rows(), num_job_outputs) = job; offset += num_job_outputs; } CombineF combine(shared_params, job_params); return combine(world_output, world_f_out); } } // namespace internal } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/algebra_solver_fp.hpp0000644000176200001440000003375713766554456026237 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_FP_SOLVER_HPP #define STAN_MATH_REV_MAT_FUNCTOR_FP_SOLVER_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * KINSOL algebraic system data holder that handles * construction & destruction of SUNDIALS data, as well as * auxiliary data that will be used for functor evaluation. * * @tparam F functor type for system function. */ template struct KinsolFixedPointEnv { /** RHS functor. */ const F& f_; /** val of params for @c y_ to refer to when params are @c var type */ const Eigen::VectorXd y_dummy; /** ref to val of params */ const Eigen::VectorXd& y_; /** system size */ const size_t N_; /** nb. of params */ const size_t M_; /** real data */ const std::vector& x_r_; /** integer data */ const std::vector& x_i_; /** messege stream */ std::ostream* msgs_; /** KINSOL memory block */ void* mem_; /** NVECTOR for unknowns */ N_Vector nv_x_; /** NVECTOR for scaling u */ N_Vector nv_u_scal_; /** NVECTOR for scaling f */ N_Vector nv_f_scal_; /* Constructor when @y is data */ template KinsolFixedPointEnv(const F& f, const Eigen::Matrix& x, const Eigen::VectorXd& y, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs, const std::vector& u_scale, const std::vector& f_scale) : f_(f), y_dummy(), y_(y), x_r_(x_r), x_i_(x_i), msgs_(msgs), N_(x.size()), M_(y.size()), mem_(KINCreate()), nv_x_(N_VNew_Serial(N_)), nv_u_scal_(N_VNew_Serial(N_)), nv_f_scal_(N_VNew_Serial(N_)) { for (int i = 0; i < N_; ++i) { NV_Ith_S(nv_x_, i) = stan::math::value_of(x(i)); NV_Ith_S(nv_u_scal_, i) = stan::math::value_of(u_scale[i]); NV_Ith_S(nv_f_scal_, i) = stan::math::value_of(f_scale[i]); } } /* Constructor when @y is param */ template KinsolFixedPointEnv(const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs, const std::vector& u_scale, const std::vector& f_scale) : f_(f), y_dummy(stan::math::value_of(y)), y_(y_dummy), x_r_(x_r), x_i_(x_i), msgs_(msgs), N_(x.size()), M_(y.size()), mem_(KINCreate()), nv_x_(N_VNew_Serial(N_)), nv_u_scal_(N_VNew_Serial(N_)), nv_f_scal_(N_VNew_Serial(N_)) { for (int i = 0; i < N_; ++i) { NV_Ith_S(nv_x_, i) = stan::math::value_of(x(i)); NV_Ith_S(nv_u_scal_, i) = stan::math::value_of(u_scale[i]); NV_Ith_S(nv_f_scal_, i) = stan::math::value_of(f_scale[i]); } } ~KinsolFixedPointEnv() { N_VDestroy_Serial(nv_x_); N_VDestroy_Serial(nv_u_scal_); N_VDestroy_Serial(nv_f_scal_); KINFree(&mem_); } /* Implements the user-defined function passed to KINSOL. */ static int kinsol_f_system(N_Vector x, N_Vector f, void* user_data) { auto g = static_cast*>(user_data); Eigen::VectorXd x_eigen(Eigen::Map(NV_DATA_S(x), g->N_)); Eigen::Map(N_VGetArrayPointer(f), g->N_) = g->f_(x_eigen, g->y_, g->x_r_, g->x_i_, g->msgs_); return 0; } }; /* * Calculate Jacobian Jxy(Jacobian of unkonwn x w.r.t. the * param y) * given the solution. Specifically, for * * x - f(x, y) = 0 * * we have (Jpq = Jacobian matrix dq/dq) * * Jxy - Jfx * Jxy = Jfy * * therefore Jxy can be solved from system * * (I - Jfx) * Jxy = Jfy * * Jfx and Jfy are obtained through one AD evaluation of f * w.r.t combined vector [x, y]. */ struct FixedPointADJac { /* * Calculate Jacobian Jxy. * * @tparam F RHS functor type * @param x fixed point solution * @param y RHS parameters * @param env KINSOL working envionment, see doc for @c KinsolFixedPointEnv. */ template inline Eigen::Matrix operator()( const Eigen::VectorXd& x, const Eigen::Matrix& y, KinsolFixedPointEnv& env) { using stan::math::precomputed_gradients; using stan::math::to_array_1d; using stan::math::var; auto g = [&env](const Eigen::Matrix& par_) { Eigen::Matrix x_(par_.head(env.N_)); Eigen::Matrix y_(par_.tail(env.M_)); return env.f_(x_, y_, env.x_r_, env.x_i_, env.msgs_); }; Eigen::VectorXd theta(x.size() + y.size()); for (int i = 0; i < env.N_; ++i) { theta(i) = x(i); } for (int i = 0; i < env.M_; ++i) { theta(i + env.N_) = env.y_(i); } Eigen::Matrix fx; Eigen::Matrix J_theta; stan::math::jacobian(g, theta, fx, J_theta); Eigen::MatrixXd A(J_theta.block(0, 0, env.N_, env.N_)); Eigen::MatrixXd b(J_theta.block(0, env.N_, env.N_, env.M_)); A = Eigen::MatrixXd::Identity(env.N_, env.N_) - A; Eigen::MatrixXd Jxy = A.colPivHouseholderQr().solve(b); std::vector gradients(env.M_); Eigen::Matrix x_sol(env.N_); std::vector yv(to_array_1d(y)); for (int i = 0; i < env.N_; ++i) { gradients = to_array_1d(Eigen::VectorXd(Jxy.row(i))); x_sol[i] = precomputed_gradients(x(i), yv, gradients); } return x_sol; } }; /* * Fixed point solver for problem of form * * x = F(x; theta) * * with x as unkowns and theta parameters. * * The solution for FP iteration * doesn't involve derivatives but only data types. * * @tparam fp_env_type solver environment setup that handles * workspace & auxiliary data encapsulation & RAII, namely * the work environment. Currently only support KINSOL's * dense matrix. * @tparam fp_jac_type functor type for calculating the * jacobian. Currently only support @c * FixedPointADJac that obtain dense Jacobian * through QR decomposition. */ template struct FixedPointSolver; /* * Specialization for fixed point solver when using KINSOL. * * @tparam F RHS functor for fixed point iteration. * @tparam fp_jac_type functor type for calculating the jacobian */ template struct FixedPointSolver, fp_jac_type> { /* * Solve FP using KINSOL * * @param x initial point and final solution. * @param env KINSOL solution envionment * @param f_tol Function tolenrance * @param max_num_steps max nb. of iterations. */ void kinsol_solve_fp(Eigen::VectorXd& x, KinsolFixedPointEnv& env, double f_tol, int max_num_steps) { int N = env.N_; void* mem = env.mem_; const int default_anderson_depth = 4; int anderson_depth = std::min(N, default_anderson_depth); check_flag_sundials(KINSetNumMaxIters(mem, max_num_steps), "KINSetNumMaxIters"); check_flag_sundials(KINSetMAA(mem, anderson_depth), "KINSetMAA"); check_flag_sundials(KINInit(mem, &env.kinsol_f_system, env.nv_x_), "KINInit"); check_flag_sundials(KINSetFuncNormTol(mem, f_tol), "KINSetFuncNormTol"); check_flag_sundials(KINSetUserData(mem, static_cast(&env)), "KINSetUserData"); check_flag_kinsol( KINSol(mem, env.nv_x_, KIN_FP, env.nv_u_scal_, env.nv_f_scal_), max_num_steps); for (int i = 0; i < N; ++i) { x(i) = NV_Ith_S(env.nv_x_, i); } } /* * Solve data-only FP problem so no need to calculate jacobian. * @tparam T1 type of init point of iterations * * @param x initial point and final solution. * @param y RHS functor parameters * @param env KINSOL solution envionment * @param f_tol Function tolenrance * @param max_num_steps max nb. of iterations. */ template Eigen::Matrix solve(const Eigen::Matrix& x, const Eigen::Matrix& y, KinsolFixedPointEnv& env, double f_tol, int max_num_steps) { Eigen::VectorXd xd(stan::math::value_of(x)); kinsol_solve_fp(xd, env, f_tol, max_num_steps); return xd; } /* * Solve FP problem and calculate jacobian. * @tparam T1 type of init point of iterations * * @param x initial point and final solution. * @param y RHS functor parameters * @param env KINSOL solution envionment * @param f_tol Function tolenrance * @param max_num_steps max nb. of iterations. */ template Eigen::Matrix solve( const Eigen::Matrix& x, const Eigen::Matrix& y, KinsolFixedPointEnv& env, double f_tol, int max_num_steps) { using stan::math::value_of; using stan::math::var; // FP solution Eigen::VectorXd xd(solve(x, Eigen::VectorXd(), env, f_tol, max_num_steps)); fp_jac_type jac_sol; return jac_sol(xd, y, env); } }; /** * Return a fixed pointer to the specified system of algebraic * equations of form * * x = F(x; theta) * * given an initial guess x, and parameters theta and data. Use the * KINSOL solver from the SUNDIALS suite. * * The user can also specify the scaling controls, the function * tolerance, and the maximum number of steps. * * @tparam F type of equation system function. * @tparam T type of initial guess vector. The final soluton * type doesn't depend on initial guess type, * but we allow initial guess to be either data or param. * @tparam T_u type of scaling vector for unknowns. We allow * it to be @c var because scaling could be parameter * dependent. Internally these params are converted to data * because scaling is applied. * @tparam T_f type of scaling vector for residual. We allow * it to be @c var because scaling could be parameter * dependent. Internally these params are converted to data * because scaling is applied. * @param[in] f Functor that evaluated the system of equations. * @param[in] x Vector of starting values. * @param[in] y Parameter vector for the equation system. The function * is overloaded to treat y as a vector of doubles or of a * a template type T. * @param[in] x_r Continuous data vector for the equation system. * @param[in] x_i Integer data vector for the equation system. * @param[in, out] msgs The print stream for warning messages. * @param[in] u_scale diagonal scaling matrix elements Du * such that Du*x has all components roughly the same * magnitude when x is close to a solution. * (ref. KINSOL user guide chap.2 sec. "Scaling") * @param[in] f_scale diagonal scaling matrix elements such * that Df*(x-f(x)) has all components roughly the same * magnitude when x is not too close to a solution. * (ref. KINSOL user guide chap.2 sec. "Scaling") * @param[in] f_tol Function-norm stopping tolerance. * @param[in] max_num_steps maximum number of function evaluations. * * @throw std::invalid_argument if x has size zero. * @throw std::invalid_argument if x has non-finite elements. * @throw std::invalid_argument if y has non-finite elements. * @throw std::invalid_argument if dat has non-finite elements. * @throw std::invalid_argument if dat_int has non-finite elements. * @throw std::invalid_argument if scaled_step_size is strictly * negative. * @throw std::invalid_argument if function_tolerance is strictly * negative. * @throw std::invalid_argument if max_num_steps is not positive. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if solver exceeds max_num_steps. */ template Eigen::Matrix algebra_solver_fp( const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& x_r, const std::vector& x_i, const std::vector& u_scale, const std::vector& f_scale, std::ostream* msgs = nullptr, double f_tol = 1e-8, int max_num_steps = 200) { // NOLINT(runtime/int) algebra_solver_check(x, y, x_r, x_i, f_tol, max_num_steps); check_nonnegative("algebra_solver", "u_scale", u_scale); check_nonnegative("algebra_solver", "f_scale", f_scale); check_matching_sizes("algebra_solver", "the algebraic system's output", value_of(f(x, y, x_r, x_i, msgs)), "the vector of unknowns, x,", x); KinsolFixedPointEnv env(f, x, y, x_r, x_i, msgs, u_scale, f_scale); // NOLINT FixedPointSolver, FixedPointADJac> fp; return fp.solve(x, y, env, f_tol, max_num_steps); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/kinsol_solve.hpp0000644000176200001440000001277013766554456025262 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_KINSOL_SOLVE_HPP #define STAN_MATH_REV_MAT_FUNCTOR_KINSOL_SOLVE_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Return the solution to the specified algebraic system, * given an initial guess. Invokes the Kinsol solver from Sundials. * * @tparam F type of equation system function. * @tparam T type of initial guess vector. * @param[in] f Functor that evaluated the system of equations. * @param[in] x Vector of starting values. * @param[in] y Parameter vector for the equation system. The function * is overloaded to treat y as a vector of doubles or of a * a template type T. * @param[in] dat Continuous data vector for the equation system. * @param[in] dat_int Integer data vector for the equation system. * @param[in, out] msgs The print stream for warning messages. * @param[in] scaling_step_tol Scaled-step stopping tolerance. If * a Newton step is smaller than the scaling step * tolerance, the code breaks, assuming the solver is no * longer making significant progress (i.e. is stuck) * @param[in] function_tolerance determines whether roots are acceptable. * @param[in] max_num_steps Maximum number of function evaluations. * @param[in] custom_jacobian If 0, use Kinsol's default to compute the * jacobian for the Newton step, namely Quotient Difference * (finite difference). If 1, use reverse-mode AD, unless * the user specifies their own method. * @param[in] J_f A functor that computes the Jacobian for the Newton step. * Defaults to reverse-mode AD. * @param[in] steps_eval_jacobian Maximum number of steps before the * Jacobian gets recomputed. Note that Kinsol's default is 10. * If equal to 1, the algorithm computes exact Newton steps. * @param[in] global_line_search does the solver use a global line search? * If equal to KIN_NONE, no, if KIN_LINESEARCH, yes. * @return x_solution Vector of solutions to the system of equations. * @throw std::invalid_argument if Kinsol returns a negative * flag when setting up the solver. * @throw boost::math::evaluation_error if Kinsol returns a * negative flag after attempting to solve the equation. */ template Eigen::VectorXd kinsol_solve( const F1& f, const Eigen::VectorXd& x, const Eigen::VectorXd& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs = nullptr, double scaling_step_tol = 1e-3, double function_tolerance = 1e-6, long int max_num_steps = 200, // NOLINT(runtime/int) bool custom_jacobian = 1, const F2& J_f = kinsol_J_f(), int steps_eval_jacobian = 10, int global_line_search = KIN_LINESEARCH) { int N = x.size(); typedef kinsol_system_data system_data; system_data kinsol_data(f, J_f, x, y, dat, dat_int, msgs); check_flag_sundials(KINInit(kinsol_data.kinsol_memory_, &system_data::kinsol_f_system, kinsol_data.nv_x_), "KINInit"); N_Vector scaling = N_VNew_Serial(N); N_VConst_Serial(1.0, scaling); // no scaling check_flag_sundials( KINSetNumMaxIters(kinsol_data.kinsol_memory_, max_num_steps), "KINSetNumMaxIters"); check_flag_sundials( KINSetFuncNormTol(kinsol_data.kinsol_memory_, function_tolerance), "KINSetFuncNormTol"); check_flag_sundials( KINSetScaledStepTol(kinsol_data.kinsol_memory_, scaling_step_tol), "KINSetScaledStepTol"); check_flag_sundials( KINSetMaxSetupCalls(kinsol_data.kinsol_memory_, steps_eval_jacobian), "KINSetMaxSetupCalls"); // CHECK // The default value is 1000 * ||u_0||_D where ||u_0|| is the initial guess. // So we run into issues if ||u_0|| = 0. // If the norm is non-zero, use kinsol's default (accessed with 0), // else use the dimension of x -- CHECK - find optimal length. double max_newton_step = (x.norm() == 0) ? x.size() : 0; check_flag_sundials( KINSetMaxNewtonStep(kinsol_data.kinsol_memory_, max_newton_step), "KINSetMaxNewtonStep"); check_flag_sundials(KINSetUserData(kinsol_data.kinsol_memory_, static_cast(&kinsol_data)), "KINSetUserData"); // construct Linear solver check_flag_sundials(KINSetLinearSolver(kinsol_data.kinsol_memory_, kinsol_data.LS_, kinsol_data.J_), "KINSetLinearSolver"); if (custom_jacobian) check_flag_sundials( KINSetJacFn(kinsol_data.kinsol_memory_, &system_data::kinsol_jacobian), "KINSetJacFn"); N_Vector nv_x = N_VNew_Serial(N); for (int i = 0; i < N; i++) NV_Ith_S(nv_x, i) = x(i); check_flag_kinsol(KINSol(kinsol_data.kinsol_memory_, nv_x, global_line_search, scaling, scaling), max_num_steps); Eigen::VectorXd x_solution(N); for (int i = 0; i < N; i++) x_solution(i) = NV_Ith_S(nv_x, i); N_VDestroy(nv_x); N_VDestroy(scaling); return x_solution; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/cvodes_utils.hpp0000644000176200001440000000342113766554456025247 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_CVODES_UTILS_HPP #define STAN_MATH_REV_MAT_FUNCTOR_CVODES_UTILS_HPP #include #include #include #include #include namespace stan { namespace math { // no-op error handler to silence CVodes error output; errors handled // directly by Stan extern "C" inline void cvodes_silent_err_handler(int error_code, const char* module, const char* function, char* msg, void* eh_data) {} inline void cvodes_set_options(void* cvodes_mem, double rel_tol, double abs_tol, // NOLINTNEXTLINE(runtime/int) long int max_num_steps) { // forward CVode errors to noop error handler CVodeSetErrHandlerFn(cvodes_mem, cvodes_silent_err_handler, nullptr); // Initialize solver parameters check_flag_sundials(CVodeSStolerances(cvodes_mem, rel_tol, abs_tol), "CVodeSStolerances"); check_flag_sundials(CVodeSetMaxNumSteps(cvodes_mem, max_num_steps), "CVodeSetMaxNumSteps"); double init_step = 0; check_flag_sundials(CVodeSetInitStep(cvodes_mem, init_step), "CVodeSetInitStep"); long int max_err_test_fails = 20; // NOLINT(runtime/int) check_flag_sundials(CVodeSetMaxErrTestFails(cvodes_mem, max_err_test_fails), "CVodeSetMaxErrTestFails"); long int max_conv_fails = 50; // NOLINT(runtime/int) check_flag_sundials(CVodeSetMaxConvFails(cvodes_mem, max_conv_fails), "CVodeSetMaxConvFails"); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/algebra_solver_newton.hpp0000644000176200001440000001620713766554456027133 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_ALGEBRA_SOLVER_NEWTON_HPP #define STAN_MATH_REV_MAT_FUNCTOR_ALGEBRA_SOLVER_NEWTON_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Return the solution to the specified system of algebraic * equations given an initial guess, and parameters and data, * which get passed into the algebraic system. Use the * KINSOL solver from the SUNDIALS suite. * * The user can also specify the scaled step size, the function * tolerance, and the maximum number of steps. * * @tparam F type of equation system function. * @tparam T type of initial guess vector. * @param[in] f Functor that evaluated the system of equations. * @param[in] x Vector of starting values. * @param[in] y Parameter vector for the equation system. The function * is overloaded to treat y as a vector of doubles or of a * a template type T. * @param[in] dat Continuous data vector for the equation system. * @param[in] dat_int Integer data vector for the equation system. * @param[in, out] msgs The print stream for warning messages. * @param[in] scaling_step_size Scaled-step stopping tolerance. If * a Newton step is smaller than the scaling step * tolerance, the code breaks, assuming the solver is no * longer making significant progress (i.e. is stuck) * @param[in] function_tolerance determines whether roots are acceptable. * @param[in] max_num_steps maximum number of function evaluations. * * @throw std::invalid_argument if x has size zero. * @throw std::invalid_argument if x has non-finite elements. * @throw std::invalid_argument if y has non-finite elements. * @throw std::invalid_argument if dat has non-finite elements. * @throw std::invalid_argument if dat_int has non-finite elements. * @throw std::invalid_argument if scaled_step_size is strictly * negative. * @throw std::invalid_argument if function_tolerance is strictly * negative. * @throw std::invalid_argument if max_num_steps is not positive. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if solver exceeds max_num_steps. */ template Eigen::VectorXd algebra_solver_newton( const F& f, const Eigen::Matrix& x, const Eigen::VectorXd& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs = nullptr, double scaling_step_size = 1e-3, double function_tolerance = 1e-6, long int max_num_steps = 200) { // NOLINT(runtime/int) algebra_solver_check(x, y, dat, dat_int, function_tolerance, max_num_steps); check_nonnegative("algebra_solver", "scaling_step_size", scaling_step_size); check_matching_sizes("algebra_solver", "the algebraic system's output", value_of(f(x, y, dat, dat_int, msgs)), "the vector of unknowns, x,", x); return kinsol_solve(f, value_of(x), y, dat, dat_int, 0, scaling_step_size, function_tolerance, max_num_steps); } /** * Return the solution to the specified system of algebraic * equations given an initial guess, and parameters and data, * which get passed into the algebraic system. Use the * KINSOL solver from the SUNDIALS suite. * * The user can also specify the scaled step size, the function * tolerance, and the maximum number of steps. * * Overload the previous definition to handle the case where y * is a vector of parameters (var). The overload calls the * algebraic solver defined above and builds a vari object on * top, using the algebra_solver_vari class. * * @tparam F type of equation system function. * @tparam T type of initial guess vector. * @param[in] f Functor that evaluated the system of equations. * @param[in] x Vector of starting values. * @param[in] y Parameter vector for the equation system. The function * is overloaded to treat y as a vector of doubles or of a * a template type T. * @param[in] dat Continuous data vector for the equation system. * @param[in] dat_int Integer data vector for the equation system. * @param[in, out] msgs The print stream for warning messages. * @param[in] scaling_step_size Scaled-step stopping tolerance. If * a Newton step is smaller than the scaling step * tolerance, the code breaks, assuming the solver is no * longer making significant progress (i.e. is stuck) * @param[in] function_tolerance determines whether roots are acceptable. * @param[in] max_num_steps maximum number of function evaluations. * @return theta Vector of solutions to the system of equations. * @throw std::invalid_argument if x has size zero. * @throw std::invalid_argument if x has non-finite elements. * @throw std::invalid_argument if y has non-finite elements. * @throw std::invalid_argument if dat has non-finite elements. * @throw std::invalid_argument if dat_int has non-finite elements. * @throw std::invalid_argument if scaled_step_size is strictly * negative. * @throw std::invalid_argument if function_tolerance is strictly * negative. * @throw std::invalid_argument if max_num_steps is not positive. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if solver exceeds max_num_steps. */ template Eigen::Matrix algebra_solver_newton( const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs = nullptr, double scaling_step_size = 1e-3, double function_tolerance = 1e-6, long int max_num_steps = 200) { // NOLINT(runtime/int) Eigen::VectorXd theta_dbl = algebra_solver_newton( f, x, value_of(y), dat, dat_int, msgs, scaling_step_size, function_tolerance, max_num_steps); typedef system_functor Fy; typedef system_functor Fs; typedef hybrj_functor_solver Fx; Fx fx(Fs(), f, value_of(x), value_of(y), dat, dat_int, msgs); // Construct vari algebra_solver_vari* vi0 = new algebra_solver_vari(Fy(), f, value_of(x), y, dat, dat_int, theta_dbl, fx, msgs); Eigen::Matrix theta(x.size()); theta(0) = var(vi0->theta_[0]); for (int i = 1; i < x.size(); ++i) theta(i) = var(vi0->theta_[i]); return theta; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/cvodes_integrator.hpp0000644000176200001440000001722113766554456026270 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_INTEGRATE_ODE_CVODES_HPP #define STAN_MATH_REV_MAT_FUNCTOR_INTEGRATE_ODE_CVODES_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Integrator interface for CVODES' ODE solvers (Adams & BDF * methods). * @tparam Lmm ID of ODE solver (1: ADAMS, 2: BDF) */ template class cvodes_integrator { public: cvodes_integrator() {} /** * Return the solutions for the specified system of ordinary * differential equations given the specified initial state, * initial times, times of desired solution, and parameters and * data, writing error and warning messages to the specified * stream. * * This function is templated to allow the initials to be * either data or autodiff variables and the parameters to be data * or autodiff variables. The autodiff-based implementation for * reverse-mode are defined in namespace stan::math * and may be invoked via argument-dependent lookup by including * their headers. * * The solver used is based on the backward differentiation * formula which is an implicit numerical integration scheme * appropiate for stiff ODE systems. * * @tparam F type of ODE system function. * @tparam T_initial type of scalars for initial values. * @tparam T_param type of scalars for parameters. * @tparam T_t0 type of scalar of initial time point. * @tparam T_ts type of time-points where ODE solution is returned. * @param[in] f functor for the base ordinary differential equation. * @param[in] y0 initial state. * @param[in] t0 initial time. * @param[in] ts times of the desired solutions, in strictly * increasing order, all greater than the initial time. * @param[in] theta parameter vector for the ODE. * @param[in] x continuous data vector for the ODE. * @param[in] x_int integer data vector for the ODE. * @param[in, out] msgs the print stream for warning messages. * @param[in] relative_tolerance relative tolerance passed to CVODE. * @param[in] absolute_tolerance absolute tolerance passed to CVODE. * @param[in] max_num_steps maximal number of admissable steps * between time-points * @return a vector of states, each state being a vector of the * same size as the state variable, corresponding to a time in ts. */ template std::vector::type>> integrate(const F& f, const std::vector& y0, const T_t0& t0, const std::vector& ts, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs, double relative_tolerance, double absolute_tolerance, long int max_num_steps) { // NOLINT(runtime/int) using initial_var = stan::is_var; using param_var = stan::is_var; const char* fun = "integrate_ode_cvodes"; const double t0_dbl = value_of(t0); const std::vector ts_dbl = value_of(ts); check_finite(fun, "initial state", y0); check_finite(fun, "initial time", t0_dbl); check_finite(fun, "times", ts_dbl); check_finite(fun, "parameter vector", theta); check_finite(fun, "continuous data", x); check_nonzero_size(fun, "times", ts); check_nonzero_size(fun, "initial state", y0); check_ordered(fun, "times", ts_dbl); check_less(fun, "initial time", t0_dbl, ts_dbl[0]); if (relative_tolerance <= 0) { invalid_argument("integrate_ode_cvodes", "relative_tolerance,", relative_tolerance, "", ", must be greater than 0"); } if (absolute_tolerance <= 0) { invalid_argument("integrate_ode_cvodes", "absolute_tolerance,", absolute_tolerance, "", ", must be greater than 0"); } if (max_num_steps <= 0) { invalid_argument("integrate_ode_cvodes", "max_num_steps,", max_num_steps, "", ", must be greater than 0"); } const size_t N = y0.size(); const size_t M = theta.size(); const size_t S = (initial_var::value ? N : 0) + (param_var::value ? M : 0); using ode_data = cvodes_ode_data; ode_data cvodes_data(f, y0, theta, x, x_int, msgs); void* cvodes_mem = CVodeCreate(Lmm); if (cvodes_mem == nullptr) { throw std::runtime_error("CVodeCreate failed to allocate memory"); } const size_t coupled_size = cvodes_data.coupled_ode_.size(); std::vector::type>> y; coupled_ode_observer observer( f, y0, theta, t0, ts, x, x_int, msgs, y); try { check_flag_sundials(CVodeInit(cvodes_mem, &ode_data::cv_rhs, t0_dbl, cvodes_data.nv_state_), "CVodeInit"); // Assign pointer to this as user data check_flag_sundials( CVodeSetUserData(cvodes_mem, reinterpret_cast(&cvodes_data)), "CVodeSetUserData"); cvodes_set_options(cvodes_mem, relative_tolerance, absolute_tolerance, max_num_steps); // for the stiff solvers we need to reserve additional memory // and provide a Jacobian function call. new API since 3.0.0: // create matrix object and linear solver object; resource // (de-)allocation is handled in the cvodes_ode_data check_flag_sundials( CVodeSetLinearSolver(cvodes_mem, cvodes_data.LS_, cvodes_data.A_), "CVodeSetLinearSolver"); check_flag_sundials( CVodeSetJacFn(cvodes_mem, &ode_data::cv_jacobian_states), "CVodeSetJacFn"); // initialize forward sensitivity system of CVODES as needed if (S > 0) { check_flag_sundials( CVodeSensInit(cvodes_mem, static_cast(S), CV_STAGGERED, &ode_data::cv_rhs_sens, cvodes_data.nv_state_sens_), "CVodeSensInit"); check_flag_sundials(CVodeSensEEtolerances(cvodes_mem), "CVodeSensEEtolerances"); } double t_init = t0_dbl; for (size_t n = 0; n < ts.size(); ++n) { double t_final = ts_dbl[n]; if (t_final != t_init) { check_flag_sundials(CVode(cvodes_mem, t_final, cvodes_data.nv_state_, &t_init, CV_NORMAL), "CVode"); } if (S > 0) { check_flag_sundials( CVodeGetSens(cvodes_mem, &t_init, cvodes_data.nv_state_sens_), "CVodeGetSens"); } observer(cvodes_data.coupled_state_, t_final); t_init = t_final; } } catch (const std::exception& e) { CVodeFree(&cvodes_mem); throw; } CVodeFree(&cvodes_mem); return y; } }; // cvodes integrator } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/algebra_solver_powell.hpp0000644000176200001440000003360013766554456027117 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_ALGEBRA_SOLVER_POWELL_HPP #define STAN_MATH_REV_MAT_FUNCTOR_ALGEBRA_SOLVER_POWELL_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * The vari class for the algebraic solver. We compute the Jacobian of * the solutions with respect to the parameters using the implicit * function theorem. The call to Jacobian() occurs outside the call to * chain() -- this prevents malloc issues. */ template struct algebra_solver_vari : public vari { /** vector of parameters */ vari** y_; /** number of parameters */ int y_size_; /** number of unknowns */ int x_size_; /** vector of solution */ vari** theta_; /** Jacobian of the solution w.r.t parameters */ double* Jx_y_; algebra_solver_vari(const Fs& fs, const F& f, const Eigen::VectorXd& x, const Eigen::Matrix& y, const std::vector& dat, const std::vector& dat_int, const Eigen::VectorXd& theta_dbl, Fx& fx, std::ostream* msgs) : vari(theta_dbl(0)), y_(ChainableStack::instance_->memalloc_.alloc_array(y.size())), y_size_(y.size()), x_size_(x.size()), theta_( ChainableStack::instance_->memalloc_.alloc_array(x_size_)), Jx_y_(ChainableStack::instance_->memalloc_.alloc_array( x_size_ * y_size_)) { using Eigen::Map; using Eigen::MatrixXd; for (int i = 0; i < y.size(); ++i) { y_[i] = y(i).vi_; } theta_[0] = this; for (int i = 1; i < x.size(); ++i) { theta_[i] = new vari(theta_dbl(i), false); } // Compute the Jacobian and store in array, using the // implicit function theorem, i.e. Jx_y = Jf_y / Jf_x using f_y = hybrj_functor_solver; Map(&Jx_y_[0], x_size_, y_size_) = -mdivide_left(fx.get_jacobian(theta_dbl), f_y(fs, f, theta_dbl, value_of(y), dat, dat_int, msgs) .get_jacobian(value_of(y))); } void chain() { for (int j = 0; j < y_size_; j++) { for (int i = 0; i < x_size_; i++) { y_[j]->adj_ += theta_[i]->adj_ * Jx_y_[j * x_size_ + i]; } } } }; /** * Return the solution to the specified system of algebraic * equations given an initial guess, and parameters and data, * which get passed into the algebraic system. * Use Powell's dogleg solver. * * The user can also specify the relative tolerance * (xtol in Eigen's code), the function tolerance, * and the maximum number of steps (maxfev in Eigen's code). * * Throw an exception if the norm of f(x), where f is the * output of the algebraic system and x the proposed solution, * is greater than the function tolerance. We here use the * norm as a metric to measure how far we are from the origin (0). * * @tparam F type of equation system function. * @tparam T type of initial guess vector. * @param[in] f Functor that evaluates the system of equations. * @param[in] x Vector of starting values. * @param[in] y parameter vector for the equation system. The function * is overloaded to treat y as a vector of doubles or of a * a template type T. * @param[in] dat continuous data vector for the equation system. * @param[in] dat_int integer data vector for the equation system. * @param[in, out] msgs the print stream for warning messages. * @param[in] relative_tolerance determines the convergence criteria * for the solution. * @param[in] function_tolerance determines whether roots are acceptable. * @param[in] max_num_steps maximum number of function evaluations. * @return theta Vector of solutions to the system of equations. * @throw std::invalid_argument if x has size zero. * @throw std::invalid_argument if x has non-finite elements. * @throw std::invalid_argument if y has non-finite elements. * @throw std::invalid_argument if dat has non-finite elements. * @throw std::invalid_argument if dat_int has non-finite elements. * @throw std::invalid_argument if relative_tolerance is strictly * negative. * @throw std::invalid_argument if function_tolerance is strictly * negative. * @throw std::invalid_argument if max_num_steps is not positive. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if solver exceeds max_num_steps. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if the norm of the solution exceeds the * function tolerance. */ template Eigen::VectorXd algebra_solver_powell( const F& f, const Eigen::Matrix& x, const Eigen::VectorXd& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs = nullptr, double relative_tolerance = 1e-10, double function_tolerance = 1e-6, long int max_num_steps = 1e+3) { // NOLINT(runtime/int) algebra_solver_check(x, y, dat, dat_int, function_tolerance, max_num_steps); check_nonnegative("alegbra_solver", "relative_tolerance", relative_tolerance); // if (relative_tolerance < 0) // invalid_argument("algebra_solver", "relative_tolerance,", // function_tolerance, "", // ", must be greater than or equal to 0"); // Create functor for algebraic system using Fs = system_functor; using Fx = hybrj_functor_solver; Fx fx(Fs(), f, value_of(x), y, dat, dat_int, msgs); Eigen::HybridNonLinearSolver solver(fx); // Check dimension unknowns equals dimension of system output check_matching_sizes("algebra_solver", "the algebraic system's output", fx.get_value(value_of(x)), "the vector of unknowns, x,", x); // Compute theta_dbl Eigen::VectorXd theta_dbl = value_of(x); solver.parameters.xtol = relative_tolerance; solver.parameters.maxfev = max_num_steps; solver.solve(theta_dbl); // Check if the max number of steps has been exceeded if (solver.nfev >= max_num_steps) { std::ostringstream message; message << "algebra_solver: max number of iterations: " << max_num_steps << " exceeded."; throw boost::math::evaluation_error(message.str()); } // Check solution is a root double system_norm = fx.get_value(theta_dbl).stableNorm(); if (system_norm > function_tolerance) { std::ostringstream message2; message2 << "algebra_solver: the norm of the algebraic function is: " << system_norm << " but should be lower than the function " << "tolerance: " << function_tolerance << ". Consider " << "decreasing the relative tolerance and increasing the " << "max_num_steps."; throw boost::math::evaluation_error(message2.str()); } return theta_dbl; } /** * Return the solution to the specified system of algebraic * equations given an initial guess, and parameters and data, * which get passed into the algebraic system. * Use Powell's dogleg solver. * * The user can also specify the relative tolerance * (xtol in Eigen's code), the function tolerance, * and the maximum number of steps (maxfev in Eigen's code). * * Overload the previous definition to handle the case where y * is a vector of parameters (var). The overload calls the * algebraic solver defined above and builds a vari object on * top, using the algebra_solver_vari class. * * @tparam F type of equation system function. * @tparam T1 Type of elements in x vector. * @tparam T2 Type of elements in y vector. * @param[in] f Functor that evaluates the system of equations. * @param[in] x Vector of starting values (initial guess). * @param[in] y parameter vector for the equation system. * @param[in] dat continuous data vector for the equation system. * @param[in] dat_int integer data vector for the equation system. * @param[in, out] msgs the print stream for warning messages. * @param[in] relative_tolerance determines the convergence criteria * for the solution. * @param[in] function_tolerance determines whether roots are acceptable. * @param[in] max_num_steps maximum number of function evaluations. * @return theta Vector of solutions to the system of equations. * @throw std::invalid_argument if x has size zero. * @throw std::invalid_argument if x has non-finite elements. * @throw std::invalid_argument if y has non-finite elements. * @throw std::invalid_argument if dat has non-finite elements. * @throw std::invalid_argument if dat_int has non-finite * elements. * @throw std::invalid_argument if relative_tolerance is strictly * negative. * @throw std::invalid_argument if function_tolerance is strictly * negative. * @throw std::invalid_argument if max_num_steps is not positive. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if solver exceeds max_num_steps. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if the norm of the solution exceeds the * function tolerance. */ template Eigen::Matrix algebra_solver_powell( const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs = nullptr, double relative_tolerance = 1e-10, double function_tolerance = 1e-6, long int max_num_steps = 1e+3) { // NOLINT(runtime/int) Eigen::VectorXd theta_dbl = algebra_solver_powell( f, x, value_of(y), dat, dat_int, 0, relative_tolerance, function_tolerance, max_num_steps); using Fy = system_functor; // TODO(charlesm93): a similar object gets constructed inside // the call to algebra_solver. Cache the previous result // and use it here (if possible). using Fs = system_functor; using Fx = hybrj_functor_solver; Fx fx(Fs(), f, value_of(x), value_of(y), dat, dat_int, msgs); // Construct vari algebra_solver_vari* vi0 = new algebra_solver_vari(Fy(), f, value_of(x), y, dat, dat_int, theta_dbl, fx, msgs); Eigen::Matrix theta(x.size()); theta(0) = var(vi0->theta_[0]); for (int i = 1; i < x.size(); ++i) { theta(i) = var(vi0->theta_[i]); } return theta; } /** * Return the solution to the specified system of algebraic * equations given an initial guess, and parameters and data, * which get passed into the algebraic system. * Use Powell's dogleg solver. * * The user can also specify the relative tolerance * (xtol in Eigen's code), the function tolerance, * and the maximum number of steps (maxfev in Eigen's code). * * Signature to maintain backward compatibility, will be removed * in the future. * * @tparam F type of equation system function. * @tparam T1 Type of elements in x vector. * @tparam T2 Type of elements in y vector. * @param[in] f Functor that evaluates the system of equations. * @param[in] x Vector of starting values (initial guess). * @param[in] y parameter vector for the equation system. * @param[in] dat continuous data vector for the equation system. * @param[in] dat_int integer data vector for the equation system. * @param[in, out] msgs the print stream for warning messages. * @param[in] relative_tolerance determines the convergence criteria * for the solution. * @param[in] function_tolerance determines whether roots are acceptable. * @param[in] max_num_steps maximum number of function evaluations. * @return theta Vector of solutions to the system of equations. * @throw std::invalid_argument if x has size zero. * @throw std::invalid_argument if x has non-finite elements. * @throw std::invalid_argument if y has non-finite elements. * @throw std::invalid_argument if dat has non-finite elements. * @throw std::invalid_argument if dat_int has non-finite * elements. * @throw std::invalid_argument if relative_tolerance is strictly * negative. * @throw std::invalid_argument if function_tolerance is strictly * negative. * @throw std::invalid_argument if max_num_steps is not positive. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if solver exceeds max_num_steps. * @throw boost::math::evaluation_error (which is a subclass of * std::runtime_error) if the norm of the solution exceeds the * function tolerance. */ template Eigen::Matrix algebra_solver( const F& f, const Eigen::Matrix& x, const Eigen::Matrix& y, const std::vector& dat, const std::vector& dat_int, std::ostream* msgs = nullptr, double relative_tolerance = 1e-10, double function_tolerance = 1e-6, long int max_num_steps = 1e+3) { // NOLINT(runtime/int) return algebra_solver_powell(f, x, y, dat, dat_int, msgs, relative_tolerance, function_tolerance, max_num_steps); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/integrate_ode_bdf.hpp0000644000176200001440000000234213766554456026171 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_INTEGRATE_ODE_BDF_HPP #define STAN_MATH_REV_MAT_FUNCTOR_INTEGRATE_ODE_BDF_HPP #include #include #include #include namespace stan { namespace math { template std::vector::type>> integrate_ode_bdf(const F& f, const std::vector& y0, const T_t0& t0, const std::vector& ts, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs = nullptr, double relative_tolerance = 1e-10, double absolute_tolerance = 1e-10, long int max_num_steps = 1e8) { // NOLINT(runtime/int) stan::math::cvodes_integrator integrator; return integrator.integrate(f, y0, t0, ts, theta, x, x_int, msgs, relative_tolerance, absolute_tolerance, max_num_steps); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/idas_integrator.hpp0000644000176200001440000002020213766554456025716 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_IDAS_INTEGRATOR_HPP #define STAN_MATH_REV_MAT_FUNCTOR_IDAS_INTEGRATOR_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include enum IDAS_SENSITIVITY { forward }; namespace stan { namespace math { /** * IDAS DAE integrator. */ class idas_integrator { const double rtol_; const double atol_; const int64_t max_num_steps_; /** * Forward decl */ template void init_sensitivity(Dae& dae); /** * Placeholder for data-only idas_forword_system, no sensitivty * * @tparam F DAE functor type. * @param[in] dae DAE system */ template void init_sensitivity(idas_forward_system& dae) {} // /** // * idas adjoint sens calculation requires different initialization // * // * @tparam F type of DAE RHS functor // * @tparam Tyy type of DAE primary unknowns // * @tparam Typ type of DAE derivative unknowns // * @tparam Tpar type of DAE parameters. // * @param[out] dae DAE system // * @param[in] t0 initial time. // * @param[in] ts times of the desired solutions // * @param[out] res_yy DAE solutions // */ // template // void init_sensitivity(idas_adjoint_system& dae) { // // TODO(yizhang): adjoint sensitivity initialization // } template void solve(idas_forward_system& dae, const double& t0, const std::vector& ts, std::vector >& res_yy); template void solve(Dae& dae, const double& t0, const std::vector& ts, typename Dae::return_type& res_yy); // TODO(yizhang): adjoint sensitivity solver public: static constexpr int IDAS_MAX_STEPS = 500; /** * constructor * @param[in] rtol relative tolerance * @param[in] atol absolute tolerance * @param[in] max_num_steps max nb. of times steps */ idas_integrator(const double rtol, const double atol, const int64_t max_num_steps = IDAS_MAX_STEPS) : rtol_(rtol), atol_(atol), max_num_steps_(max_num_steps) { if (rtol_ <= 0) { invalid_argument("idas_integrator", "relative tolerance,", rtol_, "", ", must be greater than 0"); } if (rtol_ > 1.0E-3) { invalid_argument("idas_integrator", "relative tolerance,", rtol_, "", ", must be less than 1.0E-3"); } if (atol_ <= 0) { invalid_argument("idas_integrator", "absolute tolerance,", atol_, "", ", must be greater than 0"); } if (max_num_steps_ <= 0) { invalid_argument("idas_integrator", "max_num_steps,", max_num_steps_, "", ", must be greater than 0"); } } /** * Return the solutions for the specified DAE * given the specified initial state, * initial times, times of desired solution, and parameters and * data, writing error and warning messages to the specified * stream contained in the DAE system. * * @tparam DAE type of DAE system * @param[in] dae DAE system * @param[in] t0 initial time. * @param[in] ts times of the desired solutions, in strictly * increasing order, all greater than the initial time. * @return a vector of states, each state being a vector of the * same size as the state variable, corresponding to a time in ts. */ template typename Dae::return_type integrate(Dae& dae, double t0, const std::vector& ts) { using Eigen::Dynamic; using Eigen::Matrix; using Eigen::MatrixXd; using Eigen::VectorXd; static const char* caller = "idas_integrator"; check_finite(caller, "initial time", t0); check_finite(caller, "times", ts); check_ordered(caller, "times", ts); check_nonzero_size(caller, "times", ts); check_less(caller, "initial time", t0, ts.front()); auto mem = dae.mem(); auto yy = dae.nv_yy(); auto yp = dae.nv_yp(); const size_t n = dae.n(); typename Dae::return_type res_yy( ts.size(), std::vector(n, 0)); auto A = SUNDenseMatrix(n, n); auto LS = SUNDenseLinearSolver(yy, A); try { CHECK_IDAS_CALL(IDASetUserData(mem, dae.to_user_data())); CHECK_IDAS_CALL(IDAInit(mem, dae.residual(), t0, yy, yp)); CHECK_IDAS_CALL(IDASetLinearSolver(mem, LS, A)); CHECK_IDAS_CALL(IDASStolerances(mem, rtol_, atol_)); CHECK_IDAS_CALL(IDASetMaxNumSteps(mem, max_num_steps_)); init_sensitivity(dae); solve(dae, t0, ts, res_yy); } catch (const std::exception& e) { SUNLinSolFree(LS); SUNMatDestroy(A); throw; } SUNLinSolFree(LS); SUNMatDestroy(A); return res_yy; } }; // idas integrator /** * Initialize sensitivity calculation and set * tolerance. For sensitivity with respect to initial * conditions, set sensitivity to identity * * @tparam Dae DAE system type * @param[in/out] dae DAE system */ template void idas_integrator::init_sensitivity(Dae& dae) { if (Dae::need_sens) { auto mem = dae.mem(); auto yys = dae.nv_yys(); auto yps = dae.nv_yps(); auto n = dae.n(); if (Dae::is_var_yy0) { for (size_t i = 0; i < n; ++i) { NV_Ith_S(yys[i], i) = 1.0; } } if (Dae::is_var_yp0) { for (size_t i = 0; i < n; ++i) { NV_Ith_S(yps[i + n], i) = 1.0; } } CHECK_IDAS_CALL(IDASensInit(mem, dae.ns(), IDA_SIMULTANEOUS, dae.sensitivity_residual(), yys, yps)); CHECK_IDAS_CALL(IDASensEEtolerances(mem)); CHECK_IDAS_CALL(IDAGetSensConsistentIC(mem, yys, yps)); } } /** * Solve DAE system, no sensitivty * * @tparam F DAE functor type * @param[out] dae DAE system * @param[in] t0 initial time * @param[in] ts times of the desired solutions * @param[out] res_yy DAE solutions */ template void idas_integrator::solve(idas_forward_system& dae, const double& t0, const std::vector& ts, std::vector >& res_yy) { double t1 = t0; size_t i = 0; auto mem = dae.mem(); auto yy = dae.nv_yy(); auto yp = dae.nv_yp(); std::for_each(ts.begin(), ts.end(), [&](double t2) { CHECK_IDAS_CALL(IDASolve(mem, t2, &t1, yy, yp, IDA_NORMAL)); std::copy(dae.yy_val().begin(), dae.yy_val().end(), res_yy[i].begin()); ++i; }); } /** * Solve Dae system with forward sensitivty, return a * vector of var with precomputed gradient as sensitivity value * * @tparam Dae DAE system type * @param[out] dae DAE system * @param[in] t0 initial time * @param[in] ts times of the desired solutions * @param[out] res_yy DAE solutions */ template void idas_integrator::solve(Dae& dae, const double& t0, const std::vector& ts, typename Dae::return_type& res_yy) { double t1 = t0; size_t i = 0; auto mem = dae.mem(); auto yy = dae.nv_yy(); auto yp = dae.nv_yp(); auto yys = dae.nv_yys(); const auto n = dae.n(); const auto ns = dae.ns(); auto vars = dae.vars(); std::vector sol_t(n); std::vector sol_grad(ns); std::for_each(ts.begin(), ts.end(), [&](double t2) { CHECK_IDAS_CALL(IDASolve(mem, t2, &t1, yy, yp, IDA_NORMAL)); CHECK_IDAS_CALL(IDAGetSens(mem, &t1, yys)); for (size_t k = 0; k < n; ++k) { for (size_t j = 0; j < ns; ++j) { sol_grad[j] = NV_Ith_S(yys[j], k); } sol_t[k] = stan::math::precomputed_gradients(NV_Ith_S(yy, k), vars, sol_grad); } res_yy[i] = sol_t; ++i; }); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/integrate_ode_adams.hpp0000644000176200001440000000237013766554456026524 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_INTEGRATE_ODE_ADAMS_HPP #define STAN_MATH_REV_MAT_FUNCTOR_INTEGRATE_ODE_ADAMS_HPP #include #include #include #include namespace stan { namespace math { template std::vector::type>> integrate_ode_adams(const F& f, const std::vector& y0, const T_t0& t0, const std::vector& ts, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs = nullptr, double relative_tolerance = 1e-10, double absolute_tolerance = 1e-10, long int max_num_steps = 1e8) { // NOLINT(runtime/int) stan::math::cvodes_integrator integrator; return integrator.integrate(f, y0, t0, ts, theta, x, x_int, msgs, relative_tolerance, absolute_tolerance, max_num_steps); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/jacobian.hpp0000644000176200001440000000220013766554456024304 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_JACOBIAN_HPP #define STAN_MATH_REV_MAT_FUNCTOR_JACOBIAN_HPP #include #include #include #include #include namespace stan { namespace math { template void jacobian(const F& f, const Eigen::Matrix& x, Eigen::Matrix& fx, Eigen::Matrix& J) { using Eigen::Dynamic; using Eigen::Matrix; start_nested(); try { Matrix x_var(x); Matrix fx_var = f(x_var); fx.resize(fx_var.size()); J.resize(x.size(), fx_var.size()); fx = fx_var.val(); grad(fx_var(0).vi_); J.col(0) = x_var.adj(); for (int i = 1; i < fx_var.size(); ++i) { set_zero_all_adjoints_nested(); grad(fx_var(i).vi_); J.col(i) = x_var.adj(); } J.transposeInPlace(); } catch (const std::exception& e) { recover_memory_nested(); throw; } recover_memory_nested(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/idas_forward_system.hpp0000644000176200001440000001372713766554456026626 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_IDAS_FORWARD_SYSTEM_HPP #define STAN_MATH_REV_MAT_FUNCTOR_IDAS_FORWARD_SYSTEM_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * IDAS DAE system with forward sensitivity calculation * * @tparam F type of functor for DAE residual. * @tparam Tyy type of initial unknown values. * @tparam Typ type of initial unknown's derivative values. * @tparam Tpar type of parameters. */ template class idas_forward_system : public idas_system { N_Vector* nv_yys_; N_Vector* nv_yps_; public: /** * Construct IDAS DAE system from initial condition and parameters * * @param[in] f DAE residual functor * @param[in] eq_id array for DAE's variable ID, it is a * reference to a constant vector with 1 or 0 as member * entries. 1 for derivative variables, 0 for algebraic variables. * @param[in] yy0 initial condition * @param[in] yp0 initial condition for derivatives * @param[in] theta parameters of the base DAE * @param[in] x_r continuous data vector for the DAE * @param[in] x_i integer data vector for the DAE * @param[in] msgs stream to which messages are printed */ idas_forward_system(const F& f, const std::vector& eq_id, const std::vector& yy0, const std::vector& yp0, const std::vector& theta, const std::vector& x_r, const std::vector& x_i, std::ostream* msgs) : idas_system(f, eq_id, yy0, yp0, theta, x_r, x_i, msgs) { if (this->need_sens) { nv_yys_ = N_VCloneVectorArray(this->ns_, this->nv_yy_); nv_yps_ = N_VCloneVectorArray(this->ns_, this->nv_yp_); for (size_t is = 0; is < this->ns_; ++is) { N_VConst(RCONST(0.0), nv_yys_[is]); N_VConst(RCONST(0.0), nv_yps_[is]); } } } /** * destructor to deallocate IDAS solution memory and workspace. */ ~idas_forward_system() { if (this->need_sens) { N_VDestroyVectorArray_Serial(this->nv_yys_, this->ns_); N_VDestroyVectorArray_Serial(this->nv_yps_, this->ns_); } } /** * return N_Vector pointer array of sensitivity */ N_Vector* nv_yys() { return nv_yys_; } /** * return N_Vector pointer array of sensitivity time derivative */ N_Vector* nv_yps() { return nv_yps_; } /** * convert to void pointer for IDAS callbacks */ void* to_user_data() { // prepare to inject DAE info return static_cast(this); } /** * return a lambda for sensitivity residual callback. */ IDASensResFn sensitivity_residual() const { return [](int ns, double t, N_Vector yy, N_Vector yp, N_Vector res, N_Vector* yys, N_Vector* yps, N_Vector* ress, void* user_data, N_Vector temp1, N_Vector temp2, N_Vector temp3) { using Eigen::Matrix; using Eigen::MatrixXd; using Eigen::VectorXd; using Eigen::Dynamic; using DAE = idas_forward_system; DAE* dae = static_cast(user_data); static const char* caller = "sensitivity_residual"; check_greater(caller, "number of parameters", ns, 0); const size_t& N = dae->N_; const size_t& M = dae->M_; Eigen::Map vec_yy(N_VGetArrayPointer(yy), N); Eigen::Map vec_yp(N_VGetArrayPointer(yp), N); std::vector vyy(vec_yy.data(), vec_yy.data() + N); std::vector vyp(vec_yp.data(), vec_yp.data() + N); std::vector vtheta = value_of(dae->theta()); std::vector vpar = value_of(dae->theta_); Eigen::Map vec_par(vpar.data(), vpar.size()); auto yys_mat = matrix_d_from_NVarray(yys, ns); auto yps_mat = matrix_d_from_NVarray(yps, ns); try { stan::math::start_nested(); MatrixXd J, r; VectorXd f_val; auto fyy = [&t, &vyp, &vtheta, &N, &dae](const matrix_v& x) -> vector_v { std::vector yy(x.data(), x.data() + N); auto eval = dae->f_(t, yy, vyp, vtheta, dae->x_r_, dae->x_i_, dae->msgs_); Eigen::Map res(eval.data(), N); return res; }; stan::math::jacobian(fyy, vec_yy, f_val, J); r = J * yys_mat; auto fyp = [&t, &vyy, &vtheta, &N, &dae](const matrix_v& x) -> vector_v { std::vector yp(x.data(), x.data() + N); auto eval = dae->f_(t, vyy, yp, vtheta, dae->x_r_, dae->x_i_, dae->msgs_); Eigen::Map res(eval.data(), N); return res; }; stan::math::jacobian(fyp, vec_yp, f_val, J); r += J * yps_mat; if (dae->is_var_par) { auto fpar = [&t, &vyy, &vyp, &N, &M, &dae](const matrix_v& x) -> vector_v { std::vector par(x.data(), x.data() + M); auto eval = dae->f_(t, vyy, vyp, par, dae->x_r_, dae->x_i_, dae->msgs_); Eigen::Map res(eval.data(), N); return res; }; stan::math::jacobian(fpar, vec_par, f_val, J); r.block(0, (dae->is_var_yy0 ? N : 0) + (dae->is_var_yp0 ? N : 0), N, M) += J; // only for theta } matrix_d_to_NVarray(r, ress, ns); } catch (const std::exception& e) { stan::math::recover_memory_nested(); throw; } stan::math::recover_memory_nested(); return 0; }; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/mat/functor/gradient.hpp0000644000176200001440000000330213766554456024337 0ustar liggesusers#ifndef STAN_MATH_REV_MAT_FUNCTOR_GRADIENT_HPP #define STAN_MATH_REV_MAT_FUNCTOR_GRADIENT_HPP #include #include #include #include namespace stan { namespace math { /** * Calculate the value and the gradient of the specified function * at the specified argument. * *

The functor must implement * * * var * operator()(const * Eigen::Matrix&) * * * using only operations that are defined for * var. This latter constraint usually * requires the functions to be defined in terms of the libraries * defined in Stan or in terms of functions with appropriately * general namespace imports that eventually depend on functions * defined in Stan. * *

Time and memory usage is on the order of the size of the * fully unfolded expression for the function applied to the * argument, independently of dimension. * * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] grad_fx Gradient of function at argument */ template void gradient(const F& f, const Eigen::Matrix& x, double& fx, Eigen::Matrix& grad_fx) { start_nested(); try { Eigen::Matrix x_var(x); var fx_var = f(x_var); fx = fx_var.val(); grad_fx.resize(x.size()); grad(fx_var.vi_); grad_fx = x_var.adj(); } catch (const std::exception& /*e*/) { recover_memory_nested(); throw; } recover_memory_nested(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/arr/0000755000176200001440000000000013766604372020347 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/arr/fun/0000755000176200001440000000000013766554456021146 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/arr/fun/sum.hpp0000644000176200001440000000251113766554456022462 0ustar liggesusers#ifndef STAN_MATH_REV_ARR_FUN_SUM_HPP #define STAN_MATH_REV_ARR_FUN_SUM_HPP #include #include namespace stan { namespace math { /** * Class for sums of variables constructed with standard vectors. * There's an extension for Eigen matrices. */ class sum_v_vari : public vari { protected: vari** v_; size_t length_; inline static double sum_of_val(const std::vector& v) { double result = 0; for (auto x : v) { result += x.val(); } return result; } public: explicit sum_v_vari(double value, vari** v, size_t length) : vari(value), v_(v), length_(length) {} explicit sum_v_vari(const std::vector& v1) : vari(sum_of_val(v1)), v_(reinterpret_cast(ChainableStack::instance_->memalloc_.alloc( v1.size() * sizeof(vari*)))), length_(v1.size()) { for (size_t i = 0; i < length_; i++) { v_[i] = v1[i].vi_; } } virtual void chain() { for (size_t i = 0; i < length_; i++) { v_[i]->adj_ += adj_; } } }; /** * Returns the sum of the entries of the specified vector. * * @param m Vector. * @return Sum of vector entries. */ inline var sum(const std::vector& m) { if (m.empty()) { return 0.0; } return var(new sum_v_vari(m)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/arr/fun/to_var.hpp0000644000176200001440000000227013766554456023152 0ustar liggesusers#ifndef STAN_MATH_REV_ARR_FUN_TO_VAR_HPP #define STAN_MATH_REV_ARR_FUN_TO_VAR_HPP #include #include #include namespace stan { namespace math { /** * Converts argument to an automatic differentiation variable. * * Returns a var variable with the input value. * * @param[in] v A std::vector * @return A std::vector with the values set */ inline std::vector to_var(const std::vector& v) { std::vector var_vector(v.size()); for (size_t n = 0; n < v.size(); n++) { var_vector[n] = v[n]; } return var_vector; } /** * Specialization of to_var to for const input vector of var * * Returns a var variable from the input * * @param[in] v A std::vector * @return The input std::vector */ inline const std::vector& to_var(const std::vector& v) { return v; } /** * Specialization of to_var to for non-const input vector of var * * Returns a var variable from the input * * @param[in] v A std::vector * @return The input std::vector */ inline std::vector& to_var(std::vector& v) { return v; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/arr/fun/log_sum_exp.hpp0000644000176200001440000000250613766554456024203 0ustar liggesusers#ifndef STAN_MATH_REV_ARR_FUN_LOG_SUM_EXP_HPP #define STAN_MATH_REV_ARR_FUN_LOG_SUM_EXP_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { inline double log_sum_exp_as_double(const std::vector& x) { using std::exp; using std::log; using std::numeric_limits; double max = -numeric_limits::infinity(); for (size_t i = 0; i < x.size(); ++i) { if (x[i] > max) { max = x[i].val(); } } double sum = 0.0; for (size_t i = 0; i < x.size(); ++i) { if (x[i] != -numeric_limits::infinity()) { sum += exp(x[i].val() - max); } } return max + log(sum); } class log_sum_exp_vector_vari : public op_vector_vari { public: explicit log_sum_exp_vector_vari(const std::vector& x) : op_vector_vari(log_sum_exp_as_double(x), x) {} void chain() { for (size_t i = 0; i < size_; ++i) { vis_[i]->adj_ += adj_ * calculate_chain(vis_[i]->val_, val_); } } }; } // namespace internal /** * Returns the log sum of exponentials. */ inline var log_sum_exp(const std::vector& x) { return var(new internal::log_sum_exp_vector_vari(x)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/arr/functor/0000755000176200001440000000000013766554456022036 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/arr/functor/coupled_ode_system.hpp0000644000176200001440000004460313766554456026444 0ustar liggesusers#ifndef STAN_MATH_REV_ARR_FUNCTOR_COUPLED_ODE_SYSTEM_HPP #define STAN_MATH_REV_ARR_FUNCTOR_COUPLED_ODE_SYSTEM_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * The coupled_ode_system template specialization * for known initial values and unknown parameters. * *

This coupled ode system has N + N * M states where N is the size of * the base ode system and M is the number of parameters. * *

For the coupled ode system, the first N states are the base * system's states: \f$ \frac{d x_n}{dt} \f$. * *

The next M states correspond to the sensitivities of the * parameters with respect to the first base system equation: * \f[ * \frac{d x_{N + m}}{dt} * = \frac{d}{dt} \frac{\partial x_1}{\partial \theta_m} * \f] * for \f$ m \in {1, \ldots, M} \f$]. * *

The next M states correspond to the sensitivites with respect * to the second base system equation, and so on through the last base * system equation. * *

Note: Calculating the sensitivity system requires the Jacobian * of the base ODE RHS wrt to the parameters theta. The parameter * vector theta is constant for successive calls to the exposed * operator(). For this reason, the parameter vector theta is copied * upon construction onto the nochain var autodiff tape which is used * in the the nested autodiff performed in the operator() of this * adaptor. Doing so reduces the size of the nested autodiff and * speeds up autodiff. As a side effect, the parameter vector theta * will remain on the nochain autodiff part of the autodiff tape being * in use even after destruction of the given instance. Moreover, the * adjoint zeroing for the nested system does not cover the theta * parameter vector part of the nochain autodiff tape and is therefore * set to zero using a dedicated loop. * * @tparam F base ode system functor. Must provide * operator()(double t, std::vector y, std::vector theta, * std::vector x, std::vectorx_int, std::ostream* * msgs) */ template struct coupled_ode_system { const F& f_; const std::vector& y0_dbl_; const std::vector& theta_; std::vector theta_nochain_; const std::vector& x_; const std::vector& x_int_; const size_t N_; const size_t M_; const size_t size_; std::ostream* msgs_; /** * Construct a coupled ode system from the base system function, * initial state of the base system, parameters, and a stream for * messages. * * @param[in] f the base ODE system functor * @param[in] y0 the initial state of the base ode * @param[in] theta parameters of the base ode * @param[in] x real data * @param[in] x_int integer data * @param[in, out] msgs stream for messages */ coupled_ode_system(const F& f, const std::vector& y0, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs) : f_(f), y0_dbl_(y0), theta_(theta), x_(x), x_int_(x_int), N_(y0.size()), M_(theta.size()), size_(N_ + N_ * M_), msgs_(msgs) { for (const var& p : theta) { theta_nochain_.emplace_back(var(new vari(p.val(), false))); } } /** * Calculates the derivative of the coupled ode system with respect * to time. * * This method uses nested autodiff and is not thread safe. * * @param[in] z state of the coupled ode system; this must be size * size() * @param[out] dz_dt a vector of size size() with the * derivatives of the coupled system with respect to time * @param[in] t time * @throw exception if the base ode function does not return the * expected number of derivatives, N. */ void operator()(const std::vector& z, std::vector& dz_dt, double t) const { using std::vector; try { start_nested(); const vector y_vars(z.begin(), z.begin() + N_); vector dy_dt_vars = f_(t, y_vars, theta_nochain_, x_, x_int_, msgs_); check_size_match("coupled_ode_system", "dz_dt", dy_dt_vars.size(), "states", N_); for (size_t i = 0; i < N_; i++) { dz_dt[i] = dy_dt_vars[i].val(); dy_dt_vars[i].grad(); for (size_t j = 0; j < M_; j++) { // orders derivatives by equation (i.e. if there are 2 eqns // (y1, y2) and 2 parameters (a, b), dy_dt will be ordered as: // dy1_dt, dy2_dt, dy1_da, dy2_da, dy1_db, dy2_db double temp_deriv = theta_nochain_[j].adj(); const size_t offset = N_ + N_ * j; for (size_t k = 0; k < N_; k++) { temp_deriv += z[offset + k] * y_vars[k].adj(); } dz_dt[offset + i] = temp_deriv; } set_zero_all_adjoints_nested(); // Parameters stored on the outer (non-nested) nochain stack are not // reset to zero by the last call. This is done as a separate step here. // See efficiency note above on template specalization for more details // on this. for (size_t j = 0; j < M_; ++j) { theta_nochain_[j].vi_->set_zero_adjoint(); } } } catch (const std::exception& e) { recover_memory_nested(); throw; } recover_memory_nested(); } /** * Returns the size of the coupled system. * * @return size of the coupled system. */ size_t size() const { return size_; } /** * Returns the initial state of the coupled system. * * The initial state of the coupled ode system is the same * as the base ode system. This is because the initial values * are known. * * There are N + N * M coupled states, where N is the number of base * ode system states and M is the number of parameters. The first N * correspond to the initial values provided. The next N * M states * are all 0. * * @return the initial condition of the coupled system, a vector of * size N + N * M. */ std::vector initial_state() const { std::vector state(size_, 0.0); for (size_t n = 0; n < N_; n++) { state[n] = y0_dbl_[n]; } return state; } }; /** * The coupled_ode_system template specialization * for unknown initial values and known parameters. * *

This coupled ode system has N + N * N states where N is the size * of the base ode system. * *

For the coupled ode system, the first N states are the base * system's states: \f$ \frac{d x_n}{dt} \f$. * *

The next N states correspond to the sensitivities of the * initial conditions with respect to the first base system equation: * \f[ * \frac{d x_{N + n}}{dt} * = \frac{d}{dt} \frac{\partial x_1}{\partial y0_m} * \f] * for \f$ n \in {1, \ldots, N} \f$]. * *

The next N states correspond to the sensitivites with respect * to the second base system equation, and so on through the last base * system equation. * * @tparam F base ode system functor. Must provide * operator()(double t, std::vector y, std::vector theta, * std::vector x, std::vectorx_int, std::ostream* * msgs) */ template struct coupled_ode_system { const F& f_; const std::vector& y0_; const std::vector& theta_dbl_; const std::vector& x_; const std::vector& x_int_; std::ostream* msgs_; const size_t N_; const size_t M_; const size_t size_; /** * Construct a coupled ode system from the base system function, * initial state of the base system, parameters, and a stream for * messages. * * @param[in] f the base ODE system functor * @param[in] y0 the initial state of the base ode * @param[in] theta parameters of the base ode * @param[in] x real data * @param[in] x_int integer data * @param[in, out] msgs stream for messages */ coupled_ode_system(const F& f, const std::vector& y0, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs) : f_(f), y0_(y0), theta_dbl_(theta), x_(x), x_int_(x_int), msgs_(msgs), N_(y0.size()), M_(theta.size()), size_(N_ + N_ * N_) {} /** * Calculates the derivative of the coupled ode system with respect * to time. * * This method uses nested autodiff and is not thread safe. * * @param[in] z state of the coupled ode syste; this must be * size size() * @param[out] dz_dt a vector of length size() with the * derivatives of the coupled system with respect to time * @param[in] t time * @throw exception if the base ode function does not return the * expected number of derivatives, N. */ void operator()(const std::vector& z, std::vector& dz_dt, double t) const { using std::vector; try { start_nested(); const vector y_vars(z.begin(), z.begin() + N_); vector dy_dt_vars = f_(t, y_vars, theta_dbl_, x_, x_int_, msgs_); check_size_match("coupled_ode_system", "dz_dt", dy_dt_vars.size(), "states", N_); for (size_t i = 0; i < N_; i++) { dz_dt[i] = dy_dt_vars[i].val(); dy_dt_vars[i].grad(); for (size_t j = 0; j < N_; j++) { // orders derivatives by equation (i.e. if there are 2 eqns // (y1, y2) and 2 initial conditions (y0_a, y0_b), dy_dt will be // ordered as: dy1_dt, dy2_dt, dy1_d{y0_a}, dy2_d{y0_a}, dy1_d{y0_b}, // dy2_d{y0_b} double temp_deriv = 0; const size_t offset = N_ + N_ * j; for (size_t k = 0; k < N_; k++) { temp_deriv += z[offset + k] * y_vars[k].adj(); } dz_dt[offset + i] = temp_deriv; } set_zero_all_adjoints_nested(); } } catch (const std::exception& e) { recover_memory_nested(); throw; } recover_memory_nested(); } /** * Returns the size of the coupled system. * * @return size of the coupled system. */ size_t size() const { return size_; } /** * Returns the initial state of the coupled system. * *

Because the starting state is unknown, the coupled system * incorporates the initial conditions as parameters. At the initial * time the Jacobian of the integrated function is the identity matrix. * * @return the initial condition of the coupled system. * This is a vector of length size() where the first N values are * the initial condition of the base ODE and the remainder * correspond to the identity matrix which is the Jacobian of the * integrated function at the initial time-point. */ std::vector initial_state() const { std::vector initial(size_, 0.0); for (size_t i = 0; i < N_; i++) { initial[i] = value_of(y0_[i]); } for (size_t i = 0; i < N_; i++) { initial[N_ + i * N_ + i] = 1.0; } return initial; } }; /** * The coupled_ode_system template specialization * for unknown initial values and unknown parameters. * *

This coupled ode system has N + (N + M) * N states where N is * the size of the base ode system and M is the number of parameters. * *

For the coupled ode system, the first N states are the base * system's states: \f$ \frac{d x_n}{dt} \f$. * *

The next N + M states correspond to the sensitivities of the * initial conditions, then to the sensitivities of the parameters * with respect to the to the first base system equation: * * \f[ * \frac{d x_{N + n}}{dt} * = \frac{d}{dt} \frac{\partial x_1}{\partial y0_n} * \f] * * \f[ * \frac{d x_{N + N + m}}{dt} * = \frac{d}{dt} \frac{\partial x_1}{\partial \theta_m} * \f] * *

The next N + M states correspond to the sensitivities * of the initial conditions followed by the sensitivites of the * parameters with respect to the second base system equation, and * so on through the last base system equation. * *

Note: Calculating the sensitivity system requires the Jacobian * of the base ODE RHS wrt to the parameters theta. The parameter * vector theta is constant for successive calls to the exposed * operator(). For this reason, the parameter vector theta is copied * upon construction onto the nochain var autodiff tape which is used * in the the nested autodiff performed in the operator() of this * adaptor. Doing so reduces the size of the nested autodiff and * speeds up autodiff. As a side effect, the parameter vector theta * will remain on the nochain autodiff part of the autodiff tape being * in use even after destruction of the given instance. Moreover, the * adjoint zeroing for the nested system does not cover the theta * parameter vector part of the nochain autodiff tape and is therefore * set to zero using a dedicated loop. * * @tparam F base ode system functor. Must provide * operator()(double t, std::vector y, std::vector theta, * std::vector x, std::vectorx_int, std::ostream* * msgs) */ template struct coupled_ode_system { const F& f_; const std::vector& y0_; const std::vector& theta_; std::vector theta_nochain_; const std::vector& x_; const std::vector& x_int_; const size_t N_; const size_t M_; const size_t size_; std::ostream* msgs_; /** * Construct a coupled ode system from the base system function, * initial state of the base system, parameters, and a stream for * messages. * * @param[in] f the base ODE system functor * @param[in] y0 the initial state of the base ode * @param[in] theta parameters of the base ode * @param[in] x real data * @param[in] x_int integer data * @param[in, out] msgs stream for messages */ coupled_ode_system(const F& f, const std::vector& y0, const std::vector& theta, const std::vector& x, const std::vector& x_int, std::ostream* msgs) : f_(f), y0_(y0), theta_(theta), x_(x), x_int_(x_int), N_(y0.size()), M_(theta.size()), size_(N_ + N_ * (N_ + M_)), msgs_(msgs) { for (const var& p : theta) { theta_nochain_.emplace_back(var(new vari(p.val(), false))); } } /** * Calculates the derivative of the coupled ode system with respect * to time. * * This method uses nested autodiff and is not thread safe. * * @param[in] z state of the coupled ode system; this must be size * size() * @param[out] dz_dt a vector of size size() with the * derivatives of the coupled system with respect to time * @param[in] t time * @throw exception if the base ode function does not return the * expected number of derivatives, N. */ void operator()(const std::vector& z, std::vector& dz_dt, double t) const { using std::vector; try { start_nested(); const vector y_vars(z.begin(), z.begin() + N_); vector dy_dt_vars = f_(t, y_vars, theta_nochain_, x_, x_int_, msgs_); check_size_match("coupled_ode_system", "dz_dt", dy_dt_vars.size(), "states", N_); for (size_t i = 0; i < N_; i++) { dz_dt[i] = dy_dt_vars[i].val(); dy_dt_vars[i].grad(); for (size_t j = 0; j < N_; j++) { // orders derivatives by equation (i.e. if there are 2 eqns // (y1, y2) and 2 parameters (a, b), dy_dt will be ordered as: // dy1_dt, dy2_dt, dy1_da, dy2_da, dy1_db, dy2_db double temp_deriv = 0; const size_t offset = N_ + N_ * j; for (size_t k = 0; k < N_; k++) { temp_deriv += z[offset + k] * y_vars[k].adj(); } dz_dt[offset + i] = temp_deriv; } for (size_t j = 0; j < M_; j++) { double temp_deriv = theta_nochain_[j].adj(); const size_t offset = N_ + N_ * N_ + N_ * j; for (size_t k = 0; k < N_; k++) { temp_deriv += z[offset + k] * y_vars[k].adj(); } dz_dt[offset + i] = temp_deriv; } set_zero_all_adjoints_nested(); // Parameters stored on the outer (non-nested) nochain stack are not // reset to zero by the last call. This is done as a separate step here. // See efficiency note above on template specalization for more details // on this. for (size_t j = 0; j < M_; ++j) { theta_nochain_[j].vi_->set_zero_adjoint(); } } } catch (const std::exception& e) { recover_memory_nested(); throw; } recover_memory_nested(); } /** * Returns the size of the coupled system. * * @return size of the coupled system. */ size_t size() const { return size_; } /** * Returns the initial state of the coupled system. * *

Because the starting state is unknown, the coupled system * incorporates the initial conditions as parameters. At the initial * time the Jacobian of the integrated function is the identity * matrix. In addition the coupled system includes the Jacobian of * the integrated function wrt to the parameters. This Jacobian is * zero at the initial time-point. * * @return the initial condition of the coupled system. This is a * vector of length size() where the first N values are the * initial condition of the base ODE and the next N*N elements * correspond to the identity matrix which is the Jacobian of the * integrated function at the initial time-point. The last N*M * elements are all zero as these are the Jacobian wrt to the * parameters at the initial time-point, which is zero. */ std::vector initial_state() const { std::vector initial(size_, 0.0); for (size_t i = 0; i < N_; i++) { initial[i] = value_of(y0_[i]); } for (size_t i = 0; i < N_; i++) { initial[N_ + i * N_ + i] = 1.0; } return initial; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/arr/functor/integrate_1d.hpp0000644000176200001440000001456213766554456025125 0ustar liggesusers#ifndef STAN_MATH_REV_ARR_FUNCTOR_integrate_1d_HPP #define STAN_MATH_REV_ARR_FUNCTOR_integrate_1d_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Calculate first derivative of f(x, param, std::ostream&) * with respect to the nth parameter. Uses nested reverse mode autodiff * * Gradients that evaluate to NaN are set to zero if the function itself * evaluates to zero. If the function is not zero and the gradient evaluates to * NaN, a std::domain_error is thrown */ template inline double gradient_of_f(const F &f, const double &x, const double &xc, const std::vector &theta_vals, const std::vector &x_r, const std::vector &x_i, size_t n, std::ostream &msgs) { double gradient = 0.0; start_nested(); std::vector theta_var(theta_vals.size()); try { for (size_t i = 0; i < theta_vals.size(); i++) { theta_var[i] = theta_vals[i]; } var fx = f(x, xc, theta_var, x_r, x_i, &msgs); fx.grad(); gradient = theta_var[n].adj(); if (is_nan(gradient)) { if (fx.val() == 0) { gradient = 0; } else { domain_error("gradient_of_f", "The gradient of f", n, "is nan for parameter ", ""); } } } catch (const std::exception &e) { recover_memory_nested(); throw; } recover_memory_nested(); return gradient; } /** * Compute the integral of the single variable function f from a to b to within * a specified relative tolerance. a and b can be finite or infinite. * * f should be compatible with reverse mode autodiff and have the signature: * var f(double x, double xc, const std::vector& theta, * const std::vector& x_r, const std::vector &x_i, * std::ostream* msgs) * * It should return the value of the function evaluated at x. Any errors * should be printed to the msgs stream. * * Integrals that cross zero are broken into two, and the separate integrals are * each integrated to the given relative tolerance. * * For integrals with finite limits, the xc argument is the distance to the * nearest boundary. So for a > 0, b > 0, it will be a - x for x closer to a, * and b - x for x closer to b. xc is computed in a way that avoids the * precision loss of computing a - x or b - x manually. For integrals that cross * zero, xc can take values a - x, -x, or b - x depending on which integration * limit it is nearest. * * If either limit is infinite, xc is set to NaN * * The integration algorithm terminates when * \f[ * \frac{{|I_{n + 1} - I_n|}}{{|I|_{n + 1}}} < \text{relative tolerance} * \f] * where \f$I_{n}\f$ is the nth estimate of the integral and \f$|I|_{n}\f$ is * the nth estimate of the norm of the integral. * * Integrals that cross zero are * split into two. In this case, each integral is separately integrated to the * given relative_tolerance. * * Gradients of f that evaluate to NaN when the function evaluates to zero are * set to zero themselves. This is due to the autodiff easily overflowing to NaN * when evaluating gradients near the maximum and minimum floating point values * (where the function should be zero anyway for the integral to exist) * * @tparam T_a type of first limit * @tparam T_b type of second limit * @tparam T_theta type of parameters * @tparam T Type of f * @param f the functor to integrate * @param a lower limit of integration * @param b upper limit of integration * @param theta additional parameters to be passed to f * @param x_r additional data to be passed to f * @param x_i additional integer data to be passed to f * @param[in, out] msgs the print stream for warning messages * @param relative_tolerance relative tolerance passed to Boost quadrature * @return numeric integral of function f */ template > inline return_type_t integrate_1d( const F &f, const T_a &a, const T_b &b, const std::vector &theta, const std::vector &x_r, const std::vector &x_i, std::ostream &msgs, const double relative_tolerance = std::sqrt(std::numeric_limits::epsilon())) { static const char *function = "integrate_1d"; check_less_or_equal(function, "lower limit", a, b); if (value_of(a) == value_of(b)) { if (is_inf(a)) { domain_error(function, "Integration endpoints are both", value_of(a), "", ""); } return var(0.0); } else { double integral = integrate( std::bind(f, std::placeholders::_1, std::placeholders::_2, value_of(theta), x_r, x_i, &msgs), value_of(a), value_of(b), relative_tolerance); size_t N_theta_vars = is_var::value ? theta.size() : 0; std::vector dintegral_dtheta(N_theta_vars); std::vector theta_concat(N_theta_vars); if (N_theta_vars > 0) { std::vector theta_vals = value_of(theta); for (size_t n = 0; n < N_theta_vars; ++n) { dintegral_dtheta[n] = integrate( std::bind(gradient_of_f, f, std::placeholders::_1, std::placeholders::_2, theta_vals, x_r, x_i, n, std::ref(msgs)), value_of(a), value_of(b), relative_tolerance); theta_concat[n] = theta[n]; } } if (!is_inf(a) && is_var::value) { theta_concat.push_back(a); dintegral_dtheta.push_back( -value_of(f(value_of(a), 0.0, theta, x_r, x_i, &msgs))); } if (!is_inf(b) && is_var::value) { theta_concat.push_back(b); dintegral_dtheta.push_back( value_of(f(value_of(b), 0.0, theta, x_r, x_i, &msgs))); } return precomputed_gradients(integral, theta_concat, dintegral_dtheta); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/0000755000176200001440000000000013766604372020505 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/scal/fun/0000755000176200001440000000000013766554456021304 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/scal/fun/bessel_second_kind.hpp0000644000176200001440000000152513766554456025635 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BESSEL_SECOND_KIND_HPP #define STAN_MATH_REV_SCAL_FUN_BESSEL_SECOND_KIND_HPP #include #include #include namespace stan { namespace math { namespace internal { class bessel_second_kind_dv_vari : public op_dv_vari { public: bessel_second_kind_dv_vari(int a, vari* bvi) : op_dv_vari(bessel_second_kind(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ += adj_ * (ad_ * bessel_second_kind(ad_, bvi_->val_) / bvi_->val_ - bessel_second_kind(ad_ + 1, bvi_->val_)); } }; } // namespace internal inline var bessel_second_kind(int v, const var& a) { return var(new internal::bessel_second_kind_dv_vari(v, a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_inv_logit.hpp0000644000176200001440000000127413766554456024654 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_INV_LOGIT_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_INV_LOGIT_HPP #include #include #include #include #include namespace stan { namespace math { /** * Return the natural logarithm of the inverse logit of the * specified argument. * * @param u argument * @return log inverse logit of the argument */ inline var log_inv_logit(const var& u) { return var( new precomp_v_vari(log_inv_logit(u.val()), u.vi_, inv_logit(-u.val()))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/ceil.hpp0000644000176200001440000000322213766554456022730 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_CEIL_HPP #define STAN_MATH_REV_SCAL_FUN_CEIL_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class ceil_vari : public op_v_vari { public: explicit ceil_vari(vari* avi) : op_v_vari(std::ceil(avi->val_), avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } } }; } // namespace internal /** * Return the ceiling of the specified variable (cmath). * * The derivative of the ceiling function is defined and * zero everywhere but at integers, and we set them to zero for * convenience, * * \f$\frac{d}{dx} {\lceil x \rceil} = 0\f$. * * The ceiling function rounds up. For double values, this is the * smallest integral value that is not less than the specified * value. Although this function is not differentiable because it * is discontinuous at integral values, its gradient is returned * as zero everywhere. * \f[ \mbox{ceil}(x) = \begin{cases} \lceil x\rceil & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{ceil}(x)}{\partial x} = \begin{cases} 0 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Input variable. * @return Ceiling of the variable. */ inline var ceil(const var& a) { return var(new internal::ceil_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/tan.hpp0000644000176200001440000000221213766554456022574 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_TAN_HPP #define STAN_MATH_REV_SCAL_FUN_TAN_HPP #include #include #include namespace stan { namespace math { namespace internal { class tan_vari : public op_v_vari { public: explicit tan_vari(vari* avi) : op_v_vari(std::tan(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * (1.0 + val_ * val_); } }; } // namespace internal /** * Return the tangent of a radian-scaled variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \tan x = \sec^2 x\f$. * * \f[ \mbox{tan}(x) = \begin{cases} \tan(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{tan}(x)}{\partial x} = \begin{cases} \sec^2(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable for radians of angle. * @return Tangent of variable. */ inline var tan(const var& a) { return var(new internal::tan_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log1p.hpp0000644000176200001440000000144713766554456023045 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG1P_HPP #define STAN_MATH_REV_SCAL_FUN_LOG1P_HPP #include #include #include namespace stan { namespace math { namespace internal { class log1p_vari : public op_v_vari { public: explicit log1p_vari(vari* avi) : op_v_vari(log1p(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (1 + avi_->val_); } }; } // namespace internal /** * The log (1 + x) function for variables (C99). * * The derivative is given by * * \f$\frac{d}{dx} \log (1 + x) = \frac{1}{1 + x}\f$. * * @param a The variable. * @return The log of 1 plus the variable. */ inline var log1p(const var& a) { return var(new internal::log1p_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log1p_exp.hpp0000644000176200001440000000141513766554456023714 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG1P_EXP_HPP #define STAN_MATH_REV_SCAL_FUN_LOG1P_EXP_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class log1p_exp_v_vari : public op_v_vari { public: explicit log1p_exp_v_vari(vari* avi) : op_v_vari(log1p_exp(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * calculate_chain(avi_->val_, val_); } }; } // namespace internal /** * Return the log of 1 plus the exponential of the specified * variable. */ inline var log1p_exp(const var& a) { return var(new internal::log1p_exp_v_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log1m_inv_logit.hpp0000644000176200001440000000134113766554456025105 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG1M_INV_LOGIT_HPP #define STAN_MATH_REV_SCAL_FUN_LOG1M_INV_LOGIT_HPP #include #include #include #include #include namespace stan { namespace math { /** * Return the natural logarithm of one minus the inverse logit of * the specified argument. * * @param u argument * @return log of one minus the inverse logit of the argument */ inline var log1m_inv_logit(const var& u) { return var( new precomp_v_vari(log1m_inv_logit(u.val()), u.vi_, -inv_logit(u.val()))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_inv_logit_diff.hpp0000644000176200001440000000470013766554456025641 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_INV_LOGIT_DIFF_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_INV_LOGIT_DIFF_HPP #include #include #include #include #include #include namespace stan { namespace math { /* * Returns the natural logarithm of the difference of the * inverse logits of the specified arguments and its gradients. * \f[ \mathrm{log\_inv\_logit\_diff}(x,y) = \ln\left(\frac{1}{1+\exp(-x)}-\frac{1}{1+\exp(-y)}\right) \f] \f[ \frac{\partial }{\partial x} = -\frac{e^x}{e^y-e^x}-\frac{e^x}{e^x+1} \f] \f[ \frac{\partial }{\partial x} = -\frac{e^y}{e^x-e^y}-\frac{e^y}{e^y+1} \f] * * @tparam T1 Type of x argument * @tparam T2 Type of y argument * @param a Argument * @param b Argument * @return Result of log difference of inverse logits of arguments * and gradients */ namespace internal { class log_inv_logit_diff_vv_vari : public op_vv_vari { public: log_inv_logit_diff_vv_vari(vari* avi, vari* bvi) : op_vv_vari(log_inv_logit_diff(avi->val_, bvi->val_), avi, bvi) {} void chain() { avi_->adj_ -= adj_ * (inv(expm1(bvi_->val_ - avi_->val_)) + inv_logit(avi_->val_)); bvi_->adj_ -= adj_ * (inv(expm1(avi_->val_ - bvi_->val_)) + inv_logit(bvi_->val_)); } }; class log_inv_logit_diff_vd_vari : public op_vd_vari { public: log_inv_logit_diff_vd_vari(vari* avi, double b) : op_vd_vari(log_inv_logit_diff(avi->val_, b), avi, b) {} void chain() { avi_->adj_ -= adj_ * (inv(expm1(bd_ - avi_->val_)) + inv_logit(avi_->val_)); } }; class log_inv_logit_diff_dv_vari : public op_dv_vari { public: log_inv_logit_diff_dv_vari(double a, vari* bvi) : op_dv_vari(log_inv_logit_diff(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ -= adj_ * (inv(expm1(ad_ - bvi_->val_)) + inv_logit(bvi_->val_)); } }; } // namespace internal inline var log_inv_logit_diff(const var& a, double b) { return var(new internal::log_inv_logit_diff_vd_vari(a.vi_, b)); } inline var log_inv_logit_diff(const var& a, const var& b) { return var(new internal::log_inv_logit_diff_vv_vari(a.vi_, b.vi_)); } inline var log_inv_logit_diff(double a, const var& b) { return var(new internal::log_inv_logit_diff_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/tgamma.hpp0000644000176200001440000000325313766554456023266 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_TGAMMA_HPP #define STAN_MATH_REV_SCAL_FUN_TGAMMA_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class tgamma_vari : public op_v_vari { public: explicit tgamma_vari(vari* avi) : op_v_vari(tgamma(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * val_ * digamma(avi_->val_); } }; } // namespace internal /** * Return the Gamma function applied to the specified variable (C99). * * The derivative with respect to the argument is * * \f$\frac{d}{dx} \Gamma(x) = \Gamma(x) \Psi^{(0)}(x)\f$ * * where \f$\Psi^{(0)}(x)\f$ is the digamma function. * \f[ \mbox{tgamma}(x) = \begin{cases} \textrm{error} & \mbox{if } x\in \{\dots, -3, -2, -1, 0\}\\ \Gamma(x) & \mbox{if } x\not\in \{\dots, -3, -2, -1, 0\}\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{tgamma}(x)}{\partial x} = \begin{cases} \textrm{error} & \mbox{if } x\in \{\dots, -3, -2, -1, 0\}\\ \frac{\partial\, \Gamma(x)}{\partial x} & \mbox{if } x\not\in \{\dots, -3, -2, -1, 0\}\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \Gamma(x)=\int_0^{\infty} u^{x - 1} \exp(-u) \, du \f] \f[ \frac{\partial \, \Gamma(x)}{\partial x} = \Gamma(x)\Psi(x) \f] * * @param a Argument to function. * @return The Gamma function applied to the specified argument. */ inline var tgamma(const var& a) { return var(new internal::tgamma_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/as_bool.hpp0000644000176200001440000000072313766554456023435 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_AS_BOOL_HPP #define STAN_MATH_REV_SCAL_FUN_AS_BOOL_HPP #include #include namespace stan { namespace math { /** * Return 1 if the argument is unequal to zero and 0 otherwise. * * @param v Value. * @return 1 if argument is equal to zero (or NaN) and 0 otherwise. */ inline int as_bool(const var& v) { return 0.0 != v.vi_->val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/owens_t.hpp0000644000176200001440000000524713766554456023503 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_OWENS_T_HPP #define STAN_MATH_REV_SCAL_FUN_OWENS_T_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class owens_t_vv_vari : public op_vv_vari { public: owens_t_vv_vari(vari* avi, vari* bvi) : op_vv_vari(owens_t(avi->val_, bvi->val_), avi, bvi) {} void chain() { const double neg_avi_sq_div_2 = -square(avi_->val_) * 0.5; const double one_p_bvi_sq = 1.0 + square(bvi_->val_); avi_->adj_ += adj_ * erf(bvi_->val_ * avi_->val_ * INV_SQRT_2) * std::exp(neg_avi_sq_div_2) * INV_SQRT_TWO_PI * -0.5; bvi_->adj_ += adj_ * std::exp(neg_avi_sq_div_2 * one_p_bvi_sq) / (one_p_bvi_sq * 2.0 * pi()); } }; class owens_t_vd_vari : public op_vd_vari { public: owens_t_vd_vari(vari* avi, double b) : op_vd_vari(owens_t(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * erf(bd_ * avi_->val_ * INV_SQRT_2) * std::exp(-square(avi_->val_) * 0.5) * INV_SQRT_TWO_PI * -0.5; } }; class owens_t_dv_vari : public op_dv_vari { public: owens_t_dv_vari(double a, vari* bvi) : op_dv_vari(owens_t(a, bvi->val_), a, bvi) {} void chain() { const double one_p_bvi_sq = 1.0 + square(bvi_->val_); bvi_->adj_ += adj_ * std::exp(-0.5 * square(ad_) * one_p_bvi_sq) / (one_p_bvi_sq * 2.0 * pi()); } }; } // namespace internal /** * The Owen's T function of h and a. * * Used to compute the cumulative density function for the skew normal * distribution. * * @param h var parameter. * @param a var parameter. * @return The Owen's T function. */ inline var owens_t(const var& h, const var& a) { return var(new internal::owens_t_vv_vari(h.vi_, a.vi_)); } /** * The Owen's T function of h and a. * * Used to compute the cumulative density function for the skew normal * distribution. * * @param h var parameter. * @param a double parameter. * @return The Owen's T function. */ inline var owens_t(const var& h, double a) { return var(new internal::owens_t_vd_vari(h.vi_, a)); } /** * The Owen's T function of h and a. * * Used to compute the cumulative density function for the skew normal * distribution. * * @param h double parameter. * @param a var parameter. * @return The Owen's T function. */ inline var owens_t(double h, const var& a) { return var(new internal::owens_t_dv_vari(h, a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/sqrt.hpp0000644000176200001440000000227013766554456023007 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_SQRT_HPP #define STAN_MATH_REV_SCAL_FUN_SQRT_HPP #include #include #include namespace stan { namespace math { namespace internal { class sqrt_vari : public op_v_vari { public: explicit sqrt_vari(vari* avi) : op_v_vari(std::sqrt(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (2.0 * val_); } }; } // namespace internal /** * Return the square root of the specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \sqrt{x} = \frac{1}{2 \sqrt{x}}\f$. * \f[ \mbox{sqrt}(x) = \begin{cases} \textrm{NaN} & x < 0 \\ \sqrt{x} & \mbox{if } x\geq 0\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{sqrt}(x)}{\partial x} = \begin{cases} \textrm{NaN} & x < 0 \\ \frac{1}{2\sqrt{x}} & x\geq 0\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable whose square root is taken. * @return Square root of variable. */ inline var sqrt(const var& a) { return var(new internal::sqrt_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/ibeta.hpp0000644000176200001440000001571513766554456023112 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_IBETA_HPP #define STAN_MATH_REV_SCAL_FUN_IBETA_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { /** * Calculates the generalized hypergeometric 3F2(a, a, b; a + 1, a + 1; z). * * Handles negative values of b properly. */ inline double ibeta_hypergeometric_helper(double a, double b, double z, double precision = 1e-8, double max_steps = 1000) { double val = 0; double diff = 1; double k = 0; double a_2 = a * a; double bprod = 1; while (std::abs(diff) > precision && ++k < max_steps) { val += diff; bprod *= b + k - 1.0; diff = a_2 * std::pow(a + k, -2) * bprod * std::pow(z, k) / tgamma(k + 1); } return val; } class ibeta_vvv_vari : public op_vvv_vari { public: ibeta_vvv_vari(vari* avi, vari* bvi, vari* xvi) : op_vvv_vari(ibeta(avi->val_, bvi->val_, xvi->val_), avi, bvi, xvi) {} void chain() { double a = avi_->val_; double b = bvi_->val_; double c = cvi_->val_; using boost::math::constants::pi; using std::log; using std::pow; using std::sin; avi_->adj_ += adj_ * (log(c) - digamma(a) + digamma(a + b)) * val_ - tgamma(a) * tgamma(a + b) / tgamma(b) * pow(c, a) / tgamma(1 + a) / tgamma(1 + a) * ibeta_hypergeometric_helper(a, 1 - b, c); bvi_->adj_ += adj_ * (tgamma(b) * tgamma(a + b) / tgamma(a) * pow(1 - c, b) * ibeta_hypergeometric_helper(b, 1 - a, 1 - c) / tgamma(b + 1) / tgamma(b + 1) + ibeta(b, a, 1 - c) * (digamma(b) - digamma(a + b) - log(1 - c))); cvi_->adj_ += adj_ * boost::math::ibeta_derivative(a, b, c); } }; class ibeta_vvd_vari : public op_vvd_vari { public: ibeta_vvd_vari(vari* avi, vari* bvi, double x) : op_vvd_vari(ibeta(avi->val_, bvi->val_, x), avi, bvi, x) {} void chain() { double a = avi_->val_; double b = bvi_->val_; double c = cd_; using boost::math::constants::pi; using std::log; using std::pow; using std::sin; avi_->adj_ += adj_ * (log(c) - digamma(a) + digamma(a + b)) * val_ - tgamma(a) * tgamma(a + b) / tgamma(b) * pow(c, a) / tgamma(1 + a) / tgamma(1 + a) * ibeta_hypergeometric_helper(a, 1 - b, c); bvi_->adj_ += adj_ * (tgamma(b) * tgamma(a + b) / tgamma(a) * pow(1 - c, b) * ibeta_hypergeometric_helper(b, 1 - a, 1 - c) / tgamma(b + 1) / tgamma(b + 1) + ibeta(b, a, 1 - c) * (digamma(b) - digamma(a + b) - log(1 - c))); } }; class ibeta_vdv_vari : public op_vdv_vari { public: ibeta_vdv_vari(vari* avi, double b, vari* xvi) : op_vdv_vari(ibeta(avi->val_, b, xvi->val_), avi, b, xvi) {} void chain() { double a = avi_->val_; double b = bd_; double c = cvi_->val_; using boost::math::constants::pi; using boost::math::digamma; using boost::math::ibeta; using std::log; using std::pow; using std::sin; avi_->adj_ += adj_ * (log(c) - digamma(a) + digamma(a + b)) * val_ - tgamma(a) * tgamma(a + b) / tgamma(b) * pow(c, a) / tgamma(1 + a) / tgamma(1 + a) * ibeta_hypergeometric_helper(a, 1 - b, c); cvi_->adj_ += adj_ * boost::math::ibeta_derivative(a, b, c); } }; class ibeta_vdd_vari : public op_vdd_vari { public: ibeta_vdd_vari(vari* avi, double b, double x) : op_vdd_vari(ibeta(avi->val_, b, x), avi, b, x) {} void chain() { double a = avi_->val_; double b = bd_; double c = cd_; using boost::math::constants::pi; using boost::math::digamma; using boost::math::ibeta; using std::log; using std::pow; using std::sin; avi_->adj_ += adj_ * (log(c) - digamma(a) + digamma(a + b)) * val_ - tgamma(a) * tgamma(a + b) / tgamma(b) * pow(c, a) / tgamma(1 + a) / tgamma(1 + a) * ibeta_hypergeometric_helper(a, 1 - b, c); } }; class ibeta_dvv_vari : public op_dvv_vari { public: ibeta_dvv_vari(double a, vari* bvi, vari* xvi) : op_dvv_vari(ibeta(a, bvi->val_, xvi->val_), a, bvi, xvi) {} void chain() { double a = ad_; double b = bvi_->val_; double c = cvi_->val_; using boost::math::constants::pi; using boost::math::digamma; using boost::math::ibeta; using std::log; using std::pow; using std::sin; bvi_->adj_ += adj_ * (tgamma(b) * tgamma(a + b) / tgamma(a) * pow(1 - c, b) * ibeta_hypergeometric_helper(b, 1 - a, 1 - c) / tgamma(b + 1) / tgamma(b + 1) + ibeta(b, a, 1 - c) * (digamma(b) - digamma(a + b) - log(1 - c))); cvi_->adj_ += adj_ * boost::math::ibeta_derivative(a, b, c); } }; class ibeta_dvd_vari : public op_dvd_vari { public: ibeta_dvd_vari(double a, vari* bvi, double x) : op_dvd_vari(ibeta(a, bvi->val_, x), a, bvi, x) {} void chain() { double a = ad_; double b = bvi_->val_; double c = cd_; using boost::math::constants::pi; using boost::math::digamma; using boost::math::ibeta; using std::log; using std::pow; using std::sin; bvi_->adj_ += adj_ * (tgamma(b) * tgamma(a + b) / tgamma(a) * pow(1 - c, b) * ibeta_hypergeometric_helper(b, 1 - a, 1 - c) / tgamma(b + 1) / tgamma(b + 1) + ibeta(b, a, 1 - c) * (digamma(b) - digamma(a + b) - log(1 - c))); } }; class ibeta_ddv_vari : public op_ddv_vari { public: ibeta_ddv_vari(double a, double b, vari* xvi) : op_ddv_vari(ibeta(a, b, xvi->val_), a, b, xvi) {} void chain() { double a = ad_; double b = bd_; double c = cvi_->val_; cvi_->adj_ += adj_ * boost::math::ibeta_derivative(a, b, c); } }; } // namespace internal /** * The normalized incomplete beta function of a, b, and x. * * Used to compute the cumulative density function for the beta * distribution. * * Partial derivatives are those specified by wolfram alpha. * The values were checked using both finite differences and * by independent code for calculating the derivatives found * in JSS (paper by Boik and Robison-Cox). * * @param a Shape parameter. * @param b Shape parameter. * @param x Random variate. * * @return The normalized incomplete beta function. * @throws if any argument is NaN. */ inline var ibeta(const var& a, const var& b, const var& x) { return var(new internal::ibeta_vvv_vari(a.vi_, b.vi_, x.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/is_uninitialized.hpp0000644000176200001440000000134513766554456025363 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_IS_UNINITIALIZED_HPP #define STAN_MATH_REV_SCAL_FUN_IS_UNINITIALIZED_HPP #include #include #include namespace stan { namespace math { /** * Returns true if the specified variable is * uninitialized. * * This overload of the * is_uninitialized() function delegates * the return to the is_uninitialized() method on the * specified variable. * * @param x Object to test. * @return true if the specified object is uninitialized. */ inline bool is_uninitialized(var x) { return x.is_uninitialized(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/fmod.hpp0000644000176200001440000000744013766554456022747 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FMOD_HPP #define STAN_MATH_REV_SCAL_FUN_FMOD_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class fmod_vv_vari : public op_vv_vari { public: fmod_vv_vari(vari* avi, vari* bvi) : op_vv_vari(std::fmod(avi->val_, bvi->val_), avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; bvi_->adj_ -= adj_ * static_cast(avi_->val_ / bvi_->val_); } } }; class fmod_vd_vari : public op_vd_vari { public: fmod_vd_vari(vari* avi, double b) : op_vd_vari(std::fmod(avi->val_, b), avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; } } }; class fmod_dv_vari : public op_dv_vari { public: fmod_dv_vari(double a, vari* bvi) : op_dv_vari(std::fmod(a, bvi->val_), a, bvi) {} void chain() { if (unlikely(is_any_nan(bvi_->val_, ad_))) { bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { int d = static_cast(ad_ / bvi_->val_); bvi_->adj_ -= adj_ * d; } } }; } // namespace internal /** * Return the floating point remainder after dividing the * first variable by the second (cmath). * * The partial derivatives with respect to the variables are defined * everywhere but where \f$x = y\f$, but we set these to match other values, * with * * \f$\frac{\partial}{\partial x} \mbox{fmod}(x, y) = 1\f$, and * * \f$\frac{\partial}{\partial y} \mbox{fmod}(x, y) = -\lfloor \frac{x}{y} \rfloor\f$. * * \f[ \mbox{fmod}(x, y) = \begin{cases} x - \lfloor \frac{x}{y}\rfloor y & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fmod}(x, y)}{\partial x} = \begin{cases} 1 & \mbox{if } -\infty\leq x, y\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fmod}(x, y)}{\partial y} = \begin{cases} -\lfloor \frac{x}{y}\rfloor & \mbox{if } -\infty\leq x, y\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return Floating pointer remainder of dividing the first variable * by the second. */ inline var fmod(const var& a, const var& b) { return var(new internal::fmod_vv_vari(a.vi_, b.vi_)); } /** * Return the floating point remainder after dividing the * the first variable by the second scalar (cmath). * * The derivative with respect to the variable is * * \f$\frac{d}{d x} \mbox{fmod}(x, c) = \frac{1}{c}\f$. * * @param a First variable. * @param b Second scalar. * @return Floating pointer remainder of dividing the first variable by * the second scalar. */ inline var fmod(const var& a, double b) { return var(new internal::fmod_vd_vari(a.vi_, b)); } /** * Return the floating point remainder after dividing the * first scalar by the second variable (cmath). * * The derivative with respect to the variable is * * \f$\frac{d}{d y} \mbox{fmod}(c, y) = -\lfloor \frac{c}{y} \rfloor\f$. * * @param a First scalar. * @param b Second variable. * @return Floating pointer remainder of dividing first scalar by * the second variable. */ inline var fmod(double a, const var& b) { return var(new internal::fmod_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/Phi_approx.hpp0000644000176200001440000000310513766554456024125 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_PHI_APPROX_HPP #define STAN_MATH_REV_SCAL_FUN_PHI_APPROX_HPP #include #include #include namespace stan { namespace math { /** * Approximation of the unit normal CDF for variables (stan). * * http://www.jiem.org/index.php/jiem/article/download/60/27 * * \f[ \mbox{Phi\_approx}(x) = \begin{cases} \Phi_{\mbox{\footnotesize approx}}(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{Phi\_approx}(x)}{\partial x} = \begin{cases} \frac{\partial\, \Phi_{\mbox{\footnotesize approx}}(x)}{\partial x} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \Phi_{\mbox{\footnotesize approx}}(x) = \mbox{logit}^{-1}(0.07056 \, x^3 + 1.5976 \, x) \f] \f[ \frac{\partial \, \Phi_{\mbox{\footnotesize approx}}(x)}{\partial x} = -\Phi_{\mbox{\footnotesize approx}}^2(x) e^{-0.07056x^3 - 1.5976x}(-0.21168x^2-1.5976) \f] * * @param a Variable argument. * @return The corresponding unit normal cdf approximation. */ inline var Phi_approx(const var& a) { double av = a.vi_->val_; double av_squared = av * av; double av_cubed = av * av_squared; double f = inv_logit(0.07056 * av_cubed + 1.5976 * av); double da = f * (1 - f) * (3.0 * 0.07056 * av_squared + 1.5976); return var(new precomp_v_vari(f, a.vi_, da)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/cos.hpp0000644000176200001440000000221013766554456022574 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_COS_HPP #define STAN_MATH_REV_SCAL_FUN_COS_HPP #include #include #include namespace stan { namespace math { namespace internal { class cos_vari : public op_v_vari { public: explicit cos_vari(vari* avi) : op_v_vari(std::cos(avi->val_), avi) {} void chain() { avi_->adj_ -= adj_ * std::sin(avi_->val_); } }; } // namespace internal /** * Return the cosine of a radian-scaled variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \cos x = - \sin x\f$. * * \f[ \mbox{cos}(x) = \begin{cases} \cos(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{cos}(x)}{\partial x} = \begin{cases} -\sin(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable for radians of angle. * @return Cosine of variable. */ inline var cos(const var& a) { return var(new internal::cos_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/floor.hpp0000644000176200001440000000324713766554456023144 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FLOOR_HPP #define STAN_MATH_REV_SCAL_FUN_FLOOR_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class floor_vari : public op_v_vari { public: explicit floor_vari(vari* avi) : op_v_vari(std::floor(avi->val_), avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } } }; } // namespace internal /** * Return the floor of the specified variable (cmath). * * The derivative of the floor function is defined and * zero everywhere but at integers, so we set these derivatives * to zero for convenience, * * \f$\frac{d}{dx} {\lfloor x \rfloor} = 0\f$. * * The floor function rounds down. For double values, this is the largest * integral value that is not greater than the specified value. * Although this function is not differentiable because it is * discontinuous at integral values, its gradient is returned as * zero everywhere. * \f[ \mbox{floor}(x) = \begin{cases} \lfloor x \rfloor & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{floor}(x)}{\partial x} = \begin{cases} 0 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Input variable. * @return Floor of the variable. */ inline var floor(const var& a) { return var(new internal::floor_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/round.hpp0000644000176200001440000000275113766554456023151 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ROUND_HPP #define STAN_MATH_REV_SCAL_FUN_ROUND_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class round_vari : public op_v_vari { public: explicit round_vari(vari* avi) : op_v_vari(round(avi->val_), avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } } }; } // namespace internal /** * Returns the rounded form of the specified variable (C99). * * The derivative is zero everywhere but numbers half way between * whole numbers, so for convenience the derivative is defined to * be everywhere zero, * * \f$\frac{d}{dx} \mbox{round}(x) = 0\f$. * * \f[ \mbox{round}(x) = \begin{cases} \lceil x \rceil & \mbox{if } x-\lfloor x\rfloor \geq 0.5 \\ \lfloor x \rfloor & \mbox{if } x-\lfloor x\rfloor < 0.5 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{round}(x)}{\partial x} = \begin{cases} 0 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Specified variable. * @return Rounded variable. */ inline var round(const var& a) { return var(new internal::round_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/erf.hpp0000644000176200001440000000276713766554456022605 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ERF_HPP #define STAN_MATH_REV_SCAL_FUN_ERF_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class erf_vari : public op_v_vari { public: explicit erf_vari(vari* avi) : op_v_vari(erf(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * TWO_OVER_SQRT_PI * std::exp(-avi_->val_ * avi_->val_); } }; } // namespace internal /** * The error function for variables (C99). * * The derivative is * * \f$\frac{d}{dx} \mbox{erf}(x) = \frac{2}{\sqrt{\pi}} \exp(-x^2)\f$. * * \f[ \mbox{erf}(x) = \begin{cases} \operatorname{erf}(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{erf}(x)}{\partial x} = \begin{cases} \frac{\partial\, \operatorname{erf}(x)}{\partial x} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \operatorname{erf}(x)=\frac{2}{\sqrt{\pi}}\int_0^x e^{-t^2}dt \f] \f[ \frac{\partial \, \operatorname{erf}(x)}{\partial x} = \frac{2}{\sqrt{\pi}} e^{-x^2} \f] * * @param a The variable. * @return Error function applied to the variable. */ inline var erf(const var& a) { return var(new internal::erf_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/fmin.hpp0000644000176200001440000000710313766554456022747 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FMIN_HPP #define STAN_MATH_REV_SCAL_FUN_FMIN_HPP #include #include #include #include #include namespace stan { namespace math { /** * Returns the minimum of the two variable arguments (C99). * * For fmin(a, b), if a's value is less than b's, * then a is returned, otherwise b is returned. * \f[ \mbox{fmin}(x, y) = \begin{cases} x & \mbox{if } x \leq y \\ y & \mbox{if } x > y \\[6pt] x & \mbox{if } -\infty\leq x\leq \infty, y = \textrm{NaN}\\ y & \mbox{if } -\infty\leq y\leq \infty, x = \textrm{NaN}\\ \textrm{NaN} & \mbox{if } x, y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fmin}(x, y)}{\partial x} = \begin{cases} 1 & \mbox{if } x \leq y \\ 0 & \mbox{if } x > y \\[6pt] 1 & \mbox{if } -\infty\leq x\leq \infty, y = \textrm{NaN}\\ 0 & \mbox{if } -\infty\leq y\leq \infty, x = \textrm{NaN}\\ \textrm{NaN} & \mbox{if } x, y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fmin}(x, y)}{\partial y} = \begin{cases} 0 & \mbox{if } x \leq y \\ 1 & \mbox{if } x > y \\[6pt] 0 & \mbox{if } -\infty\leq x\leq \infty, y = \textrm{NaN}\\ 1 & \mbox{if } -\infty\leq y\leq \infty, x = \textrm{NaN}\\ \textrm{NaN} & \mbox{if } x, y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return If the first variable's value is smaller than the * second's, the first variable, otherwise the second variable. */ inline var fmin(const var& a, const var& b) { if (unlikely(is_nan(a))) { if (unlikely(is_nan(b))) { return var(new precomp_vv_vari(NOT_A_NUMBER, a.vi_, b.vi_, NOT_A_NUMBER, NOT_A_NUMBER)); } return b; } if (unlikely(is_nan(b))) { return a; } return a < b ? a : b; } /** * Returns the minimum of the variable and scalar, promoting the * scalar to a variable if it is larger (C99). * * For fmin(a, b), if a's value is less than or equal * to b, then a is returned, otherwise a fresh variable wrapping b * is returned. * * @param a First variable. * @param b Second value * @return If the first variable's value is less than or equal to the second * value, the first variable, otherwise the second value promoted to a fresh * variable. */ inline var fmin(const var& a, double b) { if (unlikely(is_nan(a))) { if (unlikely(is_nan(b))) { return var(new precomp_v_vari(NOT_A_NUMBER, a.vi_, NOT_A_NUMBER)); } return var(b); } if (unlikely(is_nan(b))) { return a; } return a <= b ? a : var(b); } /** * Returns the minimum of a scalar and variable, promoting the scalar to * a variable if it is larger (C99). * * For fmin(a, b), if a is less than b's value, then a * fresh variable implementation wrapping a is returned, otherwise * b is returned. * * @param a First value. * @param b Second variable. * @return If the first value is smaller than the second variable's value, * return the first value promoted to a variable, otherwise return the * second variable. */ inline var fmin(double a, const var& b) { if (unlikely(is_nan(b))) { if (unlikely(is_nan(a))) { return var(new precomp_v_vari(NOT_A_NUMBER, b.vi_, NOT_A_NUMBER)); } return var(a); } if (unlikely(is_nan(a))) { return b; } return b <= a ? b : var(a); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/boost_isfinite.hpp0000644000176200001440000000117713766554456025043 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BOOST_ISFINITE_HPP #define STAN_MATH_REV_SCAL_FUN_BOOST_ISFINITE_HPP #include #include #include namespace boost { namespace math { /** * Checks if the given number has finite value. * * Return true if the specified variable's * value is finite. * * @param v Variable to test. * @return true if variable is finite. */ template <> inline bool isfinite(const stan::math::var& v) { return (boost::math::isfinite)(v.val()); } } // namespace math } // namespace boost #endif StanHeaders/inst/include/stan/math/rev/scal/fun/acos.hpp0000644000176200001440000000275413766554456022752 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ACOS_HPP #define STAN_MATH_REV_SCAL_FUN_ACOS_HPP #include #include #include namespace stan { namespace math { namespace internal { class acos_vari : public op_v_vari { public: explicit acos_vari(vari* avi) : op_v_vari(std::acos(avi->val_), avi) {} void chain() { avi_->adj_ -= adj_ / std::sqrt(1.0 - (avi_->val_ * avi_->val_)); } }; } // namespace internal /** * Return the principal value of the arc cosine of a variable, * in radians (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \arccos x = \frac{-1}{\sqrt{1 - x^2}}\f$. * * \f[ \mbox{acos}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < -1\\ \arccos(x) & \mbox{if } -1\leq x\leq 1 \\ \textrm{NaN} & \mbox{if } x > 1\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{acos}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < -1\\ \frac{\partial\, \arccos(x)}{\partial x} & \mbox{if } -1\leq x\leq 1 \\ \textrm{NaN} & \mbox{if } x < -1\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial \, \arccos(x)}{\partial x} = -\frac{1}{\sqrt{1-x^2}} \f] * * @param a Variable in range [-1, 1]. * @return Arc cosine of variable, in radians. */ inline var acos(const var& a) { return var(new internal::acos_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_diff_exp.hpp0000644000176200001440000000460113766554456024443 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_DIFF_EXP_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_DIFF_EXP_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class log_diff_exp_vv_vari : public op_vv_vari { public: log_diff_exp_vv_vari(vari* avi, vari* bvi) : op_vv_vari(log_diff_exp(avi->val_, bvi->val_), avi, bvi) {} void chain() { avi_->adj_ += adj_ * calculate_chain(avi_->val_, val_); bvi_->adj_ -= adj_ / expm1(avi_->val_ - bvi_->val_); } }; class log_diff_exp_vd_vari : public op_vd_vari { public: log_diff_exp_vd_vari(vari* avi, double b) : op_vd_vari(log_diff_exp(avi->val_, b), avi, b) {} void chain() { if (val_ == NEGATIVE_INFTY) { avi_->adj_ += (bd_ == NEGATIVE_INFTY) ? adj_ : adj_ * INFTY; } else { avi_->adj_ += adj_ * calculate_chain(avi_->val_, val_); } } }; class log_diff_exp_dv_vari : public op_dv_vari { public: log_diff_exp_dv_vari(double a, vari* bvi) : op_dv_vari(log_diff_exp(a, bvi->val_), a, bvi) {} void chain() { if (val_ == NEGATIVE_INFTY) { bvi_->adj_ -= adj_ * INFTY; } else { bvi_->adj_ -= adj_ / expm1(ad_ - bvi_->val_); } } }; } // namespace internal /** * Returns the log difference of the exponentiated arguments. * * @param[in] a First argument. * @param[in] b Second argument. * @return Log difference of the exponentiated arguments. */ inline var log_diff_exp(const var& a, const var& b) { return var(new internal::log_diff_exp_vv_vari(a.vi_, b.vi_)); } /** * Returns the log difference of the exponentiated arguments. * * @param[in] a First argument. * @param[in] b Second argument. * @return Log difference of the exponentiated arguments. */ inline var log_diff_exp(const var& a, double b) { return var(new internal::log_diff_exp_vd_vari(a.vi_, b)); } /** * Returns the log difference of the exponentiated arguments. * * @param[in] a First argument. * @param[in] b Second argument. * @return Log difference of the exponentiated arguments. */ inline var log_diff_exp(double a, const var& b) { return var(new internal::log_diff_exp_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/bessel_first_kind.hpp0000644000176200001440000000151313766554456025506 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BESSEL_FIRST_KIND_HPP #define STAN_MATH_REV_SCAL_FUN_BESSEL_FIRST_KIND_HPP #include #include #include namespace stan { namespace math { namespace internal { class bessel_first_kind_dv_vari : public op_dv_vari { public: bessel_first_kind_dv_vari(int a, vari* bvi) : op_dv_vari(bessel_first_kind(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ += adj_ * (ad_ * bessel_first_kind(ad_, bvi_->val_) / bvi_->val_ - bessel_first_kind(ad_ + 1, bvi_->val_)); } }; } // namespace internal inline var bessel_first_kind(int v, const var& a) { return var(new internal::bessel_first_kind_dv_vari(v, a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inv_Phi.hpp0000644000176200001440000000177313766554456023421 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INV_PHI_HPP #define STAN_MATH_REV_SCAL_FUN_INV_PHI_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class inv_Phi_vari : public op_v_vari { public: explicit inv_Phi_vari(vari* avi) : op_v_vari(inv_Phi(avi->val_), avi) {} void chain() { static const double NEG_HALF = -0.5; avi_->adj_ += adj_ * SQRT_2_TIMES_SQRT_PI / std::exp(NEG_HALF * val_ * val_); } }; } // namespace internal /** * The inverse of unit normal cumulative density function. * * See inv_Phi() for the double-based version. * * The derivative is the reciprocal of unit normal density function, * * @param p Probability * @return The unit normal inverse cdf evaluated at p */ inline var inv_Phi(const var& p) { return var(new internal::inv_Phi_vari(p.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inv_sqrt.hpp0000644000176200001440000000206213766554456023662 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INV_SQRT_HPP #define STAN_MATH_REV_SCAL_FUN_INV_SQRT_HPP #include #include #include namespace stan { namespace math { namespace internal { class inv_sqrt_vari : public op_v_vari { public: explicit inv_sqrt_vari(vari* avi) : op_v_vari(inv_sqrt(avi->val_), avi) {} void chain() { avi_->adj_ -= 0.5 * adj_ / (avi_->val_ * std::sqrt(avi_->val_)); } }; } // namespace internal /** * \f[ \mbox{inv\_sqrt}(x) = \begin{cases} \frac{1}{\sqrt{x}} & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{inv\_sqrt}(x)}{\partial x} = \begin{cases} -\frac{1}{2\sqrt{x^3}} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * */ inline var inv_sqrt(const var& a) { return var(new internal::inv_sqrt_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/asinh.hpp0000644000176200001440000000266313766554456023126 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ASINH_HPP #define STAN_MATH_REV_SCAL_FUN_ASINH_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class asinh_vari : public op_v_vari { public: asinh_vari(double val, vari* avi) : op_v_vari(val, avi) {} void chain() { avi_->adj_ += adj_ / std::sqrt(avi_->val_ * avi_->val_ + 1.0); } }; } // namespace internal /** * The inverse hyperbolic sine function for variables (C99). * * The derivative is defined by * * \f$\frac{d}{dx} \mbox{asinh}(x) = \frac{x}{x^2 + 1}\f$. * * \f[ \mbox{asinh}(x) = \begin{cases} \sinh^{-1}(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{asinh}(x)}{\partial x} = \begin{cases} \frac{\partial\, \sinh^{-1}(x)}{\partial x} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \sinh^{-1}(x)=\ln\left(x+\sqrt{x^2+1}\right) \f] \f[ \frac{\partial \, \sinh^{-1}(x)}{\partial x} = \frac{1}{\sqrt{x^2+1}} \f] * * @param a The variable. * @return Inverse hyperbolic sine of the variable. */ inline var asinh(const var& a) { return var(new internal::asinh_vari(asinh(a.val()), a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/atanh.hpp0000644000176200001440000000315013766554456023107 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ATANH_HPP #define STAN_MATH_REV_SCAL_FUN_ATANH_HPP #include #include #include namespace stan { namespace math { namespace internal { class atanh_vari : public op_v_vari { public: atanh_vari(double val, vari* avi) : op_v_vari(val, avi) {} void chain() { avi_->adj_ += adj_ / (1.0 - avi_->val_ * avi_->val_); } }; } // namespace internal /** * The inverse hyperbolic tangent function for variables (C99). * * The derivative is defined by * * \f$\frac{d}{dx} \mbox{atanh}(x) = \frac{1}{1 - x^2}\f$. * \f[ \mbox{atanh}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < -1\\ \tanh^{-1}(x) & \mbox{if } -1\leq x \leq 1 \\ \textrm{NaN} & \mbox{if } x > 1\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{atanh}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < -1\\ \frac{\partial\, \tanh^{-1}(x)}{\partial x} & \mbox{if } -1\leq x\leq 1 \\ \textrm{NaN} & \mbox{if } x > 1\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \tanh^{-1}(x)=\frac{1}{2}\ln\left(\frac{1+x}{1-x}\right) \f] \f[ \frac{\partial \, \tanh^{-1}(x)}{\partial x} = \frac{1}{1-x^2} \f] * * @param a The variable. * @return Inverse hyperbolic tangent of the variable. * @throw std::domain_error if a < -1 or a > 1 */ inline var atanh(const var& a) { return var(new internal::atanh_vari(atanh(a.val()), a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/sin.hpp0000644000176200001440000000220113766554456022601 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_SIN_HPP #define STAN_MATH_REV_SCAL_FUN_SIN_HPP #include #include #include namespace stan { namespace math { namespace internal { class sin_vari : public op_v_vari { public: explicit sin_vari(vari* avi) : op_v_vari(std::sin(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * std::cos(avi_->val_); } }; } // namespace internal /** * Return the sine of a radian-scaled variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \sin x = \cos x\f$. * * \f[ \mbox{sin}(x) = \begin{cases} \sin(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{sin}(x)}{\partial x} = \begin{cases} \cos(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable for radians of angle. * @return Sine of variable. */ inline var sin(const var& a) { return var(new internal::sin_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/modified_bessel_second_kind.hpp0000644000176200001440000000165113766554456027475 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_MODIFIED_BESSEL_SECOND_KIND_HPP #define STAN_MATH_REV_SCAL_FUN_MODIFIED_BESSEL_SECOND_KIND_HPP #include #include #include namespace stan { namespace math { namespace internal { class modified_bessel_second_kind_dv_vari : public op_dv_vari { public: modified_bessel_second_kind_dv_vari(int a, vari* bvi) : op_dv_vari(modified_bessel_second_kind(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ -= adj_ * (ad_ * modified_bessel_second_kind(ad_, bvi_->val_) / bvi_->val_ + modified_bessel_second_kind(ad_ - 1, bvi_->val_)); } }; } // namespace internal inline var modified_bessel_second_kind(int v, const var& a) { return var(new internal::modified_bessel_second_kind_dv_vari(v, a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/primitive_value.hpp0000644000176200001440000000101013766554456025211 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_PRIMITIVE_VALUE_HPP #define STAN_MATH_REV_SCAL_FUN_PRIMITIVE_VALUE_HPP #include #include #include namespace stan { namespace math { /** * Return the primitive double value for the specified auto-diff * variable. * * @param v input variable. * @return value of input. */ inline double primitive_value(const var& v) { return v.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/lbeta.hpp0000644000176200001440000000556413766554456023116 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LBETA_HPP #define STAN_MATH_REV_SCAL_FUN_LBETA_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class lbeta_vv_vari : public op_vv_vari { public: lbeta_vv_vari(vari* avi, vari* bvi) : op_vv_vari(lbeta(avi->val_, bvi->val_), avi, bvi) {} void chain() { const double digamma_ab = digamma(avi_->val_ + bvi_->val_); avi_->adj_ += adj_ * (digamma(avi_->val_) - digamma_ab); bvi_->adj_ += adj_ * (digamma(bvi_->val_) - digamma_ab); } }; class lbeta_vd_vari : public op_vd_vari { public: lbeta_vd_vari(vari* avi, double b) : op_vd_vari(lbeta(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * (digamma(avi_->val_) - digamma(avi_->val_ + bd_)); } }; class lbeta_dv_vari : public op_dv_vari { public: lbeta_dv_vari(double a, vari* bvi) : op_dv_vari(lbeta(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ += adj_ * (digamma(bvi_->val_) - digamma(ad_ + bvi_->val_)); } }; } // namespace internal /* * Returns the natural logarithm of the beta function and its gradients. * \f[ \mathrm{lbeta}(a,b) = \ln\left(B\left(a,b\right)\right) \f] \f[ \frac{\partial }{\partial a} = \psi^{\left(0\right)}\left(a\right) - \psi^{\left(0\right)}\left(a + b\right) \f] \f[ \frac{\partial }{\partial b} = \psi^{\left(0\right)}\left(b\right) - \psi^{\left(0\right)}\left(a + b\right) \f] * @param a var Argument * @param b var Argument * @return Result of log beta function */ inline var lbeta(const var& a, const var& b) { return var(new internal::lbeta_vv_vari(a.vi_, b.vi_)); } /* * Returns the natural logarithm of the beta function and its gradients. * \f[ \mathrm{lbeta}(a,b) = \ln\left(B\left(a,b\right)\right) \f] \f[ \frac{\partial }{\partial a} = \psi^{\left(0\right)}\left(a\right) - \psi^{\left(0\right)}\left(a + b\right) \f] * @param a var Argument * @param b double Argument * @return Result of log beta function */ inline var lbeta(const var& a, double b) { return var(new internal::lbeta_vd_vari(a.vi_, b)); } /* * Returns the natural logarithm of the beta function and its gradients. * \f[ \mathrm{lbeta}(a,b) = \ln\left(B\left(a,b\right)\right) \f] \f[ \frac{\partial }{\partial b} = \psi^{\left(0\right)}\left(b\right) - \psi^{\left(0\right)}\left(a + b\right) \f] * @param a double Argument * @param b var Argument * @return Result of log beta function */ inline var lbeta(double a, const var& b) { return var(new internal::lbeta_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/fmax.hpp0000644000176200001440000000732613766554456022760 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FMAX_HPP #define STAN_MATH_REV_SCAL_FUN_FMAX_HPP #include #include #include #include #include namespace stan { namespace math { /** * Returns the maximum of the two variable arguments (C99). * * No new variable implementations are created, with this function * defined as if by * * fmax(a, b) = a if a's value is greater than b's, and . * * fmax(a, b) = b if b's value is greater than or equal to a's. * \f[ \mbox{fmax}(x, y) = \begin{cases} x & \mbox{if } x \geq y \\ y & \mbox{if } x < y \\[6pt] x & \mbox{if } -\infty\leq x\leq \infty, y = \textrm{NaN}\\ y & \mbox{if } -\infty\leq y\leq \infty, x = \textrm{NaN}\\ \textrm{NaN} & \mbox{if } x, y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fmax}(x, y)}{\partial x} = \begin{cases} 1 & \mbox{if } x \geq y \\ 0 & \mbox{if } x < y \\[6pt] 1 & \mbox{if } -\infty\leq x\leq \infty, y = \textrm{NaN}\\ 0 & \mbox{if } -\infty\leq y\leq \infty, x = \textrm{NaN}\\ \textrm{NaN} & \mbox{if } x, y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fmax}(x, y)}{\partial y} = \begin{cases} 0 & \mbox{if } x \geq y \\ 1 & \mbox{if } x < y \\[6pt] 0 & \mbox{if } -\infty\leq x\leq \infty, y = \textrm{NaN}\\ 1 & \mbox{if } -\infty\leq y\leq \infty, x = \textrm{NaN}\\ \textrm{NaN} & \mbox{if } x, y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return If the first variable's value is larger than the * second's, the first variable, otherwise the second variable. */ inline var fmax(const var& a, const var& b) { if (unlikely(is_nan(a))) { if (unlikely(is_nan(b))) { return var(new precomp_vv_vari(NOT_A_NUMBER, a.vi_, b.vi_, NOT_A_NUMBER, NOT_A_NUMBER)); } return b; } if (unlikely(is_nan(b))) { return a; } return a > b ? a : b; } /** * Returns the maximum of the variable and scalar, promoting the * scalar to a variable if it is larger (C99). * * For fmax(a, b), if a's value is greater than b, * then a is returned, otherwise a fesh variable implementation * wrapping the value b is returned. * * @param a First variable. * @param b Second value * @return If the first variable's value is larger than or equal * to the second value, the first variable, otherwise the second * value promoted to a fresh variable. */ inline var fmax(const var& a, double b) { if (unlikely(is_nan(a))) { if (unlikely(is_nan(b))) { return var(new precomp_v_vari(NOT_A_NUMBER, a.vi_, NOT_A_NUMBER)); } return var(b); } if (unlikely(is_nan(b))) { return a; } return a >= b ? a : var(b); } /** * Returns the maximum of a scalar and variable, promoting the scalar to * a variable if it is larger (C99). * * For fmax(a, b), if a is greater than b's value, * then a fresh variable implementation wrapping a is returned, otherwise * b is returned. * * @param a First value. * @param b Second variable. * @return If the first value is larger than the second variable's value, * return the first value promoted to a variable, otherwise return the * second variable. */ inline var fmax(double a, const var& b) { if (unlikely(is_nan(b))) { if (unlikely(is_nan(a))) { return var(new precomp_v_vari(NOT_A_NUMBER, b.vi_, NOT_A_NUMBER)); } return var(a); } if (unlikely(is_nan(a))) { return b; } return a > b ? var(a) : b; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/abs.hpp0000644000176200001440000000156313766554456022567 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ABS_HPP #define STAN_MATH_REV_SCAL_FUN_ABS_HPP #include #include namespace stan { namespace math { /** * Return the absolute value of the variable (std). * * Delegates to fabs() (see for doc). * \f[ \mbox{abs}(x) = \begin{cases} |x| & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{abs}(x)}{\partial x} = \begin{cases} -1 & \mbox{if } x < 0 \\ 0 & \mbox{if } x = 0 \\ 1 & \mbox{if } x > 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable input. * @return Absolute value of variable. */ inline var abs(const var& a) { return fabs(a); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/hypot.hpp0000644000176200001440000000572213766554456023166 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_HYPOT_HPP #define STAN_MATH_REV_SCAL_FUN_HYPOT_HPP #include #include #include namespace stan { namespace math { namespace internal { class hypot_vv_vari : public op_vv_vari { public: hypot_vv_vari(vari* avi, vari* bvi) : op_vv_vari(hypot(avi->val_, bvi->val_), avi, bvi) {} void chain() { avi_->adj_ += adj_ * avi_->val_ / val_; bvi_->adj_ += adj_ * bvi_->val_ / val_; } }; class hypot_vd_vari : public op_v_vari { public: hypot_vd_vari(vari* avi, double b) : op_v_vari(hypot(avi->val_, b), avi) {} void chain() { avi_->adj_ += adj_ * avi_->val_ / val_; } }; } // namespace internal /** * Returns the length of the hypoteneuse of a right triangle * with sides of the specified lengths (C99). * * The partial derivatives are given by * * \f$\frac{\partial}{\partial x} \sqrt{x^2 + y^2} = \frac{x}{\sqrt{x^2 + * y^2}}\f$, and * * \f$\frac{\partial}{\partial y} \sqrt{x^2 + y^2} = \frac{y}{\sqrt{x^2 + * y^2}}\f$. * * @param[in] a Length of first side. * @param[in] b Length of second side. * @return Length of hypoteneuse. */ inline var hypot(const var& a, const var& b) { return var(new internal::hypot_vv_vari(a.vi_, b.vi_)); } /** * Returns the length of the hypoteneuse of a right triangle * with sides of the specified lengths (C99). * * The derivative is * * \f$\frac{d}{d x} \sqrt{x^2 + c^2} = \frac{x}{\sqrt{x^2 + c^2}}\f$. * * @param[in] a Length of first side. * @param[in] b Length of second side. * @return Length of hypoteneuse. */ inline var hypot(const var& a, double b) { return var(new internal::hypot_vd_vari(a.vi_, b)); } /** * Returns the length of the hypoteneuse of a right triangle * with sides of the specified lengths (C99). * * The derivative is * * \f$\frac{d}{d y} \sqrt{c^2 + y^2} = \frac{y}{\sqrt{c^2 + y^2}}\f$. * \f[ \mbox{hypot}(x, y) = \begin{cases} \textrm{NaN} & \mbox{if } x < 0 \text{ or } y < 0 \\ \sqrt{x^2+y^2} & \mbox{if } x, y\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{hypot}(x, y)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < 0 \text{ or } y < 0 \\ \frac{x}{\sqrt{x^2+y^2}} & \mbox{if } x, y\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{hypot}(x, y)}{\partial y} = \begin{cases} \textrm{NaN} & \mbox{if } x < 0 \text{ or } y < 0 \\ \frac{y}{\sqrt{x^2+y^2}} & \mbox{if } x, y\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param[in] a Length of first side. * @param[in] b Length of second side. * @return Length of hypoteneuse. */ inline var hypot(double a, const var& b) { return var(new internal::hypot_vd_vari(b.vi_, a)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log.hpp0000644000176200001440000000226213766554456022600 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_HPP #include #include #include namespace stan { namespace math { namespace internal { class log_vari : public op_v_vari { public: explicit log_vari(vari* avi) : op_v_vari(std::log(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / avi_->val_; } }; } // namespace internal /** * Return the natural log of the specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \log x = \frac{1}{x}\f$. * \f[ \mbox{log}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < 0\\ \ln(x) & \mbox{if } x \geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{log}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < 0\\ \frac{1}{x} & \mbox{if } x\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable whose log is taken. * @return Natural log of variable. */ inline var log(const var& a) { return var(new internal::log_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/multiply_log.hpp0000644000176200001440000000602713766554456024542 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_MULTIPLY_LOG_HPP #define STAN_MATH_REV_SCAL_FUN_MULTIPLY_LOG_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class multiply_log_vv_vari : public op_vv_vari { public: multiply_log_vv_vari(vari* avi, vari* bvi) : op_vv_vari(multiply_log(avi->val_, bvi->val_), avi, bvi) {} void chain() { using std::log; if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * log(bvi_->val_); if (bvi_->val_ == 0.0 && avi_->val_ == 0) { bvi_->adj_ += adj_ * std::numeric_limits::infinity(); } else { bvi_->adj_ += adj_ * avi_->val_ / bvi_->val_; } } } }; class multiply_log_vd_vari : public op_vd_vari { public: multiply_log_vd_vari(vari* avi, double b) : op_vd_vari(multiply_log(avi->val_, b), avi, b) {} void chain() { using std::log; if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * log(bd_); } } }; class multiply_log_dv_vari : public op_dv_vari { public: multiply_log_dv_vari(double a, vari* bvi) : op_dv_vari(multiply_log(a, bvi->val_), a, bvi) {} void chain() { if (bvi_->val_ == 0.0 && ad_ == 0.0) { bvi_->adj_ += adj_ * std::numeric_limits::infinity(); } else { bvi_->adj_ += adj_ * ad_ / bvi_->val_; } } }; } // namespace internal /** * Return the value of a*log(b). * * When both a and b are 0, the value returned is 0. * The partial deriviative with respect to a is log(b). * The partial deriviative with respect to b is a/b. When * a and b are both 0, this is set to Inf. * * @param a First variable. * @param b Second variable. * @return Value of a*log(b) */ inline var multiply_log(const var& a, const var& b) { return var(new internal::multiply_log_vv_vari(a.vi_, b.vi_)); } /** * Return the value of a*log(b). * * When both a and b are 0, the value returned is 0. * The partial deriviative with respect to a is log(b). * * @param a First variable. * @param b Second scalar. * @return Value of a*log(b) */ inline var multiply_log(const var& a, double b) { return var(new internal::multiply_log_vd_vari(a.vi_, b)); } /** * Return the value of a*log(b). * * When both a and b are 0, the value returned is 0. * The partial deriviative with respect to b is a/b. When * a and b are both 0, this is set to Inf. * * @param a First scalar. * @param b Second variable. * @return Value of a*log(b) */ inline var multiply_log(double a, const var& b) { if (a == 1.0) { return log(b); } return var(new internal::multiply_log_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/gamma_q.hpp0000644000176200001440000000351013766554456023416 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_GAMMA_Q_HPP #define STAN_MATH_REV_SCAL_FUN_GAMMA_Q_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class gamma_q_vv_vari : public op_vv_vari { public: gamma_q_vv_vari(vari* avi, vari* bvi) : op_vv_vari(gamma_q(avi->val_, bvi->val_), avi, bvi) {} void chain() { avi_->adj_ += adj_ * grad_reg_inc_gamma(avi_->val_, bvi_->val_, tgamma(avi_->val_), digamma(avi_->val_)); bvi_->adj_ -= adj_ * boost::math::gamma_p_derivative(avi_->val_, bvi_->val_); } }; class gamma_q_vd_vari : public op_vd_vari { public: gamma_q_vd_vari(vari* avi, double b) : op_vd_vari(gamma_q(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * grad_reg_inc_gamma(avi_->val_, bd_, tgamma(avi_->val_), digamma(avi_->val_)); } }; class gamma_q_dv_vari : public op_dv_vari { public: gamma_q_dv_vari(double a, vari* bvi) : op_dv_vari(gamma_q(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ -= adj_ * boost::math::gamma_p_derivative(ad_, bvi_->val_); } }; } // namespace internal inline var gamma_q(const var& a, const var& b) { return var(new internal::gamma_q_vv_vari(a.vi_, b.vi_)); } inline var gamma_q(const var& a, double b) { return var(new internal::gamma_q_vd_vari(a.vi_, b)); } inline var gamma_q(double a, const var& b) { return var(new internal::gamma_q_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/calculate_chain.hpp0000644000176200001440000000054213766554456025115 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_CALCULATE_CHAIN_HPP #define STAN_MATH_REV_SCAL_FUN_CALCULATE_CHAIN_HPP #include #include namespace stan { namespace math { inline double calculate_chain(double x, double val) { return std::exp(x - val); // works out to inv_logit(x) } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inv_cloglog.hpp0000644000176200001440000000202313766554456024314 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INV_CLOGLOG_HPP #define STAN_MATH_REV_SCAL_FUN_INV_CLOGLOG_HPP #include #include #include namespace stan { namespace math { namespace internal { class inv_cloglog_vari : public op_v_vari { public: explicit inv_cloglog_vari(vari* avi) : op_v_vari(inv_cloglog(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * std::exp(avi_->val_ - std::exp(avi_->val_)); } }; } // namespace internal /** * Return the inverse complementary log-log function applied * specified variable (stan). * * See inv_cloglog() for the double-based version. * * The derivative is given by * * \f$\frac{d}{dx} \mbox{cloglog}^{-1}(x) = \exp (x - \exp (x))\f$. * * @param a Variable argument. * @return The inverse complementary log-log of the specified * argument. */ inline var inv_cloglog(const var& a) { return var(new internal::inv_cloglog_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/rising_factorial.hpp0000644000176200001440000000152113766554456025333 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_RISING_FACTORIAL_HPP #define STAN_MATH_REV_SCAL_FUN_RISING_FACTORIAL_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class rising_factorial_vd_vari : public op_vd_vari { public: rising_factorial_vd_vari(vari* avi, int b) : op_vd_vari(rising_factorial(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * rising_factorial(avi_->val_, bd_) * (digamma(avi_->val_ + bd_) - digamma(avi_->val_)); } }; } // namespace internal inline var rising_factorial(const var& a, int b) { return var(new internal::rising_factorial_vd_vari(a.vi_, b)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/grad_inc_beta.hpp0000644000176200001440000000301013766554456024550 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_GRAD_INC_BETA_HPP #define STAN_MATH_REV_SCAL_FUN_GRAD_INC_BETA_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Gradient of the incomplete beta function beta(a, b, z) with * respect to the first two arguments. * * Uses the equivalence to a hypergeometric function. See * http://dlmf.nist.gov/8.17#ii * * @param[out] g1 d/da * @param[out] g2 d/db * @param[in] a a * @param[in] b b * @param[in] z z */ inline void grad_inc_beta(var& g1, var& g2, const var& a, const var& b, const var& z) { var c1 = log(z); var c2 = log1m(z); var c3 = beta(a, b) * inc_beta(a, b, z); var C = exp(a * c1 + b * c2) / a; var dF1 = 0; var dF2 = 0; if (value_of(value_of(C))) { grad_2F1(dF1, dF2, a + b, var(1.0), a + 1, z); } g1 = (c1 - 1.0 / a) * c3 + C * (dF1 + dF2); g2 = c2 * c3 + C * dF1; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/lmgamma.hpp0000644000176200001440000000144113766554456023430 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LMGAMMA_HPP #define STAN_MATH_REV_SCAL_FUN_LMGAMMA_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class lmgamma_dv_vari : public op_dv_vari { public: lmgamma_dv_vari(int a, vari* bvi) : op_dv_vari(lmgamma(a, bvi->val_), a, bvi) {} void chain() { double deriv = 0; for (int i = 1; i < ad_ + 1; i++) { deriv += digamma(bvi_->val_ + (1.0 - i) / 2.0); } bvi_->adj_ += adj_ * deriv; } }; } // namespace internal inline var lmgamma(int a, const var& b) { return var(new internal::lmgamma_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/asin.hpp0000644000176200001440000000276313766554456022757 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ASIN_HPP #define STAN_MATH_REV_SCAL_FUN_ASIN_HPP #include #include #include namespace stan { namespace math { namespace internal { class asin_vari : public op_v_vari { public: explicit asin_vari(vari* avi) : op_v_vari(std::asin(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / std::sqrt(1.0 - (avi_->val_ * avi_->val_)); } }; } // namespace internal /** * Return the principal value of the arc sine, in radians, of the * specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \arcsin x = \frac{1}{\sqrt{1 - x^2}}\f$. * * \f[ \mbox{asin}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < -1\\ \arcsin(x) & \mbox{if } -1\leq x\leq 1 \\ \textrm{NaN} & \mbox{if } x > 1\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{asin}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < -1\\ \frac{\partial\, \arcsin(x)}{\partial x} & \mbox{if } -1\leq x\leq 1 \\ \textrm{NaN} & \mbox{if } x < -1\\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial \, \arcsin(x)}{\partial x} = \frac{1}{\sqrt{1-x^2}} \f] * * @param a Variable in range [-1, 1]. * @return Arc sine of variable, in radians. */ inline var asin(const var& a) { return var(new internal::asin_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/acosh.hpp0000644000176200001440000000305413766554456023114 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ACOSH_HPP #define STAN_MATH_REV_SCAL_FUN_ACOSH_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class acosh_vari : public op_v_vari { public: acosh_vari(double val, vari* avi) : op_v_vari(val, avi) {} void chain() { avi_->adj_ += adj_ / std::sqrt(avi_->val_ * avi_->val_ - 1.0); } }; } // namespace internal /** * The inverse hyperbolic cosine function for variables (C99). * * For non-variable function, see ::acosh(). * * The derivative is defined by * * \f$\frac{d}{dx} \mbox{acosh}(x) = \frac{x}{x^2 - 1}\f$. * * \f[ \mbox{acosh}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < 1 \\ \cosh^{-1}(x) & \mbox{if } x \geq 1 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{acosh}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < 1 \\ \frac{\partial\, \cosh^{-1}(x)}{\partial x} & \mbox{if } x \geq 1 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \cosh^{-1}(x)=\ln\left(x+\sqrt{x^2-1}\right) \f] \f[ \frac{\partial \, \cosh^{-1}(x)}{\partial x} = \frac{1}{\sqrt{x^2-1}} \f] * * @param a The variable. * @return Inverse hyperbolic cosine of the variable. */ inline var acosh(const var& a) { return var(new internal::acosh_vari(stan::math::acosh(a.val()), a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/sinh.hpp0000644000176200001440000000217513766554456022763 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_SINH_HPP #define STAN_MATH_REV_SCAL_FUN_SINH_HPP #include #include namespace stan { namespace math { namespace internal { class sinh_vari : public op_v_vari { public: explicit sinh_vari(vari* avi) : op_v_vari(std::sinh(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * std::cosh(avi_->val_); } }; } // namespace internal /** * Return the hyperbolic sine of the specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \sinh x = \cosh x\f$. * * \f[ \mbox{sinh}(x) = \begin{cases} \sinh(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{sinh}(x)}{\partial x} = \begin{cases} \cosh(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable. * @return Hyperbolic sine of variable. */ inline var sinh(const var& a) { return var(new internal::sinh_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/fabs.hpp0000644000176200001440000000316513766554456022735 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FABS_HPP #define STAN_MATH_REV_SCAL_FUN_FABS_HPP #include #include #include namespace stan { namespace math { /** * Return the absolute value of the variable (cmath). * * Choosing an arbitrary value at the non-differentiable point 0, * * \f$\frac{d}{dx}|x| = \mbox{sgn}(x)\f$. * * where \f$\mbox{sgn}(x)\f$ is the signum function, taking values * -1 if \f$x < 0\f$, 0 if \f$x == 0\f$, and 1 if \f$x == 1\f$. * * The function abs() provides the same behavior, with * abs() defined in stdlib.h and fabs() * defined in cmath. * The derivative is 0 if the input is 0. * * Returns std::numeric_limits::quiet_NaN() for NaN inputs. * * \f[ \mbox{fabs}(x) = \begin{cases} |x| & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fabs}(x)}{\partial x} = \begin{cases} -1 & \mbox{if } x < 0 \\ 0 & \mbox{if } x = 0 \\ 1 & \mbox{if } x > 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Input variable. * @return Absolute value of variable. */ inline var fabs(const var& a) { if (a.val() > 0.0) { return a; } else if (a.val() < 0.0) { return var(new internal::neg_vari(a.vi_)); } else if (a.val() == 0) { return var(new vari(0)); } else { return var(new precomp_v_vari(NOT_A_NUMBER, a.vi_, NOT_A_NUMBER)); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/logit.hpp0000644000176200001440000000113413766554456023132 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOGIT_HPP #define STAN_MATH_REV_SCAL_FUN_LOGIT_HPP #include #include #include #include namespace stan { namespace math { /** * Return the log odds of the specified argument. * * @param u argument * @return log odds of argument */ inline var logit(const var& u) { return var(new precomp_v_vari(logit(u.val()), u.vi_, 1 / (u.val() - u.val() * u.val()))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/beta.hpp0000644000176200001440000000652513766554456022740 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BETA_HPP #define STAN_MATH_REV_SCAL_FUN_BETA_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class beta_vv_vari : public op_vv_vari { public: beta_vv_vari(vari* avi, vari* bvi) : op_vv_vari(beta(avi->val_, bvi->val_), avi, bvi) {} void chain() { const double adj_val = this->adj_ * this->val_; const double digamma_ab = digamma(avi_->val_ + bvi_->val_); avi_->adj_ += adj_val * (digamma(avi_->val_) - digamma_ab); bvi_->adj_ += adj_val * (digamma(bvi_->val_) - digamma_ab); } }; class beta_vd_vari : public op_vd_vari { public: beta_vd_vari(vari* avi, double b) : op_vd_vari(beta(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * (digamma(avi_->val_) - digamma(avi_->val_ + bd_)) * this->val_; } }; class beta_dv_vari : public op_dv_vari { public: beta_dv_vari(double a, vari* bvi) : op_dv_vari(beta(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ += adj_ * (digamma(bvi_->val_) - digamma(ad_ + bvi_->val_)) * this->val_; } }; } // namespace internal /* * Returns the beta function and gradients for two var inputs. * \f[ \mathrm{beta}(a,b) = \left(B\left(a,b\right)\right) \f] \f[ \frac{\partial }{\partial a} = \left(\psi^{\left(0\right)}\left(a\right) - \psi^{\left(0\right)} \left(a + b\right)\right) * \mathrm{beta}(a,b) \f] \f[ \frac{\partial }{\partial b} = \left(\psi^{\left(0\right)}\left(b\right) - \psi^{\left(0\right)} \left(a + b\right)\right) * \mathrm{beta}(a,b) \f] * * @param a var Argument * @param b var Argument * @return Result of beta function */ inline var beta(const var& a, const var& b) { return var(new internal::beta_vv_vari(a.vi_, b.vi_)); } /* * Returns the beta function and gradient for first var input. * \f[ \mathrm{beta}(a,b) = \left(B\left(a,b\right)\right) \f] \f[ \frac{\partial }{\partial a} = \left(\psi^{\left(0\right)}\left(a\right) - \psi^{\left(0\right)} \left(a + b\right)\right) * \mathrm{beta}(a,b) \f] * * @param a var Argument * @param b double Argument * @return Result of beta function */ inline var beta(const var& a, double b) { return var(new internal::beta_vd_vari(a.vi_, b)); } /* * Returns the beta function and gradient for second var input. * \f[ \mathrm{beta}(a,b) = \left(B\left(a,b\right)\right) \f] \f[ \frac{\partial }{\partial b} = \left(\psi^{\left(0\right)}\left(b\right) - \psi^{\left(0\right)} \left(a + b\right)\right) * \mathrm{beta}(a,b) \f] * * @param a double Argument * @param b var Argument * @return Result of beta function */ inline var beta(double a, const var& b) { return var(new internal::beta_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log1m_exp.hpp0000644000176200001440000000173513766554456023716 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG1M_EXP_HPP #define STAN_MATH_REV_SCAL_FUN_LOG1M_EXP_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class log1m_exp_v_vari : public op_v_vari { public: explicit log1m_exp_v_vari(vari* avi) : op_v_vari(log1m_exp(avi->val_), avi) {} void chain() { avi_->adj_ -= adj_ / expm1(-(avi_->val_)); } }; } // namespace internal /** * Return the log of 1 minus the exponential of the specified * variable. * *

The deriative of log(1 - exp(x)) with respect * to x is -1 / expm1(-x). * * @param[in] x Argument. * @return Natural logarithm of one minus the exponential of the * argument. */ inline var log1m_exp(const var& x) { return var(new internal::log1m_exp_v_vari(x.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/binary_log_loss.hpp0000644000176200001440000000371113766554456025204 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BINARY_LOG_LOSS_HPP #define STAN_MATH_REV_SCAL_FUN_BINARY_LOG_LOSS_HPP #include #include #include namespace stan { namespace math { namespace internal { class binary_log_loss_1_vari : public op_v_vari { public: explicit binary_log_loss_1_vari(vari* avi) : op_v_vari(-std::log(avi->val_), avi) {} void chain() { avi_->adj_ -= adj_ / avi_->val_; } }; class binary_log_loss_0_vari : public op_v_vari { public: explicit binary_log_loss_0_vari(vari* avi) : op_v_vari(-log1p(-avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (1.0 - avi_->val_); } }; } // namespace internal /** * The log loss function for variables (stan). * * See binary_log_loss() for the double-based version. * * The derivative with respect to the variable \f$\hat{y}\f$ is * * \f$\frac{d}{d\hat{y}} \mbox{logloss}(1, \hat{y}) = - \frac{1}{\hat{y}}\f$, and * * \f$\frac{d}{d\hat{y}} \mbox{logloss}(0, \hat{y}) = \frac{1}{1 - \hat{y}}\f$. * * \f[ \mbox{binary\_log\_loss}(y, \hat{y}) = \begin{cases} y \log \hat{y} + (1 - y) \log (1 - \hat{y}) & \mbox{if } 0\leq \hat{y}\leq 1, y\in\{ 0, 1 \}\\[6pt] \textrm{NaN} & \mbox{if } \hat{y} = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{binary\_log\_loss}(y, \hat{y})}{\partial \hat{y}} = \begin{cases} \frac{y}{\hat{y}}-\frac{1-y}{1-\hat{y}} & \mbox{if } 0\leq \hat{y}\leq 1, y\in\{ 0, 1 \}\\[6pt] \textrm{NaN} & \mbox{if } \hat{y} = \textrm{NaN} \end{cases} \f] * * @param y Reference value. * @param y_hat Response variable. * @return Log loss of response versus reference value. */ inline var binary_log_loss(int y, const var& y_hat) { if (y == 0) { return var(new internal::binary_log_loss_0_vari(y_hat.vi_)); } else { return var(new internal::binary_log_loss_1_vari(y_hat.vi_)); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/lgamma.hpp0000644000176200001440000000155513766554456023261 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LGAMMA_HPP #define STAN_MATH_REV_SCAL_FUN_LGAMMA_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class lgamma_vari : public op_v_vari { public: lgamma_vari(double value, vari* avi) : op_v_vari(value, avi) {} void chain() { avi_->adj_ += adj_ * digamma(avi_->val_); } }; } // namespace internal /** * The log gamma function for variables (C99). * * The derivatie is the digamma function, * * \f$\frac{d}{dx} \Gamma(x) = \psi^{(0)}(x)\f$. * * @param a The variable. * @return Log gamma of the variable. */ inline var lgamma(const var& a) { return var(new internal::lgamma_vari(lgamma(a.val()), a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inv_logit.hpp0000644000176200001440000000166613766554456024020 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INV_LOGIT_HPP #define STAN_MATH_REV_SCAL_FUN_INV_LOGIT_HPP #include #include #include namespace stan { namespace math { namespace internal { class inv_logit_vari : public op_v_vari { public: explicit inv_logit_vari(vari* avi) : op_v_vari(inv_logit(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * val_ * (1.0 - val_); } }; } // namespace internal /** * The inverse logit function for variables (stan). * * See inv_logit() for the double-based version. * * The derivative of inverse logit is * * \f$\frac{d}{dx} \mbox{logit}^{-1}(x) = \mbox{logit}^{-1}(x) (1 - * \mbox{logit}^{-1}(x))\f$. * * @param a Argument variable. * @return Inverse logit of argument. */ inline var inv_logit(const var& a) { return var(new internal::inv_logit_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/tanh.hpp0000644000176200001440000000231713766554456022752 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_TANH_HPP #define STAN_MATH_REV_SCAL_FUN_TANH_HPP #include #include #include namespace stan { namespace math { namespace internal { class tanh_vari : public op_v_vari { public: explicit tanh_vari(vari* avi) : op_v_vari(std::tanh(avi->val_), avi) {} void chain() { double cosh = std::cosh(avi_->val_); avi_->adj_ += adj_ / (cosh * cosh); } }; } // namespace internal /** * Return the hyperbolic tangent of the specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \tanh x = \frac{1}{\cosh^2 x}\f$. * * \f[ \mbox{tanh}(x) = \begin{cases} \tanh(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{tanh}(x)}{\partial x} = \begin{cases} \mbox{sech}^2(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable. * @return Hyperbolic tangent of variable. */ inline var tanh(const var& a) { return var(new internal::tanh_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inv_square.hpp0000644000176200001440000000207113766554456024171 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INV_SQUARE_HPP #define STAN_MATH_REV_SCAL_FUN_INV_SQUARE_HPP #include #include #include namespace stan { namespace math { namespace internal { class inv_square_vari : public op_v_vari { public: explicit inv_square_vari(vari* avi) : op_v_vari(inv_square(avi->val_), avi) {} void chain() { avi_->adj_ -= 2 * adj_ / (avi_->val_ * avi_->val_ * avi_->val_); } }; } // namespace internal /** * \f[ \mbox{inv\_square}(x) = \begin{cases} \frac{1}{x^2} & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{inv\_square}(x)}{\partial x} = \begin{cases} -\frac{2}{x^3} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * */ inline var inv_square(const var& a) { return var(new internal::inv_square_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log1m.hpp0000644000176200001440000000147113766554456023037 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG1M_HPP #define STAN_MATH_REV_SCAL_FUN_LOG1M_HPP #include #include #include namespace stan { namespace math { namespace internal { class log1m_vari : public op_v_vari { public: explicit log1m_vari(vari* avi) : op_v_vari(log1m(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (avi_->val_ - 1); } }; } // namespace internal /** * The log (1 - x) function for variables. * * The derivative is given by * * \f$\frac{d}{dx} \log (1 - x) = -\frac{1}{1 - x}\f$. * * @param a The variable. * @return The variable representing log of 1 minus the variable. */ inline var log1m(const var& a) { return var(new internal::log1m_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/falling_factorial.hpp0000644000176200001440000000150513766554456025456 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FALLING_FACTORIAL_HPP #define STAN_MATH_REV_SCAL_FUN_FALLING_FACTORIAL_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class falling_factorial_vd_vari : public op_vd_vari { public: falling_factorial_vd_vari(vari* avi, int b) : op_vd_vari(falling_factorial(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * val_ * (digamma(avi_->val_ + 1) - digamma(avi_->val_ - bd_ + 1)); } }; } // namespace internal inline var falling_factorial(const var& a, int b) { return var(new internal::falling_factorial_vd_vari(a.vi_, b)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/square.hpp0000644000176200001440000000216413766554456023320 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_SQUARE_HPP #define STAN_MATH_REV_SCAL_FUN_SQUARE_HPP #include #include namespace stan { namespace math { namespace internal { class square_vari : public op_v_vari { public: explicit square_vari(vari* avi) : op_v_vari(avi->val_ * avi->val_, avi) {} void chain() { avi_->adj_ += adj_ * 2.0 * avi_->val_; } }; } // namespace internal /** * Return the square of the input variable. * *

Using square(x) is more efficient * than using x * x. * \f[ \mbox{square}(x) = \begin{cases} x^2 & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{square}(x)}{\partial x} = \begin{cases} 2x & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param x Variable to square. * @return Square of variable. */ inline var square(const var& x) { return var(new internal::square_vari(x.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/modified_bessel_first_kind.hpp0000644000176200001440000000164013766554456027347 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_MODIFIED_BESSEL_FIRST_KIND_HPP #define STAN_MATH_REV_SCAL_FUN_MODIFIED_BESSEL_FIRST_KIND_HPP #include #include #include namespace stan { namespace math { namespace internal { class modified_bessel_first_kind_dv_vari : public op_dv_vari { public: modified_bessel_first_kind_dv_vari(int a, vari* bvi) : op_dv_vari(modified_bessel_first_kind(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ += adj_ * (-ad_ * modified_bessel_first_kind(ad_, bvi_->val_) / bvi_->val_ + modified_bessel_first_kind(ad_ - 1, bvi_->val_)); } }; } // namespace internal inline var modified_bessel_first_kind(int v, const var& a) { return var(new internal::modified_bessel_first_kind_dv_vari(v, a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/gamma_p.hpp0000644000176200001440000000605113766554456023420 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_GAMMA_P_HPP #define STAN_MATH_REV_SCAL_FUN_GAMMA_P_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class gamma_p_vv_vari : public op_vv_vari { public: gamma_p_vv_vari(vari* avi, vari* bvi) : op_vv_vari(gamma_p(avi->val_, bvi->val_), avi, bvi) {} void chain() { using std::exp; using std::fabs; using std::log; if (is_inf(avi_->val_)) { avi_->adj_ += std::numeric_limits::quiet_NaN(); bvi_->adj_ += std::numeric_limits::quiet_NaN(); return; } if (is_inf(bvi_->val_)) { avi_->adj_ += std::numeric_limits::quiet_NaN(); bvi_->adj_ += std::numeric_limits::quiet_NaN(); return; } // return zero derivative as gamma_p is flat // to machine precision for b / a > 10 if (std::fabs(bvi_->val_ / avi_->val_) > 10) { return; } avi_->adj_ += adj_ * grad_reg_lower_inc_gamma(avi_->val_, bvi_->val_); bvi_->adj_ += adj_ * std::exp(-bvi_->val_ + (avi_->val_ - 1.0) * std::log(bvi_->val_) - lgamma(avi_->val_)); } }; class gamma_p_vd_vari : public op_vd_vari { public: gamma_p_vd_vari(vari* avi, double b) : op_vd_vari(gamma_p(avi->val_, b), avi, b) {} void chain() { if (is_inf(avi_->val_)) { avi_->adj_ += std::numeric_limits::quiet_NaN(); return; } if (is_inf(bd_)) { avi_->adj_ += std::numeric_limits::quiet_NaN(); return; } // return zero derivative as gamma_p is flat // to machine precision for b / a > 10 if (std::fabs(bd_ / avi_->val_) > 10) { return; } avi_->adj_ += adj_ * grad_reg_lower_inc_gamma(avi_->val_, bd_); } }; class gamma_p_dv_vari : public op_dv_vari { public: gamma_p_dv_vari(double a, vari* bvi) : op_dv_vari(gamma_p(a, bvi->val_), a, bvi) {} void chain() { if (is_inf(ad_)) { bvi_->adj_ += std::numeric_limits::quiet_NaN(); return; } if (is_inf(bvi_->val_)) { bvi_->adj_ += std::numeric_limits::quiet_NaN(); return; } // return zero derivative as gamma_p is flat to // machine precision for b / a > 10 if (std::fabs(bvi_->val_ / ad_) > 10) { return; } bvi_->adj_ += adj_ * std::exp(-bvi_->val_ + (ad_ - 1.0) * std::log(bvi_->val_) - lgamma(ad_)); } }; } // namespace internal inline var gamma_p(const var& a, const var& b) { return var(new internal::gamma_p_vv_vari(a.vi_, b.vi_)); } inline var gamma_p(const var& a, double b) { return var(new internal::gamma_p_vd_vari(a.vi_, b)); } inline var gamma_p(double a, const var& b) { return var(new internal::gamma_p_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/exp2.hpp0000644000176200001440000000225413766554456022676 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_EXP2_HPP #define STAN_MATH_REV_SCAL_FUN_EXP2_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class exp2_vari : public op_v_vari { public: explicit exp2_vari(vari* avi) : op_v_vari(std::exp2(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * val_ * LOG_2; } }; } // namespace internal /** * Exponentiation base 2 function for variables (C99). * * The derivative is * * \f$\frac{d}{dx} 2^x = (\log 2) 2^x\f$. * \f[ \mbox{exp2}(x) = \begin{cases} 2^x & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{exp2}(x)}{\partial x} = \begin{cases} 2^x\ln2 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a The variable. * @return Two to the power of the specified variable. */ inline var exp2(const var& a) { return var(new internal::exp2_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log2.hpp0000644000176200001440000000250513766554456022662 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG2_HPP #define STAN_MATH_REV_SCAL_FUN_LOG2_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class log2_vari : public op_v_vari { public: explicit log2_vari(vari* avi) : op_v_vari(log2(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (LOG_2 * avi_->val_); } }; } // namespace internal /** * Returns the base 2 logarithm of the specified variable (C99). * * See log2() for the double-based version. * * The derivative is * * \f$\frac{d}{dx} \log_2 x = \frac{1}{x \log 2}\f$. * \f[ \mbox{log2}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < 0 \\ \log_2(x) & \mbox{if } x\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{log2}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < 0 \\ \frac{1}{x\ln2} & \mbox{if } x\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Specified variable. * @return Base 2 logarithm of the variable. */ inline var log2(const var& a) { return var(new internal::log2_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/fdim.hpp0000644000176200001440000000723313766554456022741 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FDIM_HPP #define STAN_MATH_REV_SCAL_FUN_FDIM_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class fdim_vv_vari : public op_vv_vari { public: fdim_vv_vari(vari* avi, vari* bvi) : op_vv_vari(avi->val_ - bvi->val_, avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; bvi_->adj_ -= adj_; } } }; class fdim_vd_vari : public op_vd_vari { public: fdim_vd_vari(vari* avi, double b) : op_vd_vari(avi->val_ - b, avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; } } }; class fdim_dv_vari : public op_dv_vari { public: fdim_dv_vari(double a, vari* bvi) : op_dv_vari(a - bvi->val_, a, bvi) {} void chain() { if (unlikely(is_any_nan(bvi_->val_, ad_))) { bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { bvi_->adj_ -= adj_; } } }; } // namespace internal /** * Return the positive difference between the first variable's the value * and the second's (C99, C++11). * * The function values and deriatives are defined by * \f[ \mbox{fdim}(x, y) = \begin{cases} x-y & \mbox{if } x > y \\[6pt] 0 & \mbox{otherwise} \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fdim}(x, y)}{\partial x} = \begin{cases} 1 & \mbox{if } x > y \\[6pt] 0 & \mbox{otherwise} \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fdim}(x, y)}{\partial y} = \begin{cases} -1 & \mbox{if } x > y \\[6pt] 0 & \mbox{otherwise} \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return The positive difference between the first and second * variable. */ inline var fdim(const var& a, const var& b) { // reversed test to get NaN vals automatically in second case return (a.vi_->val_ <= b.vi_->val_) ? var(new vari(0.0)) : var(new internal::fdim_vv_vari(a.vi_, b.vi_)); } /** * Return the positive difference between the first value and the * value of the second variable (C99, C++11). * * See fdim(var, var) for definitions of values and * derivatives. * * @param a First value. * @param b Second variable. * @return The positive difference between the first and second * arguments. */ inline var fdim(double a, const var& b) { // reversed test to get NaN vals automatically in second case return a <= b.vi_->val_ ? var(new vari(0.0)) : var(new internal::fdim_dv_vari(a, b.vi_)); } /** * Return the positive difference between the first variable's value * and the second value (C99, C++11). * * See fdim(var, var) for definitions of values and * derivatives. * * @param a First value. * @param b Second variable. * @return The positive difference between the first and second arguments. */ inline var fdim(const var& a, double b) { // reversed test to get NaN vals automatically in second case return a.vi_->val_ <= b ? var(new vari(0.0)) : var(new internal::fdim_vd_vari(a.vi_, b)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inc_beta.hpp0000644000176200001440000000244013766554456023561 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INC_BETA_HPP #define STAN_MATH_REV_SCAL_FUN_INC_BETA_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class inc_beta_vvv_vari : public op_vvv_vari { public: inc_beta_vvv_vari(vari* avi, vari* bvi, vari* cvi) : op_vvv_vari(inc_beta(avi->val_, bvi->val_, cvi->val_), avi, bvi, cvi) {} void chain() { double d_a; double d_b; const double beta_ab = beta(avi_->val_, bvi_->val_); grad_reg_inc_beta(d_a, d_b, avi_->val_, bvi_->val_, cvi_->val_, digamma(avi_->val_), digamma(bvi_->val_), digamma(avi_->val_ + bvi_->val_), beta_ab); avi_->adj_ += adj_ * d_a; bvi_->adj_ += adj_ * d_b; cvi_->adj_ += adj_ * std::pow(1 - cvi_->val_, bvi_->val_ - 1) * std::pow(cvi_->val_, avi_->val_ - 1) / beta_ab; } }; } // namespace internal inline var inc_beta(const var& a, const var& b, const var& c) { return var(new internal::inc_beta_vvv_vari(a.vi_, b.vi_, c.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/squared_distance.hpp0000644000176200001440000000315513766554456025337 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_SQUARED_DISTANCE_HPP #define STAN_MATH_REV_SCAL_FUN_SQUARED_DISTANCE_HPP #include #include #include namespace stan { namespace math { class scal_squared_distance_vv_vari : public op_vv_vari { public: scal_squared_distance_vv_vari(vari* avi, vari* bvi) : op_vv_vari(squared_distance(avi->val_, bvi->val_), avi, bvi) {} void chain() { double diff = avi_->val_ - bvi_->val_; avi_->adj_ += adj_ * 2.0 * diff; bvi_->adj_ -= adj_ * 2.0 * diff; } }; class scal_squared_distance_vd_vari : public op_vd_vari { public: scal_squared_distance_vd_vari(vari* avi, double b) : op_vd_vari(squared_distance(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * 2 * (avi_->val_ - bd_); } }; class scal_squared_distance_dv_vari : public op_dv_vari { public: scal_squared_distance_dv_vari(double a, vari* bvi) : op_dv_vari(squared_distance(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ -= adj_ * 2 * (ad_ - bvi_->val_); } }; /** * Returns the log sum of exponentials. */ inline var squared_distance(const var& a, const var& b) { return var(new scal_squared_distance_vv_vari(a.vi_, b.vi_)); } /** * Returns the log sum of exponentials. */ inline var squared_distance(const var& a, double b) { return var(new scal_squared_distance_vd_vari(a.vi_, b)); } /** * Returns the log sum of exponentials. */ inline var squared_distance(double a, const var& b) { return var(new scal_squared_distance_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/pow.hpp0000644000176200001440000001033713766554456022626 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_POW_HPP #define STAN_MATH_REV_SCAL_FUN_POW_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class pow_vv_vari : public op_vv_vari { public: pow_vv_vari(vari* avi, vari* bvi) : op_vv_vari(std::pow(avi->val_, bvi->val_), avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { if (avi_->val_ == 0.0) { return; // partials zero, avoids 0 & log(0) } avi_->adj_ += adj_ * bvi_->val_ * val_ / avi_->val_; bvi_->adj_ += adj_ * std::log(avi_->val_) * val_; } } }; class pow_vd_vari : public op_vd_vari { public: pow_vd_vari(vari* avi, double b) : op_vd_vari(std::pow(avi->val_, b), avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { if (avi_->val_ == 0.0) { return; // partials zero, avoids 0 & log(0) } avi_->adj_ += adj_ * bd_ * val_ / avi_->val_; } } }; class pow_dv_vari : public op_dv_vari { public: pow_dv_vari(double a, vari* bvi) : op_dv_vari(std::pow(a, bvi->val_), a, bvi) {} void chain() { if (unlikely(is_any_nan(bvi_->val_, ad_))) { bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { if (ad_ == 0.0) { return; // partials zero, avoids 0 & log(0) } bvi_->adj_ += adj_ * std::log(ad_) * val_; } } }; } // namespace internal /** * Return the base raised to the power of the exponent (cmath). * * The partial derivatives are * * \f$\frac{\partial}{\partial x} \mbox{pow}(x, y) = y x^{y-1}\f$, and * * \f$\frac{\partial}{\partial y} \mbox{pow}(x, y) = x^y \ \log x\f$. * * \f[ \mbox{pow}(x, y) = \begin{cases} x^y & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{pow}(x, y)}{\partial x} = \begin{cases} yx^{y-1} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{pow}(x, y)}{\partial y} = \begin{cases} x^y\ln x & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param base Base variable. * @param exponent Exponent variable. * @return Base raised to the exponent. */ inline var pow(const var& base, const var& exponent) { return var(new internal::pow_vv_vari(base.vi_, exponent.vi_)); } /** * Return the base variable raised to the power of the exponent * scalar (cmath). * * The derivative for the variable is * * \f$\frac{d}{dx} \mbox{pow}(x, c) = c x^{c-1}\f$. * * @param base Base variable. * @param exponent Exponent scalar. * @return Base raised to the exponent. */ inline var pow(const var& base, double exponent) { if (exponent == 0.5) { return sqrt(base); } if (exponent == 1.0) { return base; } if (exponent == 2.0) { return square(base); } if (exponent == -2.0) { return inv_square(base); } if (exponent == -1.0) { return inv(base); } if (exponent == -0.5) { return inv_sqrt(base); } return var(new internal::pow_vd_vari(base.vi_, exponent)); } /** * Return the base scalar raised to the power of the exponent * variable (cmath). * * The derivative for the variable is * * \f$\frac{d}{d y} \mbox{pow}(c, y) = c^y \log c \f$. * * @param base Base scalar. * @param exponent Exponent variable. * @return Base raised to the exponent. */ inline var pow(double base, const var& exponent) { return var(new internal::pow_dv_vari(base, exponent.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/boost_isnormal.hpp0000644000176200001440000000120013766554456025040 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BOOST_ISNORMAL_HPP #define STAN_MATH_REV_SCAL_FUN_BOOST_ISNORMAL_HPP #include #include #include namespace boost { namespace math { /** * Checks if the given number is normal. * * Return true if the specified variable * has a value that is normal. * * @param v Variable to test. * @return true if variable is normal. */ template <> inline bool isnormal(const stan::math::var& v) { return (boost::math::isnormal)(v.val()); } } // namespace math } // namespace boost #endif StanHeaders/inst/include/stan/math/rev/scal/fun/cosh.hpp0000644000176200001440000000222213766554456022747 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_COSH_HPP #define STAN_MATH_REV_SCAL_FUN_COSH_HPP #include #include #include namespace stan { namespace math { namespace internal { class cosh_vari : public op_v_vari { public: explicit cosh_vari(vari* avi) : op_v_vari(std::cosh(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * std::sinh(avi_->val_); } }; } // namespace internal /** * Return the hyperbolic cosine of the specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \cosh x = \sinh x\f$. * * \f[ \mbox{cosh}(x) = \begin{cases} \cosh(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{cosh}(x)}{\partial x} = \begin{cases} \sinh(x) & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable. * @return Hyperbolic cosine of variable. */ inline var cosh(const var& a) { return var(new internal::cosh_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/exp.hpp0000644000176200001440000000204213766554456022607 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_EXP_HPP #define STAN_MATH_REV_SCAL_FUN_EXP_HPP #include #include #include namespace stan { namespace math { namespace internal { class exp_vari : public op_v_vari { public: explicit exp_vari(vari* avi) : op_v_vari(std::exp(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * val_; } }; } // namespace internal /** * Return the exponentiation of the specified variable (cmath). * \f[ \mbox{exp}(x) = \begin{cases} e^x & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{exp}(x)}{\partial x} = \begin{cases} e^x & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable to exponentiate. * @return Exponentiated variable. */ inline var exp(const var& a) { return var(new internal::exp_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/boost_fpclassify.hpp0000644000176200001440000000151713766554456025372 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_BOOST_FPCLASSIFY_HPP #define STAN_MATH_REV_SCAL_FUN_BOOST_FPCLASSIFY_HPP #include #include #include namespace boost { namespace math { /** * Categorizes the given stan::math::var value. * * Categorizes the stan::math::var value, v, into the following categories: * zero, subnormal, normal, infinite, or NAN. * * @param v Variable to classify. * @return One of FP_ZERO, FP_NORMAL, * FP_FINITE, FP_INFINITE, FP_NAN, * or FP_SUBZERO, specifying the category of v. */ template <> inline int fpclassify(const stan::math::var& v) { return (boost::math::fpclassify)(v.val()); } } // namespace math } // namespace boost #endif StanHeaders/inst/include/stan/math/rev/scal/fun/value_of.hpp0000644000176200001440000000141113766554456023612 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_VALUE_OF_HPP #define STAN_MATH_REV_SCAL_FUN_VALUE_OF_HPP #include #include namespace stan { namespace math { /** * Return the value of the specified variable. * *

This function is used internally by auto-dif functions along * with value_of(T x) to extract the * double value of either a scalar or an auto-dif * variable. This function will be called when the argument is a * var even if the function is not * referred to by namespace because of argument-dependent lookup. * * @param v Variable. * @return Value of variable. */ inline double value_of(const var& v) { return v.vi_->val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_falling_factorial.hpp0000644000176200001440000000443113766554456026320 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_FALLING_FACTORIAL_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_FALLING_FACTORIAL_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class log_falling_factorial_vv_vari : public op_vv_vari { public: log_falling_factorial_vv_vari(vari* avi, vari* bvi) : op_vv_vari(log_falling_factorial(avi->val_, bvi->val_), avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * (digamma(avi_->val_ + 1) - digamma(avi_->val_ - bvi_->val_ + 1)); bvi_->adj_ += adj_ * digamma(avi_->val_ - bvi_->val_ + 1); } } }; class log_falling_factorial_vd_vari : public op_vd_vari { public: log_falling_factorial_vd_vari(vari* avi, double b) : op_vd_vari(log_falling_factorial(avi->val_, b), avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * (digamma(avi_->val_ + 1) - digamma(avi_->val_ - bd_ + 1)); } } }; class log_falling_factorial_dv_vari : public op_dv_vari { public: log_falling_factorial_dv_vari(double a, vari* bvi) : op_dv_vari(log_falling_factorial(a, bvi->val_), a, bvi) {} void chain() { if (unlikely(is_any_nan(ad_, bvi_->val_))) { bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { bvi_->adj_ += adj_ * digamma(ad_ - bvi_->val_ + 1); } } }; } // namespace internal inline var log_falling_factorial(const var& a, double b) { return var(new internal::log_falling_factorial_vd_vari(a.vi_, b)); } inline var log_falling_factorial(const var& a, const var& b) { return var(new internal::log_falling_factorial_vv_vari(a.vi_, b.vi_)); } inline var log_falling_factorial(double a, const var& b) { return var(new internal::log_falling_factorial_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/erfc.hpp0000644000176200001440000000306613766554456022741 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ERFC_HPP #define STAN_MATH_REV_SCAL_FUN_ERFC_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class erfc_vari : public op_v_vari { public: explicit erfc_vari(vari* avi) : op_v_vari(erfc(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * NEG_TWO_OVER_SQRT_PI * std::exp(-avi_->val_ * avi_->val_); } }; } // namespace internal /** * The complementary error function for variables (C99). * * The derivative is * * \f$\frac{d}{dx} \mbox{erfc}(x) = - \frac{2}{\sqrt{\pi}} \exp(-x^2)\f$. * * \f[ \mbox{erfc}(x) = \begin{cases} \operatorname{erfc}(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{erfc}(x)}{\partial x} = \begin{cases} \frac{\partial\, \operatorname{erfc}(x)}{\partial x} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \operatorname{erfc}(x)=\frac{2}{\sqrt{\pi}}\int_x^\infty e^{-t^2}dt \f] \f[ \frac{\partial \, \operatorname{erfc}(x)}{\partial x} = -\frac{2}{\sqrt{\pi}} e^{-x^2} \f] * * @param a The variable. * @return Complementary error function applied to the variable. */ inline var erfc(const var& a) { return var(new internal::erfc_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/value_of_rec.hpp0000644000176200001440000000073613766554456024454 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_VALUE_OF_REC_HPP #define STAN_MATH_REV_SCAL_FUN_VALUE_OF_REC_HPP #include #include #include namespace stan { namespace math { /** * Return the value of the specified variable. * * @param v Variable. * @return Value of variable. */ inline double value_of_rec(const var& v) { return v.vi_->val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/is_nan.hpp0000644000176200001440000000107113766554456023263 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_IS_NAN_HPP #define STAN_MATH_REV_SCAL_FUN_IS_NAN_HPP #include #include #include namespace stan { namespace math { /** * Returns 1 if the input's value is NaN and 0 otherwise. * * Delegates to is_nan(double). * * @param v Value to test. * * @return 1 if the value is NaN and 0 otherwise. */ inline bool is_nan(const var& v) { return is_nan(v.val()); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/Phi.hpp0000644000176200001440000000335513766554456022543 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_PHI_HPP #define STAN_MATH_REV_SCAL_FUN_PHI_HPP #include #include #include namespace stan { namespace math { namespace internal { class Phi_vari : public op_v_vari { public: explicit Phi_vari(vari* avi) : op_v_vari(Phi(avi->val_), avi) {} void chain() { static const double NEG_HALF = -0.5; avi_->adj_ += adj_ * INV_SQRT_TWO_PI * std::exp(NEG_HALF * avi_->val_ * avi_->val_); } }; } // namespace internal /** * The unit normal cumulative density function for variables (stan). * * See Phi() for the double-based version. * * The derivative is the unit normal density function, * * \f$\frac{d}{dx} \Phi(x) = \mbox{\sf Norm}(x|0, 1) = \frac{1}{\sqrt{2\pi}} \exp(-\frac{1}{2} x^2)\f$. * * \f[ \mbox{Phi}(x) = \begin{cases} 0 & \mbox{if } x < -37.5 \\ \Phi(x) & \mbox{if } -37.5 \leq x \leq 8.25 \\ 1 & \mbox{if } x > 8.25 \\[6pt] \textrm{error} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{Phi}(x)}{\partial x} = \begin{cases} 0 & \mbox{if } x < -27.5 \\ \frac{\partial\, \Phi(x)}{\partial x} & \mbox{if } -27.5 \leq x \leq 27.5 \\ 0 & \mbox{if } x > 27.5 \\[6pt] \textrm{error} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \Phi(x) = \frac{1}{\sqrt{2\pi}} \int_{0}^{x} e^{-t^2/2} dt \f] \f[ \frac{\partial \, \Phi(x)}{\partial x} = \frac{e^{-x^2/2}}{\sqrt{2\pi}} \f] * * @param a Variable argument. * @return The unit normal cdf evaluated at the specified argument. */ inline var Phi(const var& a) { return var(new internal::Phi_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/to_var.hpp0000644000176200001440000000171113766554456023307 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_TO_VAR_HPP #define STAN_MATH_REV_SCAL_FUN_TO_VAR_HPP #include #include namespace stan { namespace math { /** * Converts argument to an automatic differentiation variable. * * Returns a var variable with the input value. * * @param[in] x A scalar value * @return An automatic differentiation variable with the input value. */ inline var to_var(double x) { return var(x); } /** * Specialization of to_var for non-const var input * * * @param[in,out] x An automatic differentiation variable. * @return The input automatic differentiation variable. */ inline var& to_var(var& x) { return x; } /** * Specialization of to_var for const var input * * * @param[in,out] x An automatic differentiation variable. * @return The input automatic differentiation variable. */ inline const var& to_var(const var& x) { return x; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/step.hpp0000644000176200001440000000143613766554456022774 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_STEP_HPP #define STAN_MATH_REV_SCAL_FUN_STEP_HPP #include #include namespace stan { namespace math { /** * Return the step, or heaviside, function applied to the * specified variable (stan). * * See step() for the double-based version. * * The derivative of the step function is zero everywhere * but at 0, so for convenience, it is taken to be everywhere * zero, * * \f$\mbox{step}(x) = 0\f$. * * @param a Variable argument. * @return The constant variable with value 1.0 if the argument's * value is greater than or equal to 0.0, and value 0.0 otherwise. */ inline var step(const var& a) { return var(new vari(a.vi_->val_ < 0.0 ? 0.0 : 1.0)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log10.hpp0000644000176200001440000000251613766554456022743 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG10_HPP #define STAN_MATH_REV_SCAL_FUN_LOG10_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class log10_vari : public op_v_vari { public: const double exp_val_; explicit log10_vari(vari* avi) : op_v_vari(std::log10(avi->val_), avi), exp_val_(avi->val_) {} void chain() { avi_->adj_ += adj_ / (LOG_10 * exp_val_); } }; } // namespace internal /** * Return the base 10 log of the specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \log_{10} x = \frac{1}{x \log 10}\f$. * * \f[ \mbox{log10}(x) = \begin{cases} \textrm{NaN} & \mbox{if } x < 0\\ \log_{10}(x) & \mbox{if } x \geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{log10}(x)}{\partial x} = \begin{cases} \textrm{NaN} & \mbox{if } x < 0\\ \frac{1}{x \ln10} & \mbox{if } x\geq 0 \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Variable whose log is taken. * @return Base 10 log of variable. */ inline var log10(const var& a) { return var(new internal::log10_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/atan2.hpp0000644000176200001440000000676113766554456023034 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ATAN2_HPP #define STAN_MATH_REV_SCAL_FUN_ATAN2_HPP #include #include #include namespace stan { namespace math { namespace internal { class atan2_vv_vari : public op_vv_vari { public: atan2_vv_vari(vari* avi, vari* bvi) : op_vv_vari(std::atan2(avi->val_, bvi->val_), avi, bvi) {} void chain() { double a_sq_plus_b_sq = (avi_->val_ * avi_->val_) + (bvi_->val_ * bvi_->val_); avi_->adj_ += adj_ * bvi_->val_ / a_sq_plus_b_sq; bvi_->adj_ -= adj_ * avi_->val_ / a_sq_plus_b_sq; } }; class atan2_vd_vari : public op_vd_vari { public: atan2_vd_vari(vari* avi, double b) : op_vd_vari(std::atan2(avi->val_, b), avi, b) {} void chain() { double a_sq_plus_b_sq = (avi_->val_ * avi_->val_) + (bd_ * bd_); avi_->adj_ += adj_ * bd_ / a_sq_plus_b_sq; } }; class atan2_dv_vari : public op_dv_vari { public: atan2_dv_vari(double a, vari* bvi) : op_dv_vari(std::atan2(a, bvi->val_), a, bvi) {} void chain() { double a_sq_plus_b_sq = (ad_ * ad_) + (bvi_->val_ * bvi_->val_); bvi_->adj_ -= adj_ * ad_ / a_sq_plus_b_sq; } }; } // namespace internal /** * Return the principal value of the arc tangent, in radians, of * the first variable divided by the second (cmath). * * The partial derivatives are defined by * * \f$ \frac{\partial}{\partial x} \arctan \frac{x}{y} = \frac{y}{x^2 + y^2}\f$, * and * * \f$ \frac{\partial}{\partial y} \arctan \frac{x}{y} = \frac{-x}{x^2 + * y^2}\f$. * * @param a Numerator variable. * @param b Denominator variable. * @return The arc tangent of the fraction, in radians. */ inline var atan2(const var& a, const var& b) { return var(new internal::atan2_vv_vari(a.vi_, b.vi_)); } /** * Return the principal value of the arc tangent, in radians, of * the first variable divided by the second scalar (cmath). * * The derivative with respect to the variable is * * \f$ \frac{d}{d x} \arctan \frac{x}{c} = \frac{c}{x^2 + c^2}\f$. * * @param a Numerator variable. * @param b Denominator scalar. * @return The arc tangent of the fraction, in radians. */ inline var atan2(const var& a, double b) { return var(new internal::atan2_vd_vari(a.vi_, b)); } /** * Return the principal value of the arc tangent, in radians, of * the first scalar divided by the second variable (cmath). * * The derivative with respect to the variable is * * \f$ \frac{\partial}{\partial y} \arctan \frac{c}{y} = \frac{-c}{c^2 + y^2}\f$. * * \f[ \mbox{atan2}(x, y) = \begin{cases} \arctan\left(\frac{x}{y}\right) & \mbox{if } -\infty\leq x \leq \infty, -\infty\leq y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{atan2}(x, y)}{\partial x} = \begin{cases} \frac{y}{x^2+y^2} & \mbox{if } -\infty\leq x\leq \infty, -\infty\leq y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{atan2}(x, y)}{\partial y} = \begin{cases} -\frac{x}{x^2+y^2} & \mbox{if } -\infty\leq x\leq \infty, -\infty\leq y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a Numerator scalar. * @param b Denominator variable. * @return The arc tangent of the fraction, in radians. */ inline var atan2(double a, const var& b) { return var(new internal::atan2_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_sum_exp.hpp0000644000176200001440000000354213766554456024342 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_SUM_EXP_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_SUM_EXP_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class log_sum_exp_vv_vari : public op_vv_vari { public: log_sum_exp_vv_vari(vari* avi, vari* bvi) : op_vv_vari(log_sum_exp(avi->val_, bvi->val_), avi, bvi) {} void chain() { avi_->adj_ += adj_ * calculate_chain(avi_->val_, val_); bvi_->adj_ += adj_ * calculate_chain(bvi_->val_, val_); } }; class log_sum_exp_vd_vari : public op_vd_vari { public: log_sum_exp_vd_vari(vari* avi, double b) : op_vd_vari(log_sum_exp(avi->val_, b), avi, b) {} void chain() { if (val_ == NEGATIVE_INFTY) { avi_->adj_ += adj_; } else { avi_->adj_ += adj_ * calculate_chain(avi_->val_, val_); } } }; class log_sum_exp_dv_vari : public op_dv_vari { public: log_sum_exp_dv_vari(double a, vari* bvi) : op_dv_vari(log_sum_exp(a, bvi->val_), a, bvi) {} void chain() { if (val_ == NEGATIVE_INFTY) { bvi_->adj_ += adj_; } else { bvi_->adj_ += adj_ * calculate_chain(bvi_->val_, val_); } } }; } // namespace internal /** * Returns the log sum of exponentials. */ inline var log_sum_exp(const var& a, const var& b) { return var(new internal::log_sum_exp_vv_vari(a.vi_, b.vi_)); } /** * Returns the log sum of exponentials. */ inline var log_sum_exp(const var& a, double b) { return var(new internal::log_sum_exp_vd_vari(a.vi_, b)); } /** * Returns the log sum of exponentials. */ inline var log_sum_exp(double a, const var& b) { return var(new internal::log_sum_exp_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/if_else.hpp0000644000176200001440000000276313766554456023433 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_IF_ELSE_HPP #define STAN_MATH_REV_SCAL_FUN_IF_ELSE_HPP #include #include namespace stan { namespace math { /** * If the specified condition is true, return the first * variable, otherwise return the second variable. * * @param c Boolean condition. * @param y_true Variable to return if condition is true. * @param y_false Variable to return if condition is false. */ inline var if_else(bool c, const var& y_true, const var& y_false) { return c ? y_true : y_false; } /** * If the specified condition is true, return a new variable * constructed from the first scalar, otherwise return the second * variable. * * @param c Boolean condition. * @param y_true Value to promote to variable and return if condition is true. * @param y_false Variable to return if condition is false. */ inline var if_else(bool c, double y_true, const var& y_false) { if (c) { return var(y_true); } else { return y_false; } } /** * If the specified condition is true, return the first variable, * otherwise return a new variable constructed from the second * scalar. * * @param c Boolean condition. * @param y_true Variable to return if condition is true. * @param y_false Value to promote to variable and return if condition is false. */ inline var if_else(bool c, const var& y_true, double y_false) { if (c) { return y_true; } else { return var(y_false); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/is_inf.hpp0000644000176200001440000000107213766554456023264 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_IS_INF_HPP #define STAN_MATH_REV_SCAL_FUN_IS_INF_HPP #include #include #include namespace stan { namespace math { /** * Returns 1 if the input's value is infinite and 0 otherwise. * * Delegates to is_inf. * * @param v Value to test. * * @return 1 if the value is infinite and 0 otherwise. */ inline int is_inf(const var& v) { return is_inf(v.val()); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_rising_factorial.hpp0000644000176200001440000000335313766554456026201 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_RISING_FACTORIAL_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_RISING_FACTORIAL_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class log_rising_factorial_vv_vari : public op_vv_vari { public: log_rising_factorial_vv_vari(vari* avi, vari* bvi) : op_vv_vari(log_rising_factorial(avi->val_, bvi->val_), avi, bvi) {} void chain() { avi_->adj_ += adj_ * (digamma(avi_->val_ + bvi_->val_) - digamma(avi_->val_)); bvi_->adj_ += adj_ * digamma(avi_->val_ + bvi_->val_); } }; class log_rising_factorial_vd_vari : public op_vd_vari { public: log_rising_factorial_vd_vari(vari* avi, double b) : op_vd_vari(log_rising_factorial(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += adj_ * (digamma(avi_->val_ + bd_) - digamma(avi_->val_)); } }; class log_rising_factorial_dv_vari : public op_dv_vari { public: log_rising_factorial_dv_vari(double a, vari* bvi) : op_dv_vari(log_rising_factorial(a, bvi->val_), a, bvi) {} void chain() { bvi_->adj_ += adj_ * digamma(bvi_->val_ + ad_); } }; } // namespace internal inline var log_rising_factorial(const var& a, double b) { return var(new internal::log_rising_factorial_vd_vari(a.vi_, b)); } inline var log_rising_factorial(const var& a, const var& b) { return var(new internal::log_rising_factorial_vv_vari(a.vi_, b.vi_)); } inline var log_rising_factorial(double a, const var& b) { return var(new internal::log_rising_factorial_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/expm1.hpp0000644000176200001440000000225613766554456023054 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_EXPM1_HPP #define STAN_MATH_REV_SCAL_FUN_EXPM1_HPP #include #include #include namespace stan { namespace math { namespace internal { class expm1_vari : public op_v_vari { public: explicit expm1_vari(vari* avi) : op_v_vari(expm1(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * (val_ + 1); } }; } // namespace internal /** * The exponentiation of the specified variable minus 1 (C99). * * The derivative is given by * * \f$\frac{d}{dx} \exp(a) - 1 = \exp(a)\f$. * * \f[ \mbox{expm1}(x) = \begin{cases} e^x-1 & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{expm1}(x)}{\partial x} = \begin{cases} e^x & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a The variable. * @return Two to the power of the specified variable. */ inline var expm1(const var& a) { return var(new internal::expm1_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/inv.hpp0000644000176200001440000000172613766554456022617 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_INV_HPP #define STAN_MATH_REV_SCAL_FUN_INV_HPP #include #include #include namespace stan { namespace math { namespace internal { class inv_vari : public op_v_vari { public: explicit inv_vari(vari* avi) : op_v_vari(inv(avi->val_), avi) {} void chain() { avi_->adj_ -= adj_ / (avi_->val_ * avi_->val_); } }; } // namespace internal /** * \f[ \mbox{inv}(x) = \begin{cases} \frac{1}{x} & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{inv}(x)}{\partial x} = \begin{cases} -\frac{1}{x^2} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * */ inline var inv(const var& a) { return var(new internal::inv_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/atan.hpp0000644000176200001440000000251013766554456022736 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_ATAN_HPP #define STAN_MATH_REV_SCAL_FUN_ATAN_HPP #include #include #include namespace stan { namespace math { namespace internal { class atan_vari : public op_v_vari { public: explicit atan_vari(vari* avi) : op_v_vari(std::atan(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (1.0 + (avi_->val_ * avi_->val_)); } }; } // namespace internal /** * Return the principal value of the arc tangent, in radians, of the * specified variable (cmath). * * The derivative is defined by * * \f$\frac{d}{dx} \arctan x = \frac{1}{1 + x^2}\f$. * * \f[ \mbox{atan}(x) = \begin{cases} \arctan(x) & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{atan}(x)}{\partial x} = \begin{cases} \frac{\partial\, \arctan(x)}{\partial x} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial \, \arctan(x)}{\partial x} = \frac{1}{x^2+1} \f] * * @param a Variable in range [-1, 1]. * @return Arc tangent of variable, in radians. */ inline var atan(const var& a) { return var(new internal::atan_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/trigamma.hpp0000644000176200001440000000137713766554456023626 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_TRIGAMMA_HPP #define STAN_MATH_REV_SCAL_FUN_TRIGAMMA_HPP #include #include #include #include #include #include #include namespace stan { namespace math { /** * Return the value of the trigamma function at the specified * argument (i.e., the second derivative of the log Gamma function * at the specified argument). * * @param u argument * @return trigamma function at argument */ inline var trigamma(const var& u) { return trigamma_impl(u); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/cbrt.hpp0000644000176200001440000000225613766554456022754 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_CBRT_HPP #define STAN_MATH_REV_SCAL_FUN_CBRT_HPP #include #include #include namespace stan { namespace math { namespace internal { class cbrt_vari : public op_v_vari { public: explicit cbrt_vari(vari* avi) : op_v_vari(cbrt(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ / (3.0 * val_ * val_); } }; } // namespace internal /** * Returns the cube root of the specified variable (C99). * * The derivative is * * \f$\frac{d}{dx} x^{1/3} = \frac{1}{3 x^{2/3}}\f$. * \f[ \mbox{cbrt}(x) = \begin{cases} \sqrt[3]{x} & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{cbrt}(x)}{\partial x} = \begin{cases} \frac{1}{3x^{2/3}} & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Specified variable. * @return Cube root of the variable. */ inline var cbrt(const var& a) { return var(new internal::cbrt_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/digamma.hpp0000644000176200001440000000122213766554456023411 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_DIGAMMA_HPP #define STAN_MATH_REV_SCAL_FUN_DIGAMMA_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class digamma_vari : public op_v_vari { public: explicit digamma_vari(vari* avi) : op_v_vari(digamma(avi->val_), avi) {} void chain() { avi_->adj_ += adj_ * trigamma(avi_->val_); } }; } // namespace internal inline var digamma(const var& a) { return var(new internal::digamma_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/trunc.hpp0000644000176200001440000000271413766554456023154 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_TRUNC_HPP #define STAN_MATH_REV_SCAL_FUN_TRUNC_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class trunc_vari : public op_v_vari { public: explicit trunc_vari(vari* avi) : op_v_vari(trunc(avi->val_), avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } } }; } // namespace internal /** * Returns the truncatation of the specified variable (C99). * * See ::trunc() for the double-based version. * * The derivative is zero everywhere but at integer values, so for * convenience the derivative is defined to be everywhere zero, * * \f$\frac{d}{dx} \mbox{trunc}(x) = 0\f$. * * \f[ \mbox{trunc}(x) = \begin{cases} \lfloor x \rfloor & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{trunc}(x)}{\partial x} = \begin{cases} 0 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Specified variable. * @return Truncation of the variable. */ inline var trunc(const var& a) { return var(new internal::trunc_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/ldexp.hpp0000644000176200001440000000104613766554456023132 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LDEXP_HPP #define STAN_MATH_REV_SCAL_FUN_LDEXP_HPP #include #include namespace stan { namespace math { namespace { class ldexp_vari : public op_vd_vari { public: explicit ldexp_vari(vari* avi, int b) : op_vd_vari(ldexp(avi->val_, b), avi, b) {} void chain() { avi_->adj_ += ldexp(adj_, bd_); } }; } // namespace inline var ldexp(const var& a, int b) { return var(new ldexp_vari(a.vi_, b)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/fma.hpp0000644000176200001440000001607713766554456022573 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_FMA_HPP #define STAN_MATH_REV_SCAL_FUN_FMA_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class fma_vvv_vari : public op_vvv_vari { public: fma_vvv_vari(vari* avi, vari* bvi, vari* cvi) : op_vvv_vari(fma(avi->val_, bvi->val_, cvi->val_), avi, bvi, cvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_, cvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); cvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * bvi_->val_; bvi_->adj_ += adj_ * avi_->val_; cvi_->adj_ += adj_; } } }; class fma_vvd_vari : public op_vvd_vari { public: fma_vvd_vari(vari* avi, vari* bvi, double c) : op_vvd_vari(fma(avi->val_, bvi->val_, c), avi, bvi, c) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_, cd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * bvi_->val_; bvi_->adj_ += adj_ * avi_->val_; } } }; class fma_vdv_vari : public op_vdv_vari { public: fma_vdv_vari(vari* avi, double b, vari* cvi) : op_vdv_vari(fma(avi->val_, b, cvi->val_), avi, b, cvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, cvi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); cvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * bd_; cvi_->adj_ += adj_; } } }; class fma_vdd_vari : public op_vdd_vari { public: fma_vdd_vari(vari* avi, double b, double c) : op_vdd_vari(fma(avi->val_, b, c), avi, b, c) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_, cd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * bd_; } } }; class fma_ddv_vari : public op_ddv_vari { public: fma_ddv_vari(double a, double b, vari* cvi) : op_ddv_vari(fma(a, b, cvi->val_), a, b, cvi) {} void chain() { if (unlikely(is_any_nan(cvi_->val_, ad_, bd_))) { cvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { cvi_->adj_ += adj_; } } }; } // namespace internal /** * The fused multiply-add function for three variables (C99). * This function returns the product of the first two arguments * plus the third argument. * * The partial derivatives are * * \f$\frac{\partial}{\partial x} (x * y) + z = y\f$, and * * \f$\frac{\partial}{\partial y} (x * y) + z = x\f$, and * * \f$\frac{\partial}{\partial z} (x * y) + z = 1\f$. * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ inline var fma(const var& a, const var& b, const var& c) { return var(new internal::fma_vvv_vari(a.vi_, b.vi_, c.vi_)); } /** * The fused multiply-add function for two variables and a value * (C99). This function returns the product of the first two * arguments plus the third argument. * * The partial derivatives are * * \f$\frac{\partial}{\partial x} (x * y) + c = y\f$, and * * \f$\frac{\partial}{\partial y} (x * y) + c = x\f$. * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ template > inline var fma(const var& a, const var& b, Tc&& c) { return var(new internal::fma_vvd_vari(a.vi_, b.vi_, c)); } /** * The fused multiply-add function for a variable, value, and * variable (C99). This function returns the product of the first * two arguments plus the third argument. * * The partial derivatives are * * \f$\frac{\partial}{\partial x} (x * c) + z = c\f$, and * * \f$\frac{\partial}{\partial z} (x * c) + z = 1\f$. * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ template , typename = require_all_var_t> inline var fma(Ta&& a, Tb&& b, Tc&& c) { return var(new internal::fma_vdv_vari(a.vi_, b, c.vi_)); } /** * The fused multiply-add function for a variable and two values * (C99). This function returns the product of the first two * arguments plus the third argument. * * The double-based version * ::%fma(double, double, double) is defined in * <cmath>. * * The derivative is * * \f$\frac{d}{d x} (x * c) + d = c\f$. * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ template > inline var fma(const var& a, Tb&& b, Tc&& c) { return var(new internal::fma_vdd_vari(a.vi_, b, c)); } /** * The fused multiply-add function for a value, variable, and * value (C99). This function returns the product of the first * two arguments plus the third argument. * * The derivative is * * \f$\frac{d}{d y} (c * y) + d = c\f$, and * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ template > inline var fma(Ta&& a, const var& b, Tc&& c) { return var(new internal::fma_vdd_vari(b.vi_, a, c)); } /** * The fused multiply-add function for two values and a variable, * and value (C99). This function returns the product of the * first two arguments plus the third argument. * * The derivative is * * \f$\frac{\partial}{\partial z} (c * d) + z = 1\f$. * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ template > inline var fma(Ta&& a, Tb&& b, const var& c) { return var(new internal::fma_ddv_vari(a, b, c.vi_)); } /** * The fused multiply-add function for a value and two variables * (C99). This function returns the product of the first two * arguments plus the third argument. * * The partial derivaties are * * \f$\frac{\partial}{\partial y} (c * y) + z = c\f$, and * * \f$\frac{\partial}{\partial z} (c * y) + z = 1\f$. * * @param a First multiplicand. * @param b Second multiplicand. * @param c Summand. * @return Product of the multiplicands plus the summand, ($a * $b) + $c. */ template > inline var fma(Ta&& a, const var& b, const var& c) { return var(new internal::fma_vdv_vari(b.vi_, a, c.vi_)); // a-b symmetry } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/fun/log_mix.hpp0000644000176200001440000001101713766554456023453 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_FUN_LOG_MIX_HPP #define STAN_MATH_REV_SCAL_FUN_LOG_MIX_HPP #include #include #include #include #include namespace stan { namespace math { /* Computes shared terms in log_mix partial derivative calculations * * @param[in] theta_val value of mixing proportion theta. * @param[in] lambda1_val value of log density multiplied by theta. * @param[in] lambda2_val value of log density multiplied by 1 - theta. * @param[out] one_m_exp_lam2_m_lam1 shared term in deriv calculation. * @param[out] one_m_t_prod_exp_lam2_m_lam1 shared term in deriv calculation. * @param[out] one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1 shared term in deriv * calculation. */ inline void log_mix_partial_helper( double theta_val, double lambda1_val, double lambda2_val, double& one_m_exp_lam2_m_lam1, double& one_m_t_prod_exp_lam2_m_lam1, double& one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1) { using std::exp; double lam2_m_lam1 = lambda2_val - lambda1_val; double exp_lam2_m_lam1 = exp(lam2_m_lam1); one_m_exp_lam2_m_lam1 = 1 - exp_lam2_m_lam1; double one_m_t = 1 - theta_val; one_m_t_prod_exp_lam2_m_lam1 = one_m_t * exp_lam2_m_lam1; one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1 = 1 / (theta_val + one_m_t_prod_exp_lam2_m_lam1); } /** * Return the log mixture density with specified mixing proportion * and log densities and its derivative at each. * * \f[ * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \log \left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right). * \f] * * \f[ * \frac{\partial}{\partial \theta} * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \dfrac{\exp(\lambda_1) - \exp(\lambda_2)} * {\left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right)} * \f] * * \f[ * \frac{\partial}{\partial \lambda_1} * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \dfrac{\theta \exp(\lambda_1)} * {\left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right)} * \f] * * \f[ * \frac{\partial}{\partial \lambda_2} * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \dfrac{\theta \exp(\lambda_2)} * {\left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right)} * \f] * * @tparam T_theta theta scalar type. * @tparam T_lambda1 lambda1 scalar type. * @tparam T_lambda2 lambda2 scalar type. * * @param[in] theta mixing proportion in [0, 1]. * @param[in] lambda1 first log density. * @param[in] lambda2 second log density. * @return log mixture of densities in specified proportion */ template inline return_type_t log_mix( const T_theta& theta, const T_lambda1& lambda1, const T_lambda2& lambda2) { using std::log; operands_and_partials ops_partials( theta, lambda1, lambda2); double theta_double = value_of(theta); const double lambda1_double = value_of(lambda1); const double lambda2_double = value_of(lambda2); double log_mix_function_value = log_mix(theta_double, lambda1_double, lambda2_double); double one_m_exp_lam2_m_lam1(0.0); double one_m_t_prod_exp_lam2_m_lam1(0.0); double one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1(0.0); if (lambda1 > lambda2) { log_mix_partial_helper(theta_double, lambda1_double, lambda2_double, one_m_exp_lam2_m_lam1, one_m_t_prod_exp_lam2_m_lam1, one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1); } else { log_mix_partial_helper(1.0 - theta_double, lambda2_double, lambda1_double, one_m_exp_lam2_m_lam1, one_m_t_prod_exp_lam2_m_lam1, one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1); one_m_exp_lam2_m_lam1 = -one_m_exp_lam2_m_lam1; theta_double = one_m_t_prod_exp_lam2_m_lam1; one_m_t_prod_exp_lam2_m_lam1 = 1.0 - value_of(theta); } if (!is_constant_all::value) { ops_partials.edge1_.partials_[0] = one_m_exp_lam2_m_lam1 * one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1; } if (!is_constant_all::value) { ops_partials.edge2_.partials_[0] = theta_double * one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1; } if (!is_constant_all::value) { ops_partials.edge3_.partials_[0] = one_m_t_prod_exp_lam2_m_lam1 * one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1; } return ops_partials.build(log_mix_function_value); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/meta/0000755000176200001440000000000013766554456021442 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/scal/meta/partials_type.hpp0000644000176200001440000000077513766554456025044 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_META_PARTIALS_TYPE_HPP #define STAN_MATH_REV_SCAL_META_PARTIALS_TYPE_HPP #include #include #include #include namespace stan { /** * Specialization of partials type returns double if input type is a double. */ template struct partials_type> { using type = typename std::decay_t::Scalar; }; } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/meta/is_var.hpp0000644000176200001440000000072113766554456023436 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_META_IS_VAR_HPP #define STAN_MATH_REV_SCAL_META_IS_VAR_HPP #include #include #include namespace stan { /** * Specialization for checking if value of T minus cv qualifier is a var. */ template struct is_var>::value>> : std::true_type {}; } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/scal/meta/operands_and_partials.hpp0000644000176200001440000001213213766554456026506 0ustar liggesusers#ifndef STAN_MATH_REV_SCAL_META_OPERANDS_AND_PARTIALS_HPP #define STAN_MATH_REV_SCAL_META_OPERANDS_AND_PARTIALS_HPP #include #include #include #include #include #include #include namespace stan { namespace math { namespace internal { template <> class ops_partials_edge { public: double partial_; broadcast_array partials_; explicit ops_partials_edge(const var& op) : partial_(0), partials_(partial_), operand_(op) {} private: template friend class stan::math::operands_and_partials; const var& operand_; void dump_partials(double* partials) { *partials = this->partial_; } void dump_operands(vari** varis) { *varis = this->operand_.vi_; } int size() const { return 1; } }; } // namespace internal /** * This class builds partial derivatives with respect to a set of * operands. There are two reason for the generality of this * class. The first is to handle vector and scalar arguments * without needing to write additional code. The second is to use * this class for writing probability distributions that handle * primitives, reverse mode, and forward mode variables * seamlessly. * * Conceptually, this class is used when we want to manually calculate * the derivative of a function and store this manual result on the * autodiff stack in a sort of "compressed" form. Think of it like an * easy-to-use interface to rev/core/precomputed_gradients. * * This class now supports multivariate use-cases as well by * exposing edge#_.partials_vec * * This is the specialization for when the return type is var, * which should be for all of the reverse mode cases. * * NB: since ops_partials_edge.partials_ and ops_partials_edge.partials_vec * are sometimes represented internally as a broadcast_array, we need to take * care with assignments to them. Indeed, we can assign any right hand side * which allows for indexing to a broadcast_array. The resulting behaviour is * that the entry for the first index is what gets assigned. The most common * use-case should be where the rhs is some container of length 1. * * @tparam Op1 type of the first operand * @tparam Op2 type of the second operand * @tparam Op3 type of the third operand * @tparam Op4 type of the fourth operand * @tparam Op5 type of the fifth operand */ template class operands_and_partials { public: internal::ops_partials_edge edge1_; internal::ops_partials_edge edge2_; internal::ops_partials_edge edge3_; internal::ops_partials_edge edge4_; internal::ops_partials_edge edge5_; explicit operands_and_partials(const Op1& o1) : edge1_(o1) {} operands_and_partials(const Op1& o1, const Op2& o2) : edge1_(o1), edge2_(o2) {} operands_and_partials(const Op1& o1, const Op2& o2, const Op3& o3) : edge1_(o1), edge2_(o2), edge3_(o3) {} operands_and_partials(const Op1& o1, const Op2& o2, const Op3& o3, const Op4& o4) : edge1_(o1), edge2_(o2), edge3_(o3), edge4_(o4) {} operands_and_partials(const Op1& o1, const Op2& o2, const Op3& o3, const Op4& o4, const Op5& o5) : edge1_(o1), edge2_(o2), edge3_(o3), edge4_(o4), edge5_(o5) {} /** * Build the node to be stored on the autodiff graph. * This should contain both the value and the tangent. * * For scalars, we don't calculate any tangents. * For reverse mode, we end up returning a type of var that will calculate * the appropriate adjoint using the stored operands and partials. * Forward mode just calculates the tangent on the spot and returns it in * a vanilla fvar. * * @param value the return value of the function we are compressing * @return the node to be stored in the expression graph for autodiff */ var build(double value) { size_t size = edge1_.size() + edge2_.size() + edge3_.size() + edge4_.size() + edge5_.size(); vari** varis = ChainableStack::instance_->memalloc_.alloc_array(size); double* partials = ChainableStack::instance_->memalloc_.alloc_array(size); int idx = 0; edge1_.dump_operands(&varis[idx]); edge1_.dump_partials(&partials[idx]); edge2_.dump_operands(&varis[idx += edge1_.size()]); edge2_.dump_partials(&partials[idx]); edge3_.dump_operands(&varis[idx += edge2_.size()]); edge3_.dump_partials(&partials[idx]); edge4_.dump_operands(&varis[idx += edge3_.size()]); edge4_.dump_partials(&partials[idx]); edge5_.dump_operands(&varis[idx += edge4_.size()]); edge5_.dump_partials(&partials[idx]); return var(new precomputed_gradients_vari(value, size, varis, partials)); } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/0000755000176200001440000000000013766604372020513 5ustar liggesusersStanHeaders/inst/include/stan/math/rev/core/operator_greater_than.hpp0000644000176200001440000000240413766554456025611 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_GREATER_THAN_HPP #define STAN_MATH_REV_CORE_OPERATOR_GREATER_THAN_HPP #include namespace stan { namespace math { /** * Greater than operator comparing variables' values (C++). * \f[ \mbox{operator\textgreater}(x, y) = \begin{cases} 0 & \mbox{if } x \leq y\\ 1 & \mbox{if } x > y \\[6pt] 0 & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return True if first variable's value is greater than second's. */ inline bool operator>(const var& a, const var& b) { return a.val() > b.val(); } /** * Greater than operator comparing variable's value and double * (C++). * * @param a First variable. * @param b Second value. * @return True if first variable's value is greater than second value. */ inline bool operator>(const var& a, double b) { return a.val() > b; } /** * Greater than operator comparing a double and a variable's value * (C++). * * @param a First value. * @param b Second variable. * @return True if first value is greater than second variable's value. */ inline bool operator>(double a, const var& b) { return a > b.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vvd_vari.hpp0000644000176200001440000000063413766554456023056 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VVD_VARI_HPP #define STAN_MATH_REV_CORE_VVD_VARI_HPP #include namespace stan { namespace math { class op_vvd_vari : public vari { protected: vari* avi_; vari* bvi_; double cd_; public: op_vvd_vari(double f, vari* avi, vari* bvi, double c) : vari(f), avi_(avi), bvi_(bvi), cd_(c) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/precomp_vv_vari.hpp0000644000176200001440000000114013766554456024430 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_PRECOMP_VV_VARI_HPP #define STAN_MATH_REV_CORE_PRECOMP_VV_VARI_HPP #include #include namespace stan { namespace math { // use for single precomputed partials class precomp_vv_vari : public op_vv_vari { protected: double da_; double db_; public: precomp_vv_vari(double val, vari* avi, vari* bvi, double da, double db) : op_vv_vari(val, avi, bvi), da_(da), db_(db) {} void chain() { avi_->adj_ += adj_ * da_; bvi_->adj_ += adj_ * db_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/empty_nested.hpp0000644000176200001440000000062113766554456023732 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_EMPTY_NESTED_HPP #define STAN_MATH_REV_CORE_EMPTY_NESTED_HPP #include namespace stan { namespace math { /** * Return true if there is no nested autodiff being executed. */ static inline bool empty_nested() { return ChainableStack::instance_->nested_var_stack_sizes_.empty(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/dvv_vari.hpp0000644000176200001440000000063413766554456023056 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_DVV_VARI_HPP #define STAN_MATH_REV_CORE_DVV_VARI_HPP #include namespace stan { namespace math { class op_dvv_vari : public vari { protected: double ad_; vari* bvi_; vari* cvi_; public: op_dvv_vari(double f, double a, vari* bvi, vari* cvi) : vari(f), ad_(a), bvi_(bvi), cvi_(cvi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/std_isnan.hpp0000644000176200001440000000073613766554456023223 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_STD_ISNAN_HPP #define STAN_MATH_REV_CORE_STD_ISNAN_HPP #include #include namespace std { /** * Checks if the given number is NaN. * * Return true if the value of the * specified variable is not a number. * * @param a Variable to test. * @return true if value is not a number. */ inline int isnan(const stan::math::var& a) { return isnan(a.val()); } } // namespace std #endif StanHeaders/inst/include/stan/math/rev/core/std_numeric_limits.hpp0000644000176200001440000000520013766554456025125 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_STD_NUMERIC_LIMITS_HPP #define STAN_MATH_REV_CORE_STD_NUMERIC_LIMITS_HPP #include #include namespace std { /** * Specialization of numeric limits for var objects. * * This implementation of std::numeric_limits * is used to treat var objects like doubles. */ template <> struct numeric_limits { static const bool is_specialized = true; static stan::math::var min() { return numeric_limits::min(); } static stan::math::var max() { return numeric_limits::max(); } static const int digits = numeric_limits::digits; static const int digits10 = numeric_limits::digits10; static const bool is_signed = numeric_limits::is_signed; static const bool is_integer = numeric_limits::is_integer; static const bool is_exact = numeric_limits::is_exact; static const int radix = numeric_limits::radix; static stan::math::var epsilon() { return numeric_limits::epsilon(); } static stan::math::var round_error() { return numeric_limits::round_error(); } static const int min_exponent = numeric_limits::min_exponent; static const int min_exponent10 = numeric_limits::min_exponent10; static const int max_exponent = numeric_limits::max_exponent; static const int max_exponent10 = numeric_limits::max_exponent10; static const bool has_infinity = numeric_limits::has_infinity; static const bool has_quiet_NaN = numeric_limits::has_quiet_NaN; static const bool has_signaling_NaN = numeric_limits::has_signaling_NaN; static const float_denorm_style has_denorm = numeric_limits::has_denorm; static const bool has_denorm_loss = numeric_limits::has_denorm_loss; static stan::math::var infinity() { return numeric_limits::infinity(); } static stan::math::var quiet_NaN() { return numeric_limits::quiet_NaN(); } static stan::math::var signaling_NaN() { return numeric_limits::signaling_NaN(); } static stan::math::var denorm_min() { return numeric_limits::denorm_min(); } static const bool is_iec559 = numeric_limits::is_iec559; static const bool is_bounded = numeric_limits::is_bounded; static const bool is_modulo = numeric_limits::is_modulo; static const bool traps = numeric_limits::traps; static const bool tinyness_before = numeric_limits::tinyness_before; static const float_round_style round_style = numeric_limits::round_style; }; } // namespace std #endif StanHeaders/inst/include/stan/math/rev/core/dv_vari.hpp0000644000176200001440000000055613766554456022673 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_DV_VARI_HPP #define STAN_MATH_REV_CORE_DV_VARI_HPP #include namespace stan { namespace math { class op_dv_vari : public vari { protected: double ad_; vari* bvi_; public: op_dv_vari(double f, double a, vari* bvi) : vari(f), ad_(a), bvi_(bvi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_logical_and.hpp0000644000176200001440000000234513766554456025406 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_LOGICAL_AND_HPP #define STAN_MATH_REV_CORE_OPERATOR_LOGICAL_AND_HPP #include namespace stan { namespace math { /** * Return the logical conjunction of the values of the two * arguments as defined by &&. * * @param[in] x first argument * @param[in] y second argument * @return disjuntion of the argument's values */ inline bool operator&&(const var& x, const var& y) { return x.val() && y.val(); } /** * Return the logical conjunction of the values of the two * arguments as defined by &&. * * @param[in] x first argument * @param[in] y second argument * @return conjunction of first argument's value and second * argument */ template inline bool operator&&(const var& x, double y) { return x.val() && y; } /** * Return the logical conjunction of the values of the two * arguments as defined by &&. * * @param[in] x first argument * @param[in] y second argument * @return conjunction of first argument and second argument's * value */ template inline bool operator&&(double x, const var& y) { return x && y.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/precomp_vvv_vari.hpp0000644000176200001440000000131213766554456024617 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_PRECOMP_VVV_VARI_HPP #define STAN_MATH_REV_CORE_PRECOMP_VVV_VARI_HPP #include #include namespace stan { namespace math { // use for single precomputed partials class precomp_vvv_vari : public op_vvv_vari { protected: double da_; double db_; double dc_; public: precomp_vvv_vari(double val, vari* avi, vari* bvi, vari* cvi, double da, double db, double dc) : op_vvv_vari(val, avi, bvi, cvi), da_(da), db_(db), dc_(dc) {} void chain() { avi_->adj_ += adj_ * da_; bvi_->adj_ += adj_ * db_; cvi_->adj_ += adj_ * dc_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_less_than_or_equal.hpp0000644000176200001440000000253613766554456027023 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_LESS_THAN_OR_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_LESS_THAN_OR_EQUAL_HPP #include namespace stan { namespace math { /** * Less than or equal operator comparing two variables' values * (C++). \f[ \mbox{operator\textless=}(x, y) = \begin{cases} 0 & \mbox{if } x > y\\ 1 & \mbox{if } x \leq y \\[6pt] 0 & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return True if first variable's value is less than or equal to * the second's. */ inline bool operator<=(const var& a, const var& b) { return a.val() <= b.val(); } /** * Less than or equal operator comparing a variable's value and a * scalar (C++). * * @param a First variable. * @param b Second value. * @return True if first variable's value is less than or equal to * the second value. */ inline bool operator<=(const var& a, double b) { return a.val() <= b; } /** * Less than or equal operator comparing a double and variable's * value (C++). * * @param a First value. * @param b Second variable. * @return True if first value is less than or equal to the second * variable's value. */ inline bool operator<=(double a, const var& b) { return a <= b.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/dvd_vari.hpp0000644000176200001440000000063013766554456023030 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_DVD_VARI_HPP #define STAN_MATH_REV_CORE_DVD_VARI_HPP #include namespace stan { namespace math { class op_dvd_vari : public vari { protected: double ad_; vari* bvi_; double cd_; public: op_dvd_vari(double f, double a, vari* bvi, double c) : vari(f), ad_(a), bvi_(bvi), cd_(c) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/recover_memory.hpp0000644000176200001440000000170313766554456024271 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_RECOVER_MEMORY_HPP #define STAN_MATH_REV_CORE_RECOVER_MEMORY_HPP #include #include #include #include namespace stan { namespace math { /** * Recover memory used for all variables for reuse. * * @throw std::logic_error if empty_nested() returns * false */ static inline void recover_memory() { if (!empty_nested()) { throw std::logic_error( "empty_nested() must be true" " before calling recover_memory()"); } ChainableStack::instance_->var_stack_.clear(); ChainableStack::instance_->var_nochain_stack_.clear(); for (auto &x : ChainableStack::instance_->var_alloc_stack_) { delete x; } ChainableStack::instance_->var_alloc_stack_.clear(); ChainableStack::instance_->memalloc_.recover_all(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_minus_equal.hpp0000644000176200001440000000104113766554456025464 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_MINUS_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_MINUS_EQUAL_HPP #include #include namespace stan { namespace math { inline var& var::operator-=(const var& b) { vi_ = new internal::subtract_vv_vari(vi_, b.vi_); return *this; } inline var& var::operator-=(double b) { if (b == 0.0) { return *this; } vi_ = new internal::subtract_vd_vari(vi_, b); return *this; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/set_zero_all_adjoints.hpp0000644000176200001440000000114713766554456025613 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_SET_ZERO_ALL_ADJOINTS_HPP #define STAN_MATH_REV_CORE_SET_ZERO_ALL_ADJOINTS_HPP #include #include #include namespace stan { namespace math { /** * Reset all adjoint values in the stack to zero. */ static void set_zero_all_adjoints() { for (auto &x : ChainableStack::instance_->var_stack_) { x->set_zero_adjoint(); } for (auto &x : ChainableStack::instance_->var_nochain_stack_) { x->set_zero_adjoint(); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/recover_memory_nested.hpp0000644000176200001440000000322113766554456025630 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_RECOVER_MEMORY_NESTED_HPP #define STAN_MATH_REV_CORE_RECOVER_MEMORY_NESTED_HPP #include #include #include #include namespace stan { namespace math { /** * Recover only the memory used for the top nested call. If there * is nothing on the nested stack, then a * std::logic_error exception is thrown. * * @throw std::logic_error if empty_nested() returns * true */ static inline void recover_memory_nested() { if (empty_nested()) { throw std::logic_error( "empty_nested() must be false" " before calling recover_memory_nested()"); } ChainableStack::instance_->var_stack_.resize( ChainableStack::instance_->nested_var_stack_sizes_.back()); ChainableStack::instance_->nested_var_stack_sizes_.pop_back(); ChainableStack::instance_->var_nochain_stack_.resize( ChainableStack::instance_->nested_var_nochain_stack_sizes_.back()); ChainableStack::instance_->nested_var_nochain_stack_sizes_.pop_back(); for (size_t i = ChainableStack::instance_->nested_var_alloc_stack_starts_.back(); i < ChainableStack::instance_->var_alloc_stack_.size(); ++i) { delete ChainableStack::instance_->var_alloc_stack_[i]; } ChainableStack::instance_->var_alloc_stack_.resize( ChainableStack::instance_->nested_var_alloc_stack_starts_.back()); ChainableStack::instance_->nested_var_alloc_stack_starts_.pop_back(); ChainableStack::instance_->memalloc_.recover_nested(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vari.hpp0000644000176200001440000001026413766554456022177 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VARI_HPP #define STAN_MATH_REV_CORE_VARI_HPP #include #include #include namespace stan { namespace math { // forward declaration of var class var; /** * The variable implementation base class. * * This class is complete (not abstract) and may be used for * constants. * * A variable implementation is constructed with a constant * value. It also stores the adjoint for storing the partial * derivative with respect to the root of the derivative tree. * * The chain() method applies the chain rule. Concrete extensions * of this class will represent base variables or the result * of operations such as addition or subtraction. These extended * classes will store operand variables and propagate derivative * information via an implementation of chain(). */ class vari { private: friend class var; public: /** * The value of this variable. */ const double val_; /** * The adjoint of this variable, which is the partial derivative * of this variable with respect to the root variable. */ double adj_; /** * Construct a variable implementation from a value. The * adjoint is initialized to zero. * * All constructed variables are added to the stack. Variables * should be constructed before variables on which they depend * to insure proper partial derivative propagation. During * derivative propagation, the chain() method of each variable * will be called in the reverse order of construction. * * @param x Value of the constructed variable. */ explicit vari(double x) : val_(x), adj_(0.0) { ChainableStack::instance_->var_stack_.push_back(this); } vari(double x, bool stacked) : val_(x), adj_(0.0) { if (stacked) { ChainableStack::instance_->var_stack_.push_back(this); } else { ChainableStack::instance_->var_nochain_stack_.push_back(this); } } /** * Throw an illegal argument exception. * * Warning: Destructors should never called for var objects. * * @throw Logic exception always. */ virtual ~vari() { // this will never get called } /** * Apply the chain rule to this variable based on the variables * on which it depends. The base implementation in this class * is a no-op. */ virtual void chain() {} /** * Initialize the adjoint for this (dependent) variable to 1. * This operation is applied to the dependent variable before * propagating derivatives, setting the derivative of the * result with respect to itself to be 1. */ void init_dependent() { adj_ = 1.0; } /** * Set the adjoint value of this variable to 0. This is used to * reset adjoints before propagating derivatives again (for * example in a Jacobian calculation). */ void set_zero_adjoint() { adj_ = 0.0; } /** * Insertion operator for vari. Prints the current value and * the adjoint value. * * @param os [in, out] ostream to modify * @param v [in] vari object to print. * * @return The modified ostream. */ friend std::ostream& operator<<(std::ostream& os, const vari* v) { return os << v->val_ << ":" << v->adj_; } /** * Allocate memory from the underlying memory pool. This memory is * is managed as a whole externally. * * Warning: Classes should not be allocated with this operator * if they have non-trivial destructors. * * @param nbytes Number of bytes to allocate. * @return Pointer to allocated bytes. */ static inline void* operator new(size_t nbytes) { return ChainableStack::instance_->memalloc_.alloc(nbytes); } /** * Delete a pointer from the underlying memory pool. * * This no-op implementation enables a subclass to throw * exceptions in its constructor. An exception thrown in the * constructor of a subclass will result in an error being * raised, which is in turn caught and calls delete(). * * See the discussion of "plugging the memory leak" in: * http://www.parashift.com/c++-faq/memory-pools.html */ static inline void operator delete(void* /* ignore arg */) { /* no op */ } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/build_vari_array.hpp0000644000176200001440000000152013766554456024547 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_BUILD_VARI_ARRAY_HPP #define STAN_MATH_REV_CORE_BUILD_VARI_ARRAY_HPP #include #include #include namespace stan { namespace math { /** * Allocates and populates a flat array of vari pointers in the autodiff arena * with the varis pointed to by the vars in the input Eigen matrix * * @tparam R Eigen row type of x * @tparam C Eigen column type of x * @param x Input * @return Flat array of vari pointers */ template vari** build_vari_array(const Eigen::Matrix& x) { vari** x_vi_ = ChainableStack::instance_->memalloc_.alloc_array(x.size()); for (int i = 0; i < x.size(); ++i) { x_vi_[i] = x(i).vi_; } return x_vi_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/precomp_v_vari.hpp0000644000176200001440000000100313766554456024240 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_PRECOMP_V_VARI_HPP #define STAN_MATH_REV_CORE_PRECOMP_V_VARI_HPP #include #include namespace stan { namespace math { // use for single precomputed partials class precomp_v_vari : public op_v_vari { protected: double da_; public: precomp_v_vari(double val, vari* avi, double da) : op_v_vari(val, avi), da_(da) {} void chain() { avi_->adj_ += adj_ * da_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_logical_or.hpp0000644000176200001440000000231713766554456025263 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_LOGICAL_OR_HPP #define STAN_MATH_REV_CORE_OPERATOR_LOGICAL_OR_HPP #include namespace stan { namespace math { /** * Return the logical disjunction of the values of the two * arguments as defined by ||. * * @param[in] x first argument * @param[in] y second argument * @return disjuntion of the argument's values */ inline bool operator||(const var& x, const var& y) { return x.val() || y.val(); } /** * Return the logical disjunction of the values of the two * arguments as defined by ||. * * @param[in] x first argument * @param[in] y second argument * @return disjunction of first argument's value and second * argument */ template inline bool operator||(const var& x, double y) { return x.val() || y; } /** * Return the logical disjunction of the values of the two * arguments as defined by ||. * * @param[in] x first argument * @param[in] y second argument * @return disjunction of first argument and the second * argument's value */ template inline bool operator||(double x, const var& y) { return x || y.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/precomputed_gradients.hpp0000644000176200001440000000613513766554456025627 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_PRECOMPUTED_GRADIENTS_HPP #define STAN_MATH_REV_CORE_PRECOMPUTED_GRADIENTS_HPP #include #include #include #include #include namespace stan { namespace math { /** * A variable implementation taking a sequence of operands and * partial derivatives with respect to the operands. * * Stan users should use function precomputed_gradients() * directly. */ class precomputed_gradients_vari : public vari { protected: const size_t size_; vari** varis_; double* gradients_; public: /** * Construct a precomputed vari with the specified value, * operands, and gradients. * * @param[in] val The value of the variable. * @param[in] size Size of operands and gradients * @param[in] varis Operand implementations. * @param[in] gradients Gradients with respect to operands. */ precomputed_gradients_vari(double val, size_t size, vari** varis, double* gradients) : vari(val), size_(size), varis_(varis), gradients_(gradients) {} /** * Construct a precomputed vari with the specified value, * operands, and gradients. * * @param[in] val The value of the variable. * @param[in] vars Vector of operands. * @param[in] gradients Vector of partial derivatives of value * with respect to operands. * @throws std::invalid_argument if the sizes of the vectors * don't match. */ precomputed_gradients_vari(double val, const std::vector& vars, const std::vector& gradients) : vari(val), size_(vars.size()), varis_(ChainableStack::instance_->memalloc_.alloc_array( vars.size())), gradients_(ChainableStack::instance_->memalloc_.alloc_array( vars.size())) { check_consistent_sizes("precomputed_gradients_vari", "vars", vars, "gradients", gradients); for (size_t i = 0; i < vars.size(); ++i) { varis_[i] = vars[i].vi_; } std::copy(gradients.begin(), gradients.end(), gradients_); } /** * Implements the chain rule for this variable, using the * prestored operands and gradient. */ void chain() { for (size_t i = 0; i < size_; ++i) { varis_[i]->adj_ += adj_ * gradients_[i]; } } }; /** * This function returns a var for an expression that has the * specified value, vector of operands, and vector of partial * derivatives of value with respect to the operands. * * @param[in] value The value of the resulting dependent variable. * @param[in] operands operands. * @param[in] gradients vector of partial derivatives of result with * respect to operands. * @return An auto-diff variable that uses the precomputed * gradients provided. */ inline var precomputed_gradients(double value, const std::vector& operands, const std::vector& gradients) { return var(new precomputed_gradients_vari(value, operands, gradients)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vv_vari.hpp0000644000176200001440000000056213766554456022712 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VV_VARI_HPP #define STAN_MATH_REV_CORE_VV_VARI_HPP #include namespace stan { namespace math { class op_vv_vari : public vari { protected: vari* avi_; vari* bvi_; public: op_vv_vari(double f, vari* avi, vari* bvi) : vari(f), avi_(avi), bvi_(bvi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_division.hpp0000644000176200001440000000671513766554456025003 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_DIVISION_HPP #define STAN_MATH_REV_CORE_OPERATOR_DIVISION_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { // (a/b)' = a' * (1 / b) - b' * (a / [b * b]) class divide_vv_vari : public op_vv_vari { public: divide_vv_vari(vari* avi, vari* bvi) : op_vv_vari(avi->val_ / bvi->val_, avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ / bvi_->val_; bvi_->adj_ -= adj_ * avi_->val_ / (bvi_->val_ * bvi_->val_); } } }; class divide_vd_vari : public op_vd_vari { public: divide_vd_vari(vari* avi, double b) : op_vd_vari(avi->val_ / b, avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ / bd_; } } }; class divide_dv_vari : public op_dv_vari { public: divide_dv_vari(double a, vari* bvi) : op_dv_vari(a / bvi->val_, a, bvi) {} void chain() { bvi_->adj_ -= adj_ * ad_ / (bvi_->val_ * bvi_->val_); } }; } // namespace internal /** * Division operator for two variables (C++). * * The partial derivatives for the variables are * * \f$\frac{\partial}{\partial x} (x/y) = 1/y\f$, and * * \f$\frac{\partial}{\partial y} (x/y) = -x / y^2\f$. * \f[ \mbox{operator/}(x, y) = \begin{cases} \frac{x}{y} & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator/}(x, y)}{\partial x} = \begin{cases} \frac{1}{y} & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator/}(x, y)}{\partial y} = \begin{cases} -\frac{x}{y^2} & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable operand. * @param b Second variable operand. * @return Variable result of dividing the first variable by the * second. */ inline var operator/(const var& a, const var& b) { return var(new internal::divide_vv_vari(a.vi_, b.vi_)); } /** * Division operator for dividing a variable by a scalar (C++). * * The derivative with respect to the variable is * * \f$\frac{\partial}{\partial x} (x/c) = 1/c\f$. * * @param a Variable operand. * @param b Scalar operand. * @return Variable result of dividing the variable by the scalar. */ inline var operator/(const var& a, double b) { if (b == 1.0) { return a; } return var(new internal::divide_vd_vari(a.vi_, b)); } /** * Division operator for dividing a scalar by a variable (C++). * * The derivative with respect to the variable is * * \f$\frac{d}{d y} (c/y) = -c / y^2\f$. * * @param a Scalar operand. * @param b Variable operand. * @return Variable result of dividing the scalar by the variable. */ inline var operator/(double a, const var& b) { return var(new internal::divide_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_divide_equal.hpp0000644000176200001440000000103413766554456025577 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_DIVIDE_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_DIVIDE_EQUAL_HPP #include #include namespace stan { namespace math { inline var& var::operator/=(const var& b) { vi_ = new internal::divide_vv_vari(vi_, b.vi_); return *this; } inline var& var::operator/=(double b) { if (b == 1.0) { return *this; } vi_ = new internal::divide_vd_vari(vi_, b); return *this; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_equal.hpp0000644000176200001440000000237513766554456024264 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_EQUAL_HPP #include namespace stan { namespace math { /** * Equality operator comparing two variables' values (C++). * \f[ \mbox{operator==}(x, y) = \begin{cases} 0 & \mbox{if } x \neq y\\ 1 & \mbox{if } x = y \\[6pt] 0 & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return True if the first variable's value is the same as the * second's. */ inline bool operator==(const var& a, const var& b) { return a.val() == b.val(); } /** * Equality operator comparing a variable's value and a double * (C++). * * @param a First variable. * @param b Second value. * @return True if the first variable's value is the same as the * second value. */ inline bool operator==(const var& a, double b) { return a.val() == b; } /** * Equality operator comparing a scalar and a variable's value * (C++). * * @param a First scalar. * @param b Second variable. * @return True if the variable's value is equal to the scalar. */ inline bool operator==(double a, const var& b) { return a == b.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_not_equal.hpp0000644000176200001440000000245013766554456025136 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_NOT_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_NOT_EQUAL_HPP #include namespace stan { namespace math { /** * Inequality operator comparing two variables' values (C++). * \f[ \mbox{operator!=}(x, y) = \begin{cases} 0 & \mbox{if } x = y\\ 1 & \mbox{if } x \neq y \\[6pt] 0 & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return True if the first variable's value is not the same as the * second's. */ inline bool operator!=(const var& a, const var& b) { return a.val() != b.val(); } /** * Inequality operator comparing a variable's value and a double * (C++). * * @param a First variable. * @param b Second value. * @return True if the first variable's value is not the same as the * second value. */ inline bool operator!=(const var& a, double b) { return a.val() != b; } /** * Inequality operator comparing a double and a variable's value * (C++). * * @param a First value. * @param b Second variable. * @return True if the first value is not the same as the * second variable's value. */ inline bool operator!=(double a, const var& b) { return a != b.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/chainablestack.hpp0000644000176200001440000000052413766554456024170 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_CHAINABLESTACK_HPP #define STAN_MATH_REV_CORE_CHAINABLESTACK_HPP #include namespace stan { namespace math { class vari; class chainable_alloc; using ChainableStack = AutodiffStackSingleton; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vdd_vari.hpp0000644000176200001440000000063013766554456023030 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VDD_VARI_HPP #define STAN_MATH_REV_CORE_VDD_VARI_HPP #include namespace stan { namespace math { class op_vdd_vari : public vari { protected: vari* avi_; double bd_; double cd_; public: op_vdd_vari(double f, vari* avi, double b, double c) : vari(f), avi_(avi), bd_(b), cd_(c) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_subtraction.hpp0000644000176200001440000000665213766554456025514 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_SUBTRACTION_HPP #define STAN_MATH_REV_CORE_OPERATOR_SUBTRACTION_HPP #include #include #include #include #include #include namespace stan { namespace math { namespace internal { class subtract_vv_vari : public op_vv_vari { public: subtract_vv_vari(vari* avi, vari* bvi) : op_vv_vari(avi->val_ - bvi->val_, avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; bvi_->adj_ -= adj_; } } }; class subtract_vd_vari : public op_vd_vari { public: subtract_vd_vari(vari* avi, double b) : op_vd_vari(avi->val_ - b, avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; } } }; class subtract_dv_vari : public op_dv_vari { public: subtract_dv_vari(double a, vari* bvi) : op_dv_vari(a - bvi->val_, a, bvi) {} void chain() { if (unlikely(is_any_nan(ad_, bvi_->val_))) { bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { bvi_->adj_ -= adj_; } } }; } // namespace internal /** * Subtraction operator for variables (C++). * * The partial derivatives are defined by * * \f$\frac{\partial}{\partial x} (x-y) = 1\f$, and * * \f$\frac{\partial}{\partial y} (x-y) = -1\f$. * \f[ \mbox{operator-}(x, y) = \begin{cases} x-y & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator-}(x, y)}{\partial x} = \begin{cases} 1 & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator-}(x, y)}{\partial y} = \begin{cases} -1 & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable operand. * @param b Second variable operand. * @return Variable result of subtracting the second variable from * the first. */ inline var operator-(const var& a, const var& b) { return var(new internal::subtract_vv_vari(a.vi_, b.vi_)); } /** * Subtraction operator for variable and scalar (C++). * * The derivative for the variable is * * \f$\frac{\partial}{\partial x} (x-c) = 1\f$, and * * @param a First variable operand. * @param b Second scalar operand. * @return Result of subtracting the scalar from the variable. */ inline var operator-(const var& a, double b) { if (b == 0.0) { return a; } return var(new internal::subtract_vd_vari(a.vi_, b)); } /** * Subtraction operator for scalar and variable (C++). * * The derivative for the variable is * * \f$\frac{\partial}{\partial y} (c-y) = -1\f$, and * * @param a First scalar operand. * @param b Second variable operand. * @return Result of sutracting a variable from a scalar. */ inline var operator-(double a, const var& b) { return var(new internal::subtract_dv_vari(a, b.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_multiplication.hpp0000644000176200001440000000616713766554456026215 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_MULTIPLICATION_HPP #define STAN_MATH_REV_CORE_OPERATOR_MULTIPLICATION_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class multiply_vv_vari : public op_vv_vari { public: multiply_vv_vari(vari* avi, vari* bvi) : op_vv_vari(avi->val_ * bvi->val_, avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += bvi_->val_ * adj_; bvi_->adj_ += avi_->val_ * adj_; } } }; class multiply_vd_vari : public op_vd_vari { public: multiply_vd_vari(vari* avi, double b) : op_vd_vari(avi->val_ * b, avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_ * bd_; } } }; } // namespace internal /** * Multiplication operator for two variables (C++). * * The partial derivatives are * * \f$\frac{\partial}{\partial x} (x * y) = y\f$, and * * \f$\frac{\partial}{\partial y} (x * y) = x\f$. * \f[ \mbox{operator*}(x, y) = \begin{cases} xy & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator*}(x, y)}{\partial x} = \begin{cases} y & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator*}(x, y)}{\partial y} = \begin{cases} x & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable operand. * @param b Second variable operand. * @return Variable result of multiplying operands. */ inline var operator*(const var& a, const var& b) { return var(new internal::multiply_vv_vari(a.vi_, b.vi_)); } /** * Multiplication operator for a variable and a scalar (C++). * * The partial derivative for the variable is * * \f$\frac{\partial}{\partial x} (x * c) = c\f$, and * * @param a Variable operand. * @param b Scalar operand. * @return Variable result of multiplying operands. */ inline var operator*(const var& a, double b) { if (b == 1.0) { return a; } return var(new internal::multiply_vd_vari(a.vi_, b)); } /** * Multiplication operator for a scalar and a variable (C++). * * The partial derivative for the variable is * * \f$\frac{\partial}{\partial y} (c * y) = c\f$. * * @param a Scalar operand. * @param b Variable operand. * @return Variable result of multiplying the operands. */ inline var operator*(double a, const var& b) { if (a == 1.0) { return b; } return var(new internal::multiply_vd_vari(b.vi_, a)); // by symmetry } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vdv_vari.hpp0000644000176200001440000000063413766554456023056 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VDV_VARI_HPP #define STAN_MATH_REV_CORE_VDV_VARI_HPP #include namespace stan { namespace math { class op_vdv_vari : public vari { protected: vari* avi_; double bd_; vari* cvi_; public: op_vdv_vari(double f, vari* avi, double b, vari* cvi) : vari(f), avi_(avi), bd_(b), cvi_(cvi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_less_than.hpp0000644000176200001440000000234313766554456025130 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_LESS_THAN_HPP #define STAN_MATH_REV_CORE_OPERATOR_LESS_THAN_HPP #include namespace stan { namespace math { /** * Less than operator comparing variables' values (C++). * \f[ \mbox{operator\textless}(x, y) = \begin{cases} 0 & \mbox{if } x \geq y \\ 1 & \mbox{if } x < y \\[6pt] 0 & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * @param a First variable. * @param b Second variable. * @return True if first variable's value is less than second's. */ inline bool operator<(const var& a, const var& b) { return a.val() < b.val(); } /** * Less than operator comparing variable's value and a double * (C++). * * @param a First variable. * @param b Second value. * @return True if first variable's value is less than second value. */ inline bool operator<(const var& a, double b) { return a.val() < b; } /** * Less than operator comparing a double and variable's value * (C++). * * @param a First value. * @param b Second variable. * @return True if first value is less than second variable's value. */ inline bool operator<(double a, const var& b) { return a < b.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/grad.hpp0000644000176200001440000000321413766554456022150 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_GRAD_HPP #define STAN_MATH_REV_CORE_GRAD_HPP #include #include #include #include #include #include namespace stan { namespace math { /** * Compute the gradient for all variables starting from the * specified root variable implementation. Does not recover * memory. This chainable variable's adjoint is initialized using * the method init_dependent() and then the chain * rule is applied working down the stack from this vari and * calling each vari's chain() method in turn. * *

This function computes a nested gradient only going back as far * as the last nesting. * *

This function does not recover any memory from the computation. * * @param vi Variable implementation for root of partial * derivative propagation. */ static void grad(vari* vi) { // simple reference implementation (intended as doc): // vi->init_dependent(); // size_t end = var_stack_.size(); // size_t begin = empty_nested() ? 0 : end - nested_size(); // for (size_t i = end; --i > begin; ) // var_stack_[i]->chain(); using it_t = std::vector::reverse_iterator; vi->init_dependent(); it_t begin = ChainableStack::instance_->var_stack_.rbegin(); it_t end = empty_nested() ? ChainableStack::instance_->var_stack_.rend() : begin + nested_size(); for (it_t it = begin; it < end; ++it) { (*it)->chain(); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/v_vari.hpp0000644000176200001440000000051213766554456022517 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_V_VARI_HPP #define STAN_MATH_REV_CORE_V_VARI_HPP #include namespace stan { namespace math { class op_v_vari : public vari { protected: vari* avi_; public: op_v_vari(double f, vari* avi) : vari(f), avi_(avi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_unary_plus.hpp0000644000176200001440000000241013766554456025344 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_UNARY_PLUS_HPP #define STAN_MATH_REV_CORE_OPERATOR_UNARY_PLUS_HPP #include #include #include #include namespace stan { namespace math { /** * Unary plus operator for variables (C++). * * The function simply returns its input, because * * \f$\frac{d}{dx} +x = \frac{d}{dx} x = 1\f$. * * The effect of unary plus on a built-in C++ scalar type is * integer promotion. Because variables are all * double-precision floating point already, promotion is * not necessary. * \f[ \mbox{operator+}(x) = \begin{cases} x & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator+}(x)}{\partial x} = \begin{cases} 1 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Argument variable. * @return The input reference. */ inline var operator+(const var& a) { if (unlikely(is_nan(a.vi_->val_))) { return var(new precomp_v_vari(NOT_A_NUMBER, a.vi_, NOT_A_NUMBER)); } return a; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vd_vari.hpp0000644000176200001440000000055613766554456022673 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VD_VARI_HPP #define STAN_MATH_REV_CORE_VD_VARI_HPP #include namespace stan { namespace math { class op_vd_vari : public vari { protected: vari* avi_; double bd_; public: op_vd_vari(double f, vari* avi, double b) : vari(f), avi_(avi), bd_(b) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vvv_vari.hpp0000644000176200001440000000064013766554456023075 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VVV_VARI_HPP #define STAN_MATH_REV_CORE_VVV_VARI_HPP #include namespace stan { namespace math { class op_vvv_vari : public vari { protected: vari* avi_; vari* bvi_; vari* cvi_; public: op_vvv_vari(double f, vari* avi, vari* bvi, vari* cvi) : vari(f), avi_(avi), bvi_(bvi), cvi_(cvi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/autodiffstackstorage.hpp0000644000176200001440000001344013766554456025451 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_AUTODIFFSTACKSTORAGE_HPP #define STAN_MATH_REV_CORE_AUTODIFFSTACKSTORAGE_HPP #include #include namespace stan { namespace math { // For RStan the AD tape instance is *always* TLS, regardless of // STAN_THREADS being set or not // Internal macro used to modify global pointer definition to the // global AD instance. // #ifdef STAN_THREADS // Whenever STAN_THREADS is set a TLS keyword is used. For reasons // explained below we use the GNU compiler extension __thread if // supported by the compiler while the generic thread_local C++11 // keyword is used otherwise. #ifdef __GNUC__ #define STAN_THREADS_DEF __thread #else #define STAN_THREADS_DEF thread_local #endif //#else // In case STAN_THREADS is not set, then no modifier is needed. //#define STAN_THREADS_DEF //#endif /** * This struct always provides access to the autodiff stack using * the singleton pattern. Read warnings below! * * The singleton instance_ is a global static pointer, * which is thread local (TLS) if the STAN_THREADS preprocess variable * is defined. * * The use of a pointer is motivated by performance reasons for the * threading case. When a TLS is used, initialization with a constant * expression at compile time is required for fast access to the * TLS. As the autodiff storage struct is non-POD, its initialization * is a dynamic expression at compile time. These dynamic expressions * are wrapped, in the TLS case, by a TLS wrapper function which slows * down its access. Using a pointer instead allows to initialize at * compile time to nullptr, which is a compile time * constant. In this case, the compiler avoids the use of a TLS * wrapper function. * * For performance reasons we use the __thread keyword on compilers * which support it. The __thread keyword is a GNU compiler-specific * (gcc, clang, Intel) extension which requires initialization with a * compile time constant expression. The C++11 keyword thread_local * does allow for constant and dynamic initialization of the * TLS. Thus, only the __thread keyword gurantees that constant * initialization and it's implied speedup, is used. * * The initialzation of the AD instance at run-time is handled by the * lifetime of a AutodiffStackSingleton object. More specifically, the * first instance of the AutodiffStackSingleton object will initialize * the AD instance and take ownership (it is the only one instance * with the private member own_instance_ being true). Thus, whenever * the first instance of the AutodiffStackSingleton object gets * destructed, the AD tape will be destructed as well. Within * stan-math the initialization of the AD instance for the main thread * of the program is handled by instantiating the singleton once in * the init_chainablestack.hpp file. Whenever STAN_THREADS is defined * then all created child threads must instantiate a * AutodiffStackSingleton object within the child thread before * accessing the AD system in order to initialize the TLS AD tape * within the child thread. * * The design of a globally held (optionally TLS) pointer, which is * globally initialized, allows the compiler to apply necessary * inlining to get maximal performance. However, the design suffers * from "the static init order fiasco"[0]. Whenever the static init * order fiasco occurs, the C++ client of the library may instantiate * a AutodiffStackSingleton object at the adequate code position prior * to any AD tape access to ensure proper initialization order. In * exchange, we get a more performant singleton pattern with automatic * initialization of the AD stack for the main thread. There has been * some discussion on earlier designs using the Mayer singleton * approach; see [1] and [2] and the discussions those PRs link to as * well. * * [0] https://isocpp.org/wiki/faq/ctors#static-init-order * [1] https://github.com/stan-dev/math/pull/840 * [2] https://github.com/stan-dev/math/pull/826 * [3] * http://discourse.mc-stan.org/t/potentially-dropping-support-for-older-versions-of-apples-version-of-clang/3780/ */ template struct AutodiffStackSingleton { using AutodiffStackSingleton_t = AutodiffStackSingleton; AutodiffStackSingleton() : own_instance_(init()) {} ~AutodiffStackSingleton() { if (own_instance_) { delete instance_; instance_ = nullptr; } } struct AutodiffStackStorage { AutodiffStackStorage &operator=(const AutodiffStackStorage &) = delete; std::vector var_stack_; std::vector var_nochain_stack_; std::vector var_alloc_stack_; stack_alloc memalloc_; // nested positions std::vector nested_var_stack_sizes_; std::vector nested_var_nochain_stack_sizes_; std::vector nested_var_alloc_stack_starts_; }; explicit AutodiffStackSingleton(AutodiffStackSingleton_t const &) = delete; AutodiffStackSingleton &operator=(const AutodiffStackSingleton_t &) = delete; static STAN_THREADS_DEF AutodiffStackStorage *instance_; private: static bool init() { static STAN_THREADS_DEF bool is_initialized = false; if (!is_initialized) { is_initialized = true; instance_ = new AutodiffStackStorage(); return true; } if (!instance_) { is_initialized = true; instance_ = new AutodiffStackStorage(); return true; } return false; } bool own_instance_; }; template STAN_THREADS_DEF typename AutodiffStackSingleton::AutodiffStackStorage *AutodiffStackSingleton::instance_; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/start_nested.hpp0000644000176200001440000000143513766554456023735 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_START_NESTED_HPP #define STAN_MATH_REV_CORE_START_NESTED_HPP #include namespace stan { namespace math { /** * Record the current position so that recover_memory_nested() * can find it. */ static inline void start_nested() { ChainableStack::instance_->nested_var_stack_sizes_.push_back( ChainableStack::instance_->var_stack_.size()); ChainableStack::instance_->nested_var_nochain_stack_sizes_.push_back( ChainableStack::instance_->var_nochain_stack_.size()); ChainableStack::instance_->nested_var_alloc_stack_starts_.push_back( ChainableStack::instance_->var_alloc_stack_.size()); ChainableStack::instance_->memalloc_.start_nested(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/stored_gradient_vari.hpp0000644000176200001440000000254113766554456025433 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_STORED_GRADIENT_VARI_HPP #define STAN_MATH_REV_CORE_STORED_GRADIENT_VARI_HPP #include namespace stan { namespace math { /** * A var implementation that stores the daughter variable * implementation pointers and the partial derivative with respect * to the result explicitly in arrays constructed on the * auto-diff memory stack. * * Like a simplified version of OperandsAndPartials. */ class stored_gradient_vari : public vari { protected: size_t size_; vari** dtrs_; double* partials_; public: /** * Construct a stored gradient vari with the specified * value, size, daughter varis, and partial derivatives. * * @param[in] value Value of vari * @param[in] size Number of daughters * @param[in] dtrs Array of pointers to daughters * @param[in] partials Partial derivatives of value with respect * to daughters. */ stored_gradient_vari(double value, size_t size, vari** dtrs, double* partials) : vari(value), size_(size), dtrs_(dtrs), partials_(partials) {} /** * Propagate derivatives through this vari with partial * derivatives given for the daughter vari by the stored partials. */ void chain() { for (size_t i = 0; i < size_; ++i) { dtrs_[i]->adj_ += adj_ * partials_[i]; } } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/print_stack.hpp0000644000176200001440000000200013766554456023544 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_PRINT_STACK_HPP #define STAN_MATH_REV_CORE_PRINT_STACK_HPP #include #include #include namespace stan { namespace math { /** * Prints the auto-dif variable stack. This function * is used for debugging purposes. * * Only works if all members of stack are vari* as it * casts to vari*. * * @param o ostream to modify */ inline void print_stack(std::ostream& o) { o << "STACK, size=" << ChainableStack::instance_->var_stack_.size() << std::endl; // TODO(carpenter): this shouldn't need to be cast any more for (size_t i = 0; i < ChainableStack::instance_->var_stack_.size(); ++i) { o << i << " " << ChainableStack::instance_->var_stack_[i] << " " << (static_cast(ChainableStack::instance_->var_stack_[i]))->val_ << " : " << (static_cast(ChainableStack::instance_->var_stack_[i]))->adj_ << std::endl; } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/std_isinf.hpp0000644000176200001440000000077713766554456023230 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_STD_ISINF_HPP #define STAN_MATH_REV_CORE_STD_ISINF_HPP #include #include namespace std { /** * Return 1 if the specified argument is positive * infinity or negative infinity and 0 otherwise. * * @param a Argument. * @return 1 if argument is infinite and 0 otherwise. */ inline int isinf(const stan::math::var& a) { return stan::math::is_inf(a.val()); } } // namespace std #endif StanHeaders/inst/include/stan/math/rev/core/operator_addition.hpp0000644000176200001440000000601313766554456024741 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_ADDITION_HPP #define STAN_MATH_REV_CORE_OPERATOR_ADDITION_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { class add_vv_vari : public op_vv_vari { public: add_vv_vari(vari* avi, vari* bvi) : op_vv_vari(avi->val_ + bvi->val_, avi, bvi) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bvi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); bvi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; bvi_->adj_ += adj_; } } }; class add_vd_vari : public op_vd_vari { public: add_vd_vari(vari* avi, double b) : op_vd_vari(avi->val_ + b, avi, b) {} void chain() { if (unlikely(is_any_nan(avi_->val_, bd_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; } } }; } // namespace internal /** * Addition operator for variables (C++). * * The partial derivatives are defined by * * \f$\frac{\partial}{\partial x} (x+y) = 1\f$, and * * \f$\frac{\partial}{\partial y} (x+y) = 1\f$. * * \f[ \mbox{operator+}(x, y) = \begin{cases} x+y & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator+}(x, y)}{\partial x} = \begin{cases} 1 & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator+}(x, y)}{\partial y} = \begin{cases} 1 & \mbox{if } -\infty\leq x, y \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable operand. * @param b Second variable operand. * @return Variable result of adding two variables. */ inline var operator+(const var& a, const var& b) { return var(new internal::add_vv_vari(a.vi_, b.vi_)); } /** * Addition operator for variable and scalar (C++). * * The derivative with respect to the variable is * * \f$\frac{d}{dx} (x + c) = 1\f$. * * @param a First variable operand. * @param b Second scalar operand. * @return Result of adding variable and scalar. */ inline var operator+(const var& a, double b) { if (b == 0.0) { return a; } return var(new internal::add_vd_vari(a.vi_, b)); } /** * Addition operator for scalar and variable (C++). * * The derivative with respect to the variable is * * \f$\frac{d}{dy} (c + y) = 1\f$. * * @param a First scalar operand. * @param b Second variable operand. * @return Result of adding variable and scalar. */ inline var operator+(double a, const var& b) { if (a == 0.0) { return b; } return var(new internal::add_vd_vari(b.vi_, a)); // by symmetry } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/set_zero_all_adjoints_nested.hpp0000644000176200001440000000243513766554456027156 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_SET_ZERO_ALL_ADJOINTS_NESTED_HPP #define STAN_MATH_REV_CORE_SET_ZERO_ALL_ADJOINTS_NESTED_HPP #include #include #include #include #include namespace stan { namespace math { /** * Reset all adjoint values in the top nested portion of the stack * to zero. */ static void set_zero_all_adjoints_nested() { if (empty_nested()) { throw std::logic_error( "empty_nested() must be false before calling" " set_zero_all_adjoints_nested()"); } size_t start1 = ChainableStack::instance_->nested_var_stack_sizes_.back(); // avoid wrap with unsigned when start1 == 0 for (size_t i = (start1 == 0U) ? 0U : (start1 - 1); i < ChainableStack::instance_->var_stack_.size(); ++i) { ChainableStack::instance_->var_stack_[i]->set_zero_adjoint(); } size_t start2 = ChainableStack::instance_->nested_var_nochain_stack_sizes_.back(); for (size_t i = (start2 == 0U) ? 0U : (start2 - 1); i < ChainableStack::instance_->var_nochain_stack_.size(); ++i) { ChainableStack::instance_->var_nochain_stack_[i]->set_zero_adjoint(); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/nested_size.hpp0000644000176200001440000000062413766554456023551 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_NESTED_SIZE_HPP #define STAN_MATH_REV_CORE_NESTED_SIZE_HPP #include #include namespace stan { namespace math { static inline size_t nested_size() { return ChainableStack::instance_->var_stack_.size() - ChainableStack::instance_->nested_var_stack_sizes_.back(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/init_chainablestack.hpp0000644000176200001440000000430313766554456025212 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_INIT_CHAINABLESTACK_HPP #define STAN_MATH_REV_CORE_INIT_CHAINABLESTACK_HPP #include #ifdef STAN_THREADS #include #include #include #include #include #include namespace stan { namespace math { /** * TBB observer object which is a callback hook called whenever the * TBB scheduler adds a new thread to the TBB managed threadpool. This * hook ensures that each worker thread has an initialized AD tape * ready for use. * * Refer to https://software.intel.com/en-us/node/506314 for details * on the observer concept. */ class ad_tape_observer : public tbb::task_scheduler_observer { using stack_ptr = std::unique_ptr; using ad_map = std::unordered_map; public: ad_tape_observer() : tbb::task_scheduler_observer(), thread_tape_map_() { on_scheduler_entry(true); // register current process observe(true); // activates the observer } ~ad_tape_observer() { observe(false); } void on_scheduler_entry(bool worker) { std::lock_guard thread_tape_map_lock(thread_tape_map_mutex_); const std::thread::id thread_id = std::this_thread::get_id(); if (thread_tape_map_.find(thread_id) == thread_tape_map_.end()) { ad_map::iterator insert_elem; bool status = false; std::tie(insert_elem, status) = thread_tape_map_.emplace(ad_map::value_type{thread_id, nullptr}); insert_elem->second = stack_ptr(new ChainableStack()); } } void on_scheduler_exit(bool worker) { std::lock_guard thread_tape_map_lock(thread_tape_map_mutex_); auto elem = thread_tape_map_.find(std::this_thread::get_id()); if (elem != thread_tape_map_.end()) { thread_tape_map_.erase(elem); } } private: ad_map thread_tape_map_; std::mutex thread_tape_map_mutex_; }; namespace { ad_tape_observer global_observer; } // namespace } // namespace math } // namespace stan #else // STAN_THREADS absent namespace stan { namespace math { namespace { ChainableStack global_ad_stack; } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/rev/core/operator_unary_decrement.hpp0000644000176200001440000000304513766554456026334 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_UNARY_DECREMENT_HPP #define STAN_MATH_REV_CORE_OPERATOR_UNARY_DECREMENT_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class decrement_vari : public op_v_vari { public: explicit decrement_vari(vari* avi) : op_v_vari(avi->val_ - 1.0, avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; } } }; } // namespace internal /** * Prefix decrement operator for variables (C++). * * Following C++, (--a) is defined to behave exactly as * * a = a - 1.0) * * does, but is faster and uses less memory. In particular, * the result is an assignable lvalue. * * @param a Variable to decrement. * @return Reference the result of decrementing this input variable. */ inline var& operator--(var& a) { a.vi_ = new internal::decrement_vari(a.vi_); return a; } /** * Postfix decrement operator for variables (C++). * * Following C++, the expression (a--) is defined to * behave like the sequence of operations * * var temp = a; a = a - 1.0; return temp; * * @param a Variable to decrement. * @return Input variable. */ inline var operator--(var& a, int /*dummy*/) { var temp(a); a.vi_ = new internal::decrement_vari(a.vi_); return temp; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/gevv_vvv_vari.hpp0000644000176200001440000000335013766554456024125 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_GEVV_VVV_VARI_HPP #define STAN_MATH_REV_CORE_GEVV_VVV_VARI_HPP #include #include #include namespace stan { namespace math { class gevv_vvv_vari : public vari { protected: vari* alpha_; vari** v1_; vari** v2_; double dotval_; size_t length_; inline static double eval_gevv(const var* alpha, const var* v1, int stride1, const var* v2, int stride2, size_t length, double* dotprod) { double result = 0; for (size_t i = 0; i < length; i++) { result += v1[i * stride1].vi_->val_ * v2[i * stride2].vi_->val_; } *dotprod = result; return alpha->vi_->val_ * result; } public: gevv_vvv_vari(const var* alpha, const var* v1, int stride1, const var* v2, int stride2, size_t length) : vari(eval_gevv(alpha, v1, stride1, v2, stride2, length, &dotval_)), length_(length) { alpha_ = alpha->vi_; // TODO(carpenter): replace this with array alloc fun call v1_ = reinterpret_cast(ChainableStack::instance_->memalloc_.alloc( 2 * length_ * sizeof(vari*))); v2_ = v1_ + length_; for (size_t i = 0; i < length_; i++) { v1_[i] = v1[i * stride1].vi_; } for (size_t i = 0; i < length_; i++) { v2_[i] = v2[i * stride2].vi_; } } virtual ~gevv_vvv_vari() {} void chain() { const double adj_alpha = adj_ * alpha_->val_; for (size_t i = 0; i < length_; i++) { v1_[i]->adj_ += adj_alpha * v2_[i]->val_; v2_[i]->adj_ += adj_alpha * v1_[i]->val_; } alpha_->adj_ += adj_ * dotval_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/vector_vari.hpp0000644000176200001440000000130313766554456023553 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VECTOR_VARI_HPP #define STAN_MATH_REV_CORE_VECTOR_VARI_HPP #include #include #include namespace stan { namespace math { class op_vector_vari : public vari { protected: const size_t size_; vari** vis_; public: op_vector_vari(double f, const std::vector& vs) : vari(f), size_(vs.size()) { vis_ = reinterpret_cast(operator new(sizeof(vari*) * vs.size())); for (size_t i = 0; i < vs.size(); ++i) { vis_[i] = vs[i].vi_; } } vari* operator[](size_t n) const { return vis_[n]; } size_t size() { return size_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/matrix_vari.hpp0000644000176200001440000000146113766554456023562 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_MATRIX_VARI_HPP #define STAN_MATH_REV_CORE_MATRIX_VARI_HPP #include #include #include #include namespace stan { namespace math { class op_matrix_vari : public vari { protected: const size_t size_; vari** vis_; public: template op_matrix_vari(double f, const Eigen::Matrix& vs) : vari(f), size_(vs.size()) { vis_ = reinterpret_cast(operator new(sizeof(vari*) * vs.size())); for (int i = 0; i < vs.size(); ++i) { vis_[i] = vs(i).vi_; } } vari* operator[](size_t n) const { return vis_[n]; } size_t size() { return size_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_unary_increment.hpp0000644000176200001440000000300113766554456026342 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_UNARY_INCREMENT_HPP #define STAN_MATH_REV_CORE_OPERATOR_UNARY_INCREMENT_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class increment_vari : public op_v_vari { public: explicit increment_vari(vari* avi) : op_v_vari(avi->val_ + 1.0, avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ += adj_; } } }; } // namespace internal /** * Prefix increment operator for variables (C++). Following C++, * (++a) is defined to behave exactly as (a = a + 1.0) does, * but is faster and uses less memory. In particular, the * result is an assignable lvalue. * * @param a Variable to increment. * @return Reference the result of incrementing this input variable. */ inline var& operator++(var& a) { a.vi_ = new internal::increment_vari(a.vi_); return a; } /** * Postfix increment operator for variables (C++). * * Following C++, the expression (a++) is defined to behave like * the sequence of operations * * var temp = a; a = a + 1.0; return temp; * * @param a Variable to increment. * @return Input variable. */ inline var operator++(var& a, int /*dummy*/) { var temp(a); a.vi_ = new internal::increment_vari(a.vi_); return temp; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_unary_not.hpp0000644000176200001440000000067113766554456025170 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_UNARY_NOT_HPP #define STAN_MATH_REV_CORE_OPERATOR_UNARY_NOT_HPP #include namespace stan { namespace math { /** * Return the negation of the value of the argument as defined by * !. * * @param[in] x argument * @return negation of argument value */ inline bool operator!(const var& x) { return !x.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_unary_negative.hpp0000644000176200001440000000241113766554456026164 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_UNARY_NEGATIVE_HPP #define STAN_MATH_REV_CORE_OPERATOR_UNARY_NEGATIVE_HPP #include #include #include #include namespace stan { namespace math { namespace internal { class neg_vari : public op_v_vari { public: explicit neg_vari(vari* avi) : op_v_vari(-(avi->val_), avi) {} void chain() { if (unlikely(is_nan(avi_->val_))) { avi_->adj_ = std::numeric_limits::quiet_NaN(); } else { avi_->adj_ -= adj_; } } }; } // namespace internal /** * Unary negation operator for variables (C++). * * \f$\frac{d}{dx} -x = -1\f$. * \f[ \mbox{operator-}(x) = \begin{cases} -x & \mbox{if } -\infty\leq x \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{operator-}(x)}{\partial x} = \begin{cases} -1 & \mbox{if } -\infty\leq x\leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param a Argument variable. * @return Negation of variable. */ inline var operator-(const var& a) { return var(new internal::neg_vari(a.vi_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_greater_than_or_equal.hpp0000644000176200001440000000256613766554456027511 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_GREATER_THAN_OR_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_GREATER_THAN_OR_EQUAL_HPP #include namespace stan { namespace math { /** * Greater than or equal operator comparing two variables' values * (C++). * \f[ \mbox{operator\textgreater=}(x, y) = \begin{cases} 0 & \mbox{if } x < y\\ 1 & \mbox{if } x \geq y \\[6pt] 0 & \mbox{if } x = \textrm{NaN or } y = \textrm{NaN} \end{cases} \f] * * @param a First variable. * @param b Second variable. * @return True if first variable's value is greater than or equal * to the second's. */ inline bool operator>=(const var& a, const var& b) { return a.val() >= b.val(); } /** * Greater than or equal operator comparing variable's value and * double (C++). * * @param a First variable. * @param b Second value. * @return True if first variable's value is greater than or equal * to second value. */ inline bool operator>=(const var& a, double b) { return a.val() >= b; } /** * Greater than or equal operator comparing double and variable's * value (C++). * * @param a First value. * @param b Second variable. * @return True if the first value is greater than or equal to the * second variable's value. */ inline bool operator>=(double a, const var& b) { return a >= b.val(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/var.hpp0000644000176200001440000003602213766554456022026 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_VAR_HPP #define STAN_MATH_REV_CORE_VAR_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { // forward declare static void grad(vari* vi); /** * Independent (input) and dependent (output) variables for gradients. * * This class acts as a smart pointer, with resources managed by * an arena-based memory manager scoped to a single gradient * calculation. * * An var is constructed with a double and used like any * other scalar. Arithmetical functions like negation, addition, * and subtraction, as well as a range of mathematical functions * like exponentiation and powers are overridden to operate on * var values objects. */ class var { public: // FIXME: doc what this is for using Scalar = double; /** * Pointer to the implementation of this variable. * * This value should not be modified, but may be accessed in * var operators to construct vari * instances. */ vari* vi_; /** * Return true if this variable has been * declared, but not been defined. Any attempt to use an * undefined variable's value or adjoint will result in a * segmentation fault. * * @return true if this variable does not yet have * a defined variable. */ bool is_uninitialized() { return (vi_ == static_cast(nullptr)); } /** * Construct a variable for later assignment. * * This is implemented as a no-op, leaving the underlying implementation * dangling. Before an assignment, the behavior is thus undefined just * as for a basic double. */ var() : vi_(static_cast(nullptr)) {} /** * Construct a variable from a pointer to a variable implementation. * * @param vi Variable implementation. */ var(vari* vi) : vi_(vi) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(float x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument as * a value and a zero adjoint. * * @param x Value of the variable. */ var(double x) : vi_(new vari(x)) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(long double x) : vi_(new vari(x)) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(bool x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(char x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(short x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(int x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(long x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(unsigned char x) // NOLINT(runtime/explicit) : vi_(new vari(static_cast(x))) {} /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ // NOLINTNEXTLINE var(unsigned short x) : vi_(new vari(static_cast(x))) {} /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(unsigned int x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ // NOLINTNEXTLINE var(unsigned long x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. Only works * if the imaginary part is zero. * * @param x Value of the variable. */ explicit var(const std::complex& x) { if (imag(x) == 0) { vi_ = new vari(real(x)); } else { std::stringstream ss; ss << "Imaginary part of std::complex used to construct var" << " must be zero. Found real part = " << real(x) << " and " << " found imaginary part = " << imag(x) << std::endl; std::string msg = ss.str(); throw std::invalid_argument(msg); } } /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. Only works * if the imaginary part is zero. * * @param x Value of the variable. */ explicit var(const std::complex& x) { if (imag(x) == 0) { vi_ = new vari(static_cast(real(x))); } else { std::stringstream ss; ss << "Imaginary part of std::complex used to construct var" << " must be zero. Found real part = " << real(x) << " and " << " found imaginary part = " << imag(x) << std::endl; std::string msg = ss.str(); throw std::invalid_argument(msg); } } /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. Only works * if the imaginary part is zero. * * @param x Value of the variable. */ explicit var(const std::complex& x) { if (imag(x) == 0) { vi_ = new vari(static_cast(real(x))); } else { std::stringstream ss; ss << "Imaginary part of std::complex used to construct var" << " must be zero. Found real part = " << real(x) << " and " << " found imaginary part = " << imag(x) << std::endl; std::string msg = ss.str(); throw std::invalid_argument(msg); } } #ifdef _WIN64 // these two ctors are for Win64 to enable 64-bit signed // and unsigned integers, because long and unsigned long // are still 32-bit /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(size_t x) : vi_(new vari(static_cast(x))) {} // NOLINT /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(ptrdiff_t x) : vi_(new vari(static_cast(x))) {} // NOLINT #endif #ifdef BOOST_MATH_USE_FLOAT128 // this ctor is for later GCCs that have the __float128 // type enabled, because it gets enabled by boost /** * Construct a variable from the specified arithmetic argument * by constructing a new vari with the argument * cast to double, and a zero adjoint. * * @param x Value of the variable. */ var(__float128 x) : vi_(new vari(static_cast(x))) {} // NOLINT #endif /** * Return the value of this variable. * * @return The value of this variable. */ inline double val() const { return vi_->val_; } /** * Return the derivative of the root expression with * respect to this expression. This method only works * after one of the grad() methods has been * called. * * @return Adjoint for this variable. */ inline double adj() const { return vi_->adj_; } /** * Compute the gradient of this (dependent) variable with respect to * the specified vector of (independent) variables, assigning the * specified vector to the gradient. * * The grad() function does not recover memory. In Stan * 2.4 and earlier, this function did recover memory. * * @param x Vector of independent variables. * @param g Gradient vector of partial derivatives of this * variable with respect to x. */ void grad(std::vector& x, std::vector& g) { stan::math::grad(vi_); g.resize(x.size()); for (size_t i = 0; i < x.size(); ++i) { g[i] = x[i].vi_->adj_; } } /** * Compute the gradient of this (dependent) variable with respect * to all (independent) variables. * * The grad() function does not recover memory. */ void grad() { stan::math::grad(vi_); } // POINTER OVERRIDES /** * Return a reference to underlying implementation of this variable. * * If x is of type var, then applying * this operator, *x, has the same behavior as * *(x.vi_). * * Warning: The returned reference does not track changes to * this variable. * * @return variable */ inline vari& operator*() { return *vi_; } /** * Return a pointer to the underlying implementation of this variable. * * If x is of type var, then applying * this operator, x->, behaves the same way as * x.vi_->. * * Warning: The returned result does not track changes to * this variable. */ inline vari* operator->() { return vi_; } // COMPOUND ASSIGNMENT OPERATORS /** * The compound add/assignment operator for variables (C++). * * If this variable is a and the argument is the variable b, * then (a += b) behaves exactly the same way as (a = a + b), * creating an intermediate variable representing (a + b). * * @param b The variable to add to this variable. * @return The result of adding the specified variable to this variable. */ inline var& operator+=(const var& b); /** * The compound add/assignment operator for scalars (C++). * * If this variable is a and the argument is the scalar b, then * (a += b) behaves exactly the same way as (a = a + b). Note * that the result is an assignable lvalue. * * @param b The scalar to add to this variable. * @return The result of adding the specified variable to this variable. */ inline var& operator+=(double b); /** * The compound subtract/assignment operator for variables (C++). * * If this variable is a and the argument is the variable b, * then (a -= b) behaves exactly the same way as (a = a - b). * Note that the result is an assignable lvalue. * * @param b The variable to subtract from this variable. * @return The result of subtracting the specified variable from * this variable. */ inline var& operator-=(const var& b); /** * The compound subtract/assignment operator for scalars (C++). * * If this variable is a and the argument is the scalar b, then * (a -= b) behaves exactly the same way as (a = a - b). Note * that the result is an assignable lvalue. * * @param b The scalar to subtract from this variable. * @return The result of subtracting the specified variable from this * variable. */ inline var& operator-=(double b); /** * The compound multiply/assignment operator for variables (C++). * * If this variable is a and the argument is the variable b, * then (a *= b) behaves exactly the same way as (a = a * b). * Note that the result is an assignable lvalue. * * @param b The variable to multiply this variable by. * @return The result of multiplying this variable by the * specified variable. */ inline var& operator*=(const var& b); /** * The compound multiply/assignment operator for scalars (C++). * * If this variable is a and the argument is the scalar b, then * (a *= b) behaves exactly the same way as (a = a * b). Note * that the result is an assignable lvalue. * * @param b The scalar to multiply this variable by. * @return The result of multplying this variable by the specified * variable. */ inline var& operator*=(double b); /** * The compound divide/assignment operator for variables (C++). If this * variable is a and the argument is the variable b, then (a /= b) * behaves exactly the same way as (a = a / b). Note that the * result is an assignable lvalue. * * @param b The variable to divide this variable by. * @return The result of dividing this variable by the * specified variable. */ inline var& operator/=(const var& b); /** * The compound divide/assignment operator for scalars (C++). * * If this variable is a and the argument is the scalar b, then * (a /= b) behaves exactly the same way as (a = a / b). Note * that the result is an assignable lvalue. * * @param b The scalar to divide this variable by. * @return The result of dividing this variable by the specified * variable. */ inline var& operator/=(double b); /** * Write the value of this auto-dif variable and its adjoint to * the specified output stream. * * @param os Output stream to which to write. * @param v Variable to write. * @return Reference to the specified output stream. */ friend std::ostream& operator<<(std::ostream& os, const var& v) { if (v.vi_ == nullptr) { return os << "uninitialized"; } return os << v.val(); } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/chainable_alloc.hpp0000644000176200001440000000124713766554456024317 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_CHAINABLE_ALLOC_HPP #define STAN_MATH_REV_CORE_CHAINABLE_ALLOC_HPP #include namespace stan { namespace math { /** * A chainable_alloc is an object which is constructed and * destructed normally but the memory lifespan is managed along * with the arena allocator for the gradient calculation. A * chainable_alloc instance must be created with a call to * operator new for memory management. */ class chainable_alloc { public: chainable_alloc() { ChainableStack::instance_->var_alloc_stack_.push_back(this); } virtual ~chainable_alloc() {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_plus_equal.hpp0000644000176200001440000000102213766554456025313 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_PLUS_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_PLUS_EQUAL_HPP #include #include namespace stan { namespace math { inline var& var::operator+=(const var& b) { vi_ = new internal::add_vv_vari(vi_, b.vi_); return *this; } inline var& var::operator+=(double b) { if (b == 0.0) { return *this; } vi_ = new internal::add_vd_vari(vi_, b); return *this; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/operator_multiply_equal.hpp0000644000176200001440000000105213766554456026212 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_OPERATOR_MULTIPLY_EQUAL_HPP #define STAN_MATH_REV_CORE_OPERATOR_MULTIPLY_EQUAL_HPP #include #include namespace stan { namespace math { inline var& var::operator*=(const var& b) { vi_ = new internal::multiply_vv_vari(vi_, b.vi_); return *this; } inline var& var::operator*=(double b) { if (b == 1.0) { return *this; } vi_ = new internal::multiply_vd_vari(vi_, b); return *this; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core/ddv_vari.hpp0000644000176200001440000000063013766554456023030 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_DDV_VARI_HPP #define STAN_MATH_REV_CORE_DDV_VARI_HPP #include namespace stan { namespace math { class op_ddv_vari : public vari { protected: double ad_; double bd_; vari* cvi_; public: op_ddv_vari(double f, double a, double b, vari* cvi) : vari(f), ad_(a), bd_(b), cvi_(cvi) {} }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/rev/core.hpp0000644000176200001440000000573413766554456021244 0ustar liggesusers#ifndef STAN_MATH_REV_CORE_HPP #define STAN_MATH_REV_CORE_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/mix/0000755000176200001440000000000013766554456017573 5ustar liggesusersStanHeaders/inst/include/stan/math/mix/scal.hpp0000644000176200001440000000032113766554456021222 0ustar liggesusers#ifndef STAN_MATH_MIX_SCAL_HPP #define STAN_MATH_MIX_SCAL_HPP #include #include #include #include #endif StanHeaders/inst/include/stan/math/mix/mat.hpp0000644000176200001440000000151013766554456021062 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_HPP #define STAN_MATH_MIX_MAT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/mix/arr.hpp0000644000176200001440000000031413766554456021066 0ustar liggesusers#ifndef STAN_MATH_MIX_ARR_HPP #define STAN_MATH_MIX_ARR_HPP #include #include #include #include #endif StanHeaders/inst/include/stan/math/mix/meta.hpp0000644000176200001440000000076213766554456021237 0ustar liggesusers#ifndef STAN_MATH_MIX_META_HPP #define STAN_MATH_MIX_META_HPP #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/mix/mat/0000755000176200001440000000000013766604372020345 5ustar liggesusersStanHeaders/inst/include/stan/math/mix/mat/fun/0000755000176200001440000000000013766554456021144 5ustar liggesusersStanHeaders/inst/include/stan/math/mix/mat/fun/typedefs.hpp0000644000176200001440000000141413766554456023500 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUN_TYPEDEFS_HPP #define STAN_MATH_MIX_MAT_FUN_TYPEDEFS_HPP #include #include #include #include namespace stan { namespace math { using matrix_fv = Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic>; using matrix_ffv = Eigen::Matrix>, Eigen::Dynamic, Eigen::Dynamic>; using vector_fv = Eigen::Matrix, Eigen::Dynamic, 1>; using vector_ffv = Eigen::Matrix>, Eigen::Dynamic, 1>; using row_vector_fv = Eigen::Matrix, 1, Eigen::Dynamic>; using row_vector_ffv = Eigen::Matrix>, 1, Eigen::Dynamic>; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/0000755000176200001440000000000013766554456022034 5ustar liggesusersStanHeaders/inst/include/stan/math/mix/mat/functor/grad_tr_mat_times_hessian.hpp0000644000176200001440000000312313766554456027742 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_GRAD_TR_MAT_TIMES_HESSIAN_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_GRAD_TR_MAT_TIMES_HESSIAN_HPP #include #include #include #include #include #include namespace stan { namespace math { template void grad_tr_mat_times_hessian( const F& f, const Eigen::Matrix& x, const Eigen::Matrix& M, Eigen::Matrix& grad_tr_MH) { using Eigen::Dynamic; using Eigen::Matrix; start_nested(); try { grad_tr_MH.resize(x.size()); Matrix x_var(x.size()); for (int i = 0; i < x.size(); ++i) { x_var(i) = x(i); } Matrix, Dynamic, 1> x_fvar(x.size()); var sum(0.0); Matrix M_n(x.size()); for (int n = 0; n < x.size(); ++n) { for (int k = 0; k < x.size(); ++k) { M_n(k) = M(n, k); } for (int k = 0; k < x.size(); ++k) { x_fvar(k) = fvar(x_var(k), k == n); } fvar fx; fvar grad_fx_dot_v; gradient_dot_vector, double>(f, x_fvar, M_n, fx, grad_fx_dot_v); sum += grad_fx_dot_v.d_; } grad(sum.vi_); for (int i = 0; i < x.size(); ++i) { grad_tr_MH(i) = x_var(i).adj(); } } catch (const std::exception& e) { recover_memory_nested(); throw; } recover_memory_nested(); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/gradient_dot_vector.hpp0000644000176200001440000000153513766554456026576 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_GRADIENT_DOT_VECTOR_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_GRADIENT_DOT_VECTOR_HPP #include #include #include #include namespace stan { namespace math { template void gradient_dot_vector(const F& f, const Eigen::Matrix& x, const Eigen::Matrix& v, T1& fx, T1& grad_fx_dot_v) { using Eigen::Matrix; Matrix, Eigen::Dynamic, 1> x_fvar(x.size()); for (int i = 0; i < x.size(); ++i) { x_fvar(i) = fvar(x(i), v(i)); } fvar fx_fvar = f(x_fvar); fx = fx_fvar.val_; grad_fx_dot_v = fx_fvar.d_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/hessian.hpp0000644000176200001440000000425313766554456024203 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_HESSIAN_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_HESSIAN_HPP #include #include #include #include namespace stan { namespace math { /** * Calculate the value, the gradient, and the Hessian, * of the specified function at the specified argument in * O(N^2) time and O(N^2) space. * *

The functor must implement * * * fvar\ * operator()(const * Eigen::Matrix\, Eigen::Dynamic, 1\>&) * * * using only operations that are defined for * fvar and var. * * This latter constraint usually * requires the functions to be defined in terms of the libraries * defined in Stan or in terms of functions with appropriately * general namespace imports that eventually depend on functions * defined in Stan. * * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] grad gradient of function at argument * @param[out] H Hessian of function at argument */ template void hessian(const F& f, const Eigen::Matrix& x, double& fx, Eigen::Matrix& grad, Eigen::Matrix& H) { H.resize(x.size(), x.size()); grad.resize(x.size()); // need to compute fx even with size = 0 if (x.size() == 0) { fx = f(x); return; } try { for (int i = 0; i < x.size(); ++i) { start_nested(); Eigen::Matrix, Eigen::Dynamic, 1> x_fvar(x.size()); for (int j = 0; j < x.size(); ++j) { x_fvar(j) = fvar(x(j), i == j); } fvar fx_fvar = f(x_fvar); grad(i) = fx_fvar.d_.val(); if (i == 0) { fx = fx_fvar.val_.val(); } stan::math::grad(fx_fvar.d_.vi_); for (int j = 0; j < x.size(); ++j) { H(i, j) = x_fvar(j).val_.adj(); } recover_memory_nested(); } } catch (const std::exception& e) { recover_memory_nested(); throw; } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/finite_diff_grad_hessian.hpp0000644000176200001440000000441613766554456027527 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_FINITE_DIFF_GRAD_HESSIAN_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_FINITE_DIFF_GRAD_HESSIAN_HPP #include #include #include #include namespace stan { namespace math { /** * Calculate the value and the gradient of the hessian of the specified * function at the specified argument using second-order autodiff and * first-order finite difference. * *

The functor must implement * * * double * operator()(const * Eigen::Matrix&) * * * Reference: * * De Levie: An improved numerical approximation * for the first derivative, page 3 * * 4 calls to the function, f. * * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] hess Hessian matrix * @param[out] grad_hess_fx gradient of Hessian of function at argument * @param[in] epsilon perturbation size */ template void finite_diff_grad_hessian(const F& f, const Eigen::VectorXd& x, double& fx, Eigen::MatrixXd& hess, std::vector& grad_hess_fx, double epsilon = 1e-04) { int d = x.size(); grad_hess_fx.clear(); Eigen::VectorXd x_temp(x); Eigen::VectorXd grad_auto(d); Eigen::MatrixXd hess_auto(d, d); Eigen::MatrixXd hess_diff(d, d); hessian(f, x, fx, grad_auto, hess); for (int i = 0; i < d; ++i) { double dummy_fx_eval; hess_diff.setZero(); x_temp(i) = x(i) + 2.0 * epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff = -hess_auto; x_temp(i) = x(i) + -2.0 * epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff += hess_auto; x_temp(i) = x(i) + epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff += 8.0 * hess_auto; x_temp(i) = x(i) + -epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff -= 8.0 * hess_auto; x_temp(i) = x(i); hess_diff /= 12.0 * epsilon; grad_hess_fx.push_back(hess_diff); } fx = f(x); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/derivative.hpp0000644000176200001440000000147313766554456024714 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_DERIVATIVE_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_DERIVATIVE_HPP #include #include #include #include namespace stan { namespace math { /** * Return the derivative of the specified univariate function at * the specified argument. * * @tparam T Argument type * @tparam F Function type * @param[in] f Function * @param[in] x Argument * @param[out] fx Value of function applied to argument * @param[out] dfx_dx Value of derivative */ template void derivative(const F& f, const T& x, T& fx, T& dfx_dx) { fvar x_fvar = fvar(x, 1.0); fvar fx_fvar = f(x_fvar); fx = fx_fvar.val_; dfx_dx = fx_fvar.d_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/finite_diff_grad_hessian_auto.hpp0000644000176200001440000000517413766554456030561 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_FINITE_DIFF_GRAD_HESSIAN_AUTO_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_FINITE_DIFF_GRAD_HESSIAN_AUTO_HPP #include #include #include #include #include namespace stan { namespace math { /** * Calculate the value, Hessian, and the gradient of the Hessian of * the specified function at the specified argument using second-order * autodiff and first-order finite difference. * *

The functor must implement * * * double operator()(const Eigen::VectorXd&) const; * * *

Reference for finite difference to compute gradient: * *
De Levie: An improved numerical approximation * for the first derivative, page 3 * *

Step size for dimension `i` is set automatically using * `stan::math::finite_diff_stepsize(H(i, j))`; the nested * finite differences are over entries in the Hessian. * *

Evaluating this function involves 6 calls to the Hessian * autodiff function for each entry in the Hessian. * * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] hess Hessian matrix * @param[out] grad_hess_fx gradient of Hessian of function at argument */ template void finite_diff_grad_hessian_auto(const F& f, const Eigen::VectorXd& x, double& fx, Eigen::MatrixXd& hess, std::vector& grad_hess_fx) { int d = x.size(); grad_hess_fx.clear(); grad_hess_fx.reserve(d); Eigen::VectorXd x_temp(x); Eigen::VectorXd grad_auto(d); Eigen::MatrixXd hess_auto(d, d); Eigen::MatrixXd hess_diff(d, d); hessian(f, x, fx, grad_auto, hess); for (int i = 0; i < d; ++i) { double dummy_fx_eval; double epsilon = finite_diff_stepsize(x(i)); hess_diff.setZero(); x_temp(i) = x(i) + 2 * epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff = -hess_auto; x_temp(i) = x(i) + -2 * epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff += hess_auto; x_temp(i) = x(i) + epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff += 8 * hess_auto; x_temp(i) = x(i) + -epsilon; hessian(f, x_temp, dummy_fx_eval, grad_auto, hess_auto); hess_diff -= 8 * hess_auto; x_temp(i) = x(i); hess_diff /= 12 * epsilon; grad_hess_fx.push_back(hess_diff); } fx = f(x); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/hessian_times_vector.hpp0000644000176200001440000000321713766554456026765 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_HESSIAN_TIMES_VECTOR_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_HESSIAN_TIMES_VECTOR_HPP #include #include #include #include #include namespace stan { namespace math { template void hessian_times_vector(const F& f, const Eigen::Matrix& x, const Eigen::Matrix& v, double& fx, Eigen::Matrix& Hv) { using Eigen::Matrix; start_nested(); try { Matrix x_var(x.size()); for (int i = 0; i < x_var.size(); ++i) { x_var(i) = x(i); } var fx_var; var grad_fx_var_dot_v; gradient_dot_vector(f, x_var, v, fx_var, grad_fx_var_dot_v); fx = fx_var.val(); grad(grad_fx_var_dot_v.vi_); Hv.resize(x.size()); for (int i = 0; i < x.size(); ++i) { Hv(i) = x_var(i).adj(); } } catch (const std::exception& e) { recover_memory_nested(); throw; } recover_memory_nested(); } template void hessian_times_vector(const F& f, const Eigen::Matrix& x, const Eigen::Matrix& v, T& fx, Eigen::Matrix& Hv) { using Eigen::Matrix; Matrix grad; Matrix H; hessian(f, x, fx, grad, H); Hv = H * v; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/partial_derivative.hpp0000644000176200001440000000216113766554456026423 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_PARTIAL_DERIVATIVE_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_PARTIAL_DERIVATIVE_HPP #include #include #include #include namespace stan { namespace math { /** * Return the partial derivative of the specified multiivariate * function at the specified argument. * * @tparam T Argument type * @tparam F Function type * @param f Function * @param[in] x Argument vector * @param[in] n Index of argument with which to take derivative * @param[out] fx Value of function applied to argument * @param[out] dfx_dxn Value of partial derivative */ template void partial_derivative(const F& f, const Eigen::Matrix& x, int n, T& fx, T& dfx_dxn) { Eigen::Matrix, Eigen::Dynamic, 1> x_fvar(x.size()); for (int i = 0; i < x.size(); ++i) { x_fvar(i) = fvar(x(i), i == n); } fvar fx_fvar = f(x_fvar); fx = fx_fvar.val_; dfx_dxn = fx_fvar.d_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/mix/mat/functor/grad_hessian.hpp0000644000176200001440000000456713766554456025210 0ustar liggesusers#ifndef STAN_MATH_MIX_MAT_FUNCTOR_GRAD_HESSIAN_HPP #define STAN_MATH_MIX_MAT_FUNCTOR_GRAD_HESSIAN_HPP #include #include #include #include #include namespace stan { namespace math { /** * Calculate the value, the Hessian, and the gradient of the Hessian * of the specified function at the specified argument. * *

The functor must implement * * * fvar\ \> * operator()(const Eigen::Matrix\ \>, * Eigen::Dynamic, 1\>&) * * * using only operations that are defined for * fvar and var. * * This latter constraint usually * requires the functions to be defined in terms of the libraries * defined in Stan or in terms of functions with appropriately * general namespace imports that eventually depend on functions * defined in Stan. * * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] H Hessian of function at argument * @param[out] grad_H Gradient of the Hessian of function at argument */ template void grad_hessian( const F& f, const Eigen::Matrix& x, double& fx, Eigen::Matrix& H, std::vector >& grad_H) { using Eigen::Dynamic; using Eigen::Matrix; fx = f(x); int d = x.size(); H.resize(d, d); grad_H.resize(d, Matrix(d, d)); try { for (int i = 0; i < d; ++i) { for (int j = i; j < d; ++j) { start_nested(); Matrix >, Dynamic, 1> x_ffvar(d); for (int k = 0; k < d; ++k) { x_ffvar(k) = fvar >(fvar(x(k), i == k), fvar(j == k, 0)); } fvar > fx_ffvar = f(x_ffvar); H(i, j) = fx_ffvar.d_.d_.val(); H(j, i) = H(i, j); grad(fx_ffvar.d_.d_.vi_); for (int k = 0; k < d; ++k) { grad_H[i](j, k) = x_ffvar(k).val_.val_.adj(); grad_H[j](i, k) = grad_H[i](j, k); } recover_memory_nested(); } } } catch (const std::exception& e) { recover_memory_nested(); throw; } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/0000755000176200001440000000000013766554456017556 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/scal.hpp0000644000176200001440000001016013766554456021207 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_HPP #define STAN_MATH_FWD_SCAL_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/fwd/mat.hpp0000644000176200001440000000413013766554456021046 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_HPP #define STAN_MATH_FWD_MAT_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/fwd/arr.hpp0000644000176200001440000000052613766554456021056 0ustar liggesusers#ifndef STAN_MATH_FWD_ARR_HPP #define STAN_MATH_FWD_ARR_HPP #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/fwd/meta.hpp0000644000176200001440000000044413766554456021217 0ustar liggesusers#ifndef STAN_MATH_FWD_META_HPP #define STAN_MATH_FWD_META_HPP #include #include #include #include #endif StanHeaders/inst/include/stan/math/fwd/mat/0000755000176200001440000000000013766604372020330 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/mat/fun/0000755000176200001440000000000013766554456021127 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/mat/fun/crossprod.hpp0000644000176200001440000000105113766554456023653 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_CROSSPROD_HPP #define STAN_MATH_FWD_MAT_FUN_CROSSPROD_HPP #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, C, C> crossprod( const Eigen::Matrix, R, C>& m) { if (m.rows() == 0) { return Eigen::Matrix, C, C>(0, 0); } return multiply(transpose(m), m); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/columns_dot_product.hpp0000644000176200001440000000370713766554456025735 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_COLUMNS_DOT_PRODUCT_HPP #define STAN_MATH_FWD_MAT_FUN_COLUMNS_DOT_PRODUCT_HPP #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, 1, C1> columns_dot_product( const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix, R2, C2>& v2) { check_matching_dims("columns_dot_product", "v1", v1, "v2", v2); Eigen::Matrix, 1, C1> ret(1, v1.cols()); for (size_type j = 0; j < v1.cols(); ++j) { Eigen::Matrix, R1, C1> ccol1 = v1.col(j); Eigen::Matrix, R2, C2> ccol2 = v2.col(j); ret(0, j) = dot_product(ccol1, ccol2); } return ret; } template inline Eigen::Matrix, 1, C1> columns_dot_product( const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix& v2) { check_matching_dims("columns_dot_product", "v1", v1, "v2", v2); Eigen::Matrix, 1, C1> ret(1, v1.cols()); for (size_type j = 0; j < v1.cols(); ++j) { Eigen::Matrix, R1, C1> ccol1 = v1.col(j); Eigen::Matrix ccol = v2.col(j); ret(0, j) = dot_product(ccol1, ccol); } return ret; } template inline Eigen::Matrix, 1, C1> columns_dot_product( const Eigen::Matrix& v1, const Eigen::Matrix, R2, C2>& v2) { check_matching_dims("columns_dot_product", "v1", v1, "v2", v2); Eigen::Matrix, 1, C1> ret(1, v1.cols()); for (size_type j = 0; j < v1.cols(); ++j) { Eigen::Matrix ccol = v1.col(j); Eigen::Matrix, R2, C2> ccol2 = v2.col(j); ret(0, j) = dot_product(ccol, ccol2); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/rows_dot_product.hpp0000644000176200001440000000366213766554456025247 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_ROWS_DOT_PRODUCT_HPP #define STAN_MATH_FWD_MAT_FUN_ROWS_DOT_PRODUCT_HPP #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R1, 1> rows_dot_product( const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix, R2, C2>& v2) { check_matching_dims("rows_dot_product", "v1", v1, "v2", v2); Eigen::Matrix, R1, 1> ret(v1.rows(), 1); for (size_type j = 0; j < v1.rows(); ++j) { Eigen::Matrix, R1, C1> crow1 = v1.row(j); Eigen::Matrix, R2, C2> crow2 = v2.row(j); ret(j, 0) = dot_product(crow1, crow2); } return ret; } template inline Eigen::Matrix, R1, 1> rows_dot_product( const Eigen::Matrix& v1, const Eigen::Matrix, R2, C2>& v2) { check_matching_dims("rows_dot_product", "v1", v1, "v2", v2); Eigen::Matrix, R1, 1> ret(v1.rows(), 1); for (size_type j = 0; j < v1.rows(); ++j) { Eigen::Matrix crow = v1.row(j); Eigen::Matrix, R2, C2> crow2 = v2.row(j); ret(j, 0) = dot_product(crow, crow2); } return ret; } template inline Eigen::Matrix, R1, 1> rows_dot_product( const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix& v2) { check_matching_dims("rows_dot_product", "v1", v1, "v2", v2); Eigen::Matrix, R1, 1> ret(v1.rows(), 1); for (size_type j = 0; j < v1.rows(); ++j) { Eigen::Matrix, R1, C1> crow1 = v1.row(j); Eigen::Matrix crow = v2.row(j); ret(j, 0) = dot_product(crow1, crow); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/unit_vector_constrain.hpp0000644000176200001440000000344213766554456026264 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_UNIT_VECTOR_CONSTRAIN_HPP #define STAN_MATH_FWD_MAT_FUN_UNIT_VECTOR_CONSTRAIN_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R, C> unit_vector_constrain( const Eigen::Matrix, R, C>& y) { using Eigen::Matrix; using std::sqrt; Matrix y_t(y.size()); for (int k = 0; k < y.size(); ++k) { y_t.coeffRef(k) = y.coeff(k).val_; } Matrix unit_vector_y_t = unit_vector_constrain(y_t); Matrix, R, C> unit_vector_y(y.size()); for (int k = 0; k < y.size(); ++k) { unit_vector_y.coeffRef(k).val_ = unit_vector_y_t.coeff(k); } T squared_norm = dot_self(y_t); T norm = sqrt(squared_norm); T inv_norm = inv(norm); Matrix J = divide(tcrossprod(y_t), -norm * squared_norm); for (int m = 0; m < y.size(); ++m) { J.coeffRef(m, m) += inv_norm; for (int k = 0; k < y.size(); ++k) { unit_vector_y.coeffRef(k).d_ = J.coeff(k, m); } } return unit_vector_y; } template inline Eigen::Matrix, R, C> unit_vector_constrain( const Eigen::Matrix, R, C>& y, fvar& lp) { fvar squared_norm = dot_self(y); lp -= 0.5 * squared_norm; return unit_vector_constrain(y); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/columns_dot_self.hpp0000644000176200001440000000120313766554456025173 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_COLUMNS_DOT_SELF_HPP #define STAN_MATH_FWD_MAT_FUN_COLUMNS_DOT_SELF_HPP #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, 1, C> columns_dot_self( const Eigen::Matrix, R, C>& x) { Eigen::Matrix, 1, C> ret(1, x.cols()); for (size_type i = 0; i < x.cols(); i++) { Eigen::Matrix, R, 1> ccol = x.col(i); ret(0, i) = dot_self(ccol); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/mdivide_left_ldlt.hpp0000644000176200001440000000245413766554456025317 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MDIVIDE_LEFT_LDLT_HPP #define STAN_MATH_FWD_MAT_FUN_MDIVIDE_LEFT_LDLT_HPP #include #include #include #include #include namespace stan { namespace math { /** * Returns the solution of the system Ax=b given an LDLT_factor of A * @param A LDLT_factor * @param b Right hand side matrix or vector. * @return x = b A^-1, solution of the linear system. * @throws std::domain_error if rows of b don't match the size of A. */ template inline Eigen::Matrix, R1, C2> mdivide_left_ldlt( const LDLT_factor &A, const Eigen::Matrix, R2, C2> &b) { check_multiplicable("mdivide_left_ldlt", "A", A, "b", b); Eigen::Matrix b_val(b.rows(), b.cols()); Eigen::Matrix b_der(b.rows(), b.cols()); for (int i = 0; i < b.rows(); i++) { for (int j = 0; j < b.cols(); j++) { b_val(i, j) = b(i, j).val_; b_der(i, j) = b(i, j).d_; } } return to_fvar(mdivide_left_ldlt(A, b_val), mdivide_left_ldlt(A, b_der)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/Eigen_NumTraits.hpp0000644000176200001440000000341613766554456024701 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_EIGEN_NUMTRAITS_HPP #define STAN_MATH_FWD_MAT_FUN_EIGEN_NUMTRAITS_HPP #include #include #include #include namespace Eigen { /** * Numerical traits template override for Eigen for automatic * gradient variables. */ template struct NumTraits> : GenericNumTraits> { enum { /** * stan::math::fvar requires initialization */ RequireInitialization = 1, /** * twice the cost to copy a double */ ReadCost = 2 * NumTraits::ReadCost, /** * 2 * AddCost *
* (a + b) = a + b *
* (a + b)' = a' + b' */ AddCost = 2 * NumTraits::AddCost, /** * 3 * MulCost + AddCost *
* (a * b) = a * b *
* (a * b)' = a' * b + a * b' */ MulCost = 3 * NumTraits::MulCost + NumTraits::AddCost }; /** * Return the number of decimal digits that can be represented * without change. Delegates to * std::numeric_limits::digits10(). */ static int digits10() { return std::numeric_limits::digits10; } }; /** * Scalar product traits specialization for Eigen for forward-mode * autodiff variables. */ template struct ScalarBinaryOpTraits, double, BinaryOp> { using ReturnType = stan::math::fvar; }; /** * Scalar product traits specialization for Eigen for forward-mode * autodiff variables. */ template struct ScalarBinaryOpTraits, BinaryOp> { using ReturnType = stan::math::fvar; }; } // namespace Eigen #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/log_softmax.hpp0000644000176200001440000000273213766554456024166 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_LOG_SOFTMAX_HPP #define STAN_MATH_FWD_MAT_FUN_LOG_SOFTMAX_HPP #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, Eigen::Dynamic, 1> log_softmax( const Eigen::Matrix, Eigen::Dynamic, 1>& alpha) { using Eigen::Dynamic; using Eigen::Matrix; Matrix alpha_t(alpha.size()); for (int k = 0; k < alpha.size(); ++k) { alpha_t(k) = alpha(k).val_; } Matrix softmax_alpha_t = softmax(alpha_t); Matrix log_softmax_alpha_t = log_softmax(alpha_t); Matrix, Dynamic, 1> log_softmax_alpha(alpha.size()); for (int k = 0; k < alpha.size(); ++k) { log_softmax_alpha(k).val_ = log_softmax_alpha_t(k); log_softmax_alpha(k).d_ = 0; } for (int m = 0; m < alpha.size(); ++m) { T negative_alpha_m_d_times_softmax_alpha_t_m = -alpha(m).d_ * softmax_alpha_t(m); for (int k = 0; k < alpha.size(); ++k) { if (m == k) { log_softmax_alpha(k).d_ += alpha(m).d_ + negative_alpha_m_d_times_softmax_alpha_t_m; } else { log_softmax_alpha(k).d_ += negative_alpha_m_d_times_softmax_alpha_t_m; } } } return log_softmax_alpha; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/qr_R.hpp0000644000176200001440000000201213766554456022536 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_QR_R_HPP #define STAN_MATH_FWD_MAT_FUN_QR_R_HPP #include #include #include #include namespace stan { namespace math { template Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic> qr_R( const Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic>& m) { using matrix_fwd_t = Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic>; check_nonzero_size("qr_R", "m", m); check_greater_or_equal("qr_R", "m.rows()", m.rows(), m.cols()); Eigen::HouseholderQR qr(m.rows(), m.cols()); qr.compute(m); matrix_fwd_t R = qr.matrixQR().topLeftCorner(m.rows(), m.cols()); for (int i = 0; i < R.rows(); i++) { for (int j = 0; j < i; j++) { R(i, j) = 0.0; } if (i < R.cols() && R(i, i) < 0.0) { R.row(i) *= -1.0; } } return R; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/multiply_lower_tri_self_transpose.hpp0000644000176200001440000000153113766554456030714 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MULTIPLY_LOWER_TRI_SELF_TRANSPOSE_HPP #define STAN_MATH_FWD_MAT_FUN_MULTIPLY_LOWER_TRI_SELF_TRANSPOSE_HPP #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R, R> multiply_lower_tri_self_transpose( const Eigen::Matrix, R, C>& m) { if (m.rows() == 0) { return Eigen::Matrix, R, R>(0, 0); } Eigen::Matrix, R, C> L(m.rows(), m.cols()); L.setZero(); for (size_type i = 0; i < m.rows(); i++) { for (size_type j = 0; (j < i + 1) && (j < m.cols()); j++) { L(i, j) = m(i, j); } } return multiply(L, transpose(L)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/rows_dot_self.hpp0000644000176200001440000000117213766554456024512 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_ROWS_DOT_SELF_HPP #define STAN_MATH_FWD_MAT_FUN_ROWS_DOT_SELF_HPP #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R, 1> rows_dot_self( const Eigen::Matrix, R, C>& x) { Eigen::Matrix, R, 1> ret(x.rows(), 1); for (size_type i = 0; i < x.rows(); i++) { Eigen::Matrix, 1, C> crow = x.row(i); ret(i, 0) = dot_self(crow); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/sum.hpp0000644000176200001440000000160413766554456022445 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_SUM_HPP #define STAN_MATH_FWD_MAT_FUN_SUM_HPP #include #include #include namespace stan { namespace math { /** * Return the sum of the entries of the specified matrix. * * @tparam T Type of matrix entries. * @tparam R Row type of matrix. * @tparam C Column type of matrix. * @param m Matrix. * @return Sum of matrix entries. */ template inline fvar sum(const Eigen::Matrix, R, C>& m) { if (m.size() == 0) { return 0.0; } Eigen::Matrix vals(m.size()); Eigen::Matrix tans(m.size()); for (int i = 0; i < m.size(); ++i) { vals(i) = m(i).val(); tans(i) = m(i).tangent(); } return fvar(sum(vals), sum(tans)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/dot_product.hpp0000644000176200001440000001134413766554456024171 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_DOT_PRODUCT_HPP #define STAN_MATH_FWD_MAT_FUN_DOT_PRODUCT_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar dot_product(const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix, R2, C2>& v2) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); check_matching_sizes("dot_product", "v1", v1, "v2", v2); fvar ret(0, 0); for (size_type i = 0; i < v1.size(); i++) { ret += v1(i) * v2(i); } return ret; } template inline fvar dot_product(const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix& v2) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); check_matching_sizes("dot_product", "v1", v1, "v2", v2); fvar ret(0, 0); for (size_type i = 0; i < v1.size(); i++) { ret += v1(i) * v2(i); } return ret; } template inline fvar dot_product(const Eigen::Matrix& v1, const Eigen::Matrix, R2, C2>& v2) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); check_matching_sizes("dot_product", "v1", v1, "v2", v2); fvar ret(0, 0); for (size_type i = 0; i < v1.size(); i++) { ret += v1(i) * v2(i); } return ret; } template inline fvar dot_product(const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix, R2, C2>& v2, size_type& length) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); fvar ret(0, 0); for (size_type i = 0; i < length; i++) { ret += v1(i) * v2(i); } return ret; } template inline fvar dot_product(const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix& v2, size_type& length) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); fvar ret(0, 0); for (size_type i = 0; i < length; i++) { ret += v1(i) * v2(i); } return ret; } template inline fvar dot_product(const Eigen::Matrix& v1, const Eigen::Matrix, R2, C2>& v2, size_type& length) { check_vector("dot_product", "v1", v1); check_vector("dot_product", "v2", v2); fvar ret(0, 0); for (size_type i = 0; i < length; i++) { ret += v1(i) * v2(i); } return ret; } template inline fvar dot_product(const std::vector >& v1, const std::vector >& v2) { check_matching_sizes("dot_product", "v1", v1, "v2", v2); fvar ret(0, 0); for (size_t i = 0; i < v1.size(); i++) { ret += v1.at(i) * v2.at(i); } return ret; } template inline fvar dot_product(const std::vector& v1, const std::vector >& v2) { check_matching_sizes("dot_product", "v1", v1, "v2", v2); fvar ret(0, 0); for (size_t i = 0; i < v1.size(); i++) { ret += v1.at(i) * v2.at(i); } return ret; } template inline fvar dot_product(const std::vector >& v1, const std::vector& v2) { check_matching_sizes("dot_product", "v1", v1, "v2", v2); fvar ret(0, 0); for (size_t i = 0; i < v1.size(); i++) { ret += v1.at(i) * v2.at(i); } return ret; } template inline fvar dot_product(const std::vector >& v1, const std::vector >& v2, size_type& length) { fvar ret(0, 0); for (size_type i = 0; i < length; i++) { ret += v1.at(i) * v2.at(i); } return ret; } template inline fvar dot_product(const std::vector& v1, const std::vector >& v2, size_type& length) { fvar ret(0, 0); for (size_type i = 0; i < length; i++) { ret += v1.at(i) * v2.at(i); } return ret; } template inline fvar dot_product(const std::vector >& v1, const std::vector& v2, size_type& length) { fvar ret(0, 0); for (size_type i = 0; i < length; i++) { ret += v1.at(i) * v2.at(i); } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/trace_quad_form.hpp0000644000176200001440000000307013766554456024773 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_TRACE_QUAD_FORM_HPP #define STAN_MATH_FWD_MAT_FUN_TRACE_QUAD_FORM_HPP #include #include #include #include #include #include #include namespace stan { namespace math { template inline fvar trace_quad_form(const Eigen::Matrix, RA, CA> &A, const Eigen::Matrix, RB, CB> &B) { check_square("trace_quad_form", "A", A); check_multiplicable("trace_quad_form", "A", A, "B", B); return trace(multiply(transpose(B), multiply(A, B))); } template inline fvar trace_quad_form(const Eigen::Matrix, RA, CA> &A, const Eigen::Matrix &B) { check_square("trace_quad_form", "A", A); check_multiplicable("trace_quad_form", "A", A, "B", B); return trace(multiply(transpose(B), multiply(A, B))); } template inline fvar trace_quad_form(const Eigen::Matrix &A, const Eigen::Matrix, RB, CB> &B) { check_square("trace_quad_form", "A", A); check_multiplicable("trace_quad_form", "A", A, "B", B); return trace(multiply(transpose(B), multiply(A, B))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/mdivide_left.hpp0000644000176200001440000000673113766554456024302 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MDIVIDE_LEFT_HPP #define STAN_MATH_FWD_MAT_FUN_MDIVIDE_LEFT_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R1, C2> mdivide_left( const Eigen::Matrix, R1, C1> &A, const Eigen::Matrix, R2, C2> &b) { check_square("mdivide_left", "A", A); check_multiplicable("mdivide_left", "A", A, "b", b); Eigen::Matrix inv_A_mult_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_A(A.rows(), A.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); for (int j = 0; j < A.cols(); j++) { for (int i = 0; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } for (int j = 0; j < b.cols(); j++) { for (int i = 0; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } inv_A_mult_b = mdivide_left(val_A, val_b); inv_A_mult_deriv_b = mdivide_left(val_A, deriv_b); inv_A_mult_deriv_A = mdivide_left(val_A, deriv_A); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = inv_A_mult_deriv_b - multiply(inv_A_mult_deriv_A, inv_A_mult_b); return to_fvar(inv_A_mult_b, deriv); } template inline Eigen::Matrix, R1, C2> mdivide_left( const Eigen::Matrix &A, const Eigen::Matrix, R2, C2> &b) { check_square("mdivide_left", "A", A); check_multiplicable("mdivide_left", "A", A, "b", b); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); for (int j = 0; j < b.cols(); j++) { for (int i = 0; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } return to_fvar(mdivide_left(A, val_b), mdivide_left(A, deriv_b)); } template inline Eigen::Matrix, R1, C2> mdivide_left( const Eigen::Matrix, R1, C1> &A, const Eigen::Matrix &b) { check_square("mdivide_left", "A", A); check_multiplicable("mdivide_left", "A", A, "b", b); Eigen::Matrix inv_A_mult_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_A(A.rows(), A.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); for (int j = 0; j < A.cols(); j++) { for (int i = 0; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } inv_A_mult_b = mdivide_left(val_A, b); inv_A_mult_deriv_A = mdivide_left(val_A, deriv_A); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = -multiply(inv_A_mult_deriv_A, inv_A_mult_b); return to_fvar(inv_A_mult_b, deriv); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/trace_gen_quad_form.hpp0000644000176200001440000000206613766554456025630 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_TRACE_GEN_QUAD_FORM_HPP #define STAN_MATH_FWD_MAT_FUN_TRACE_GEN_QUAD_FORM_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar trace_gen_quad_form(const Eigen::Matrix, RD, CD> &D, const Eigen::Matrix, RA, CA> &A, const Eigen::Matrix, RB, CB> &B) { check_square("trace_gen_quad_form", "A", A); check_square("trace_gen_quad_form", "D", D); check_multiplicable("trace_gen_quad_form", "A", A, "B", B); check_multiplicable("trace_gen_quad_form", "B", B, "D", D); return trace(multiply(multiply(D, transpose(B)), multiply(A, B))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/divide.hpp0000644000176200001440000000340013766554456023101 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_DIVIDE_HPP #define STAN_MATH_FWD_MAT_FUN_DIVIDE_HPP #include #include namespace stan { namespace math { template inline Eigen::Matrix, R, C> divide( const Eigen::Matrix, R, C>& v, const fvar& c) { Eigen::Matrix, R, C> res(v.rows(), v.cols()); for (int i = 0; i < v.rows(); i++) { for (int j = 0; j < v.cols(); j++) { res(i, j) = v(i, j) / c; } } return res; } template inline Eigen::Matrix, R, C> divide( const Eigen::Matrix, R, C>& v, double c) { Eigen::Matrix, R, C> res(v.rows(), v.cols()); for (int i = 0; i < v.rows(); i++) { for (int j = 0; j < v.cols(); j++) { res(i, j) = v(i, j) / c; } } return res; } template inline Eigen::Matrix, R, C> divide(const Eigen::Matrix& v, const fvar& c) { Eigen::Matrix, R, C> res(v.rows(), v.cols()); for (int i = 0; i < v.rows(); i++) { for (int j = 0; j < v.cols(); j++) { res(i, j) = v(i, j) / c; } } return res; } template inline Eigen::Matrix, R, C> operator/( const Eigen::Matrix, R, C>& v, const fvar& c) { return divide(v, c); } template inline Eigen::Matrix, R, C> operator/( const Eigen::Matrix, R, C>& v, double c) { return divide(v, c); } template inline Eigen::Matrix, R, C> operator/( const Eigen::Matrix& v, const fvar& c) { return divide(v, c); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/typedefs.hpp0000644000176200001440000000152013766554456023461 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_TYPEDEFS_HPP #define STAN_MATH_FWD_MAT_FUN_TYPEDEFS_HPP #include #include #include namespace stan { namespace math { using size_type = Eigen::Matrix::Index; using matrix_fd = Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic>; using matrix_ffd = Eigen::Matrix >, Eigen::Dynamic, Eigen::Dynamic>; using vector_fd = Eigen::Matrix, Eigen::Dynamic, 1>; using vector_ffd = Eigen::Matrix >, Eigen::Dynamic, 1>; using row_vector_fd = Eigen::Matrix, 1, Eigen::Dynamic>; using row_vector_ffd = Eigen::Matrix >, 1, Eigen::Dynamic>; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/dot_self.hpp0000644000176200001440000000100613766554456023434 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_DOT_SELF_HPP #define STAN_MATH_FWD_MAT_FUN_DOT_SELF_HPP #include #include #include #include namespace stan { namespace math { template inline fvar dot_self(const Eigen::Matrix, R, C>& v) { check_vector("dot_self", "v", v); return dot_product(v, v); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/mdivide_left_tri_low.hpp0000644000176200001440000001013413766554456026031 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MDIVIDE_LEFT_TRI_LOW_HPP #define STAN_MATH_FWD_MAT_FUN_MDIVIDE_LEFT_TRI_LOW_HPP #include #include #include #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R1, C1> mdivide_left_tri_low( const Eigen::Matrix, R1, C1>& A, const Eigen::Matrix, R2, C2>& b) { check_square("mdivide_left_tri_low", "A", A); check_multiplicable("mdivide_left_tri_low", "A", A, "b", b); Eigen::Matrix inv_A_mult_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_A(A.rows(), A.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); val_A.setZero(); deriv_A.setZero(); for (size_type j = 0; j < A.cols(); j++) { for (size_type i = j; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } for (size_type j = 0; j < b.cols(); j++) { for (size_type i = 0; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } inv_A_mult_b = mdivide_left(val_A, val_b); inv_A_mult_deriv_b = mdivide_left(val_A, deriv_b); inv_A_mult_deriv_A = mdivide_left(val_A, deriv_A); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = inv_A_mult_deriv_b - multiply(inv_A_mult_deriv_A, inv_A_mult_b); return to_fvar(inv_A_mult_b, deriv); } template inline Eigen::Matrix, R1, C1> mdivide_left_tri_low( const Eigen::Matrix& A, const Eigen::Matrix, R2, C2>& b) { check_square("mdivide_left_tri_low", "A", A); check_multiplicable("mdivide_left_tri_low", "A", A, "b", b); Eigen::Matrix inv_A_mult_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_b(A.rows(), b.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); val_A.setZero(); for (size_type j = 0; j < A.cols(); j++) { for (size_type i = j; i < A.rows(); i++) { val_A(i, j) = A(i, j); } } for (size_type j = 0; j < b.cols(); j++) { for (size_type i = 0; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } inv_A_mult_b = mdivide_left(val_A, val_b); inv_A_mult_deriv_b = mdivide_left(val_A, deriv_b); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = inv_A_mult_deriv_b; return to_fvar(inv_A_mult_b, deriv); } template inline Eigen::Matrix, R1, C1> mdivide_left_tri_low( const Eigen::Matrix, R1, C1>& A, const Eigen::Matrix& b) { check_square("mdivide_left_tri_low", "A", A); check_multiplicable("mdivide_left_tri_low", "A", A, "b", b); Eigen::Matrix inv_A_mult_b(A.rows(), b.cols()); Eigen::Matrix inv_A_mult_deriv_A(A.rows(), A.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); val_A.setZero(); deriv_A.setZero(); for (size_type j = 0; j < A.cols(); j++) { for (size_type i = j; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } inv_A_mult_b = mdivide_left(val_A, b); inv_A_mult_deriv_A = mdivide_left(val_A, deriv_A); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = -multiply(inv_A_mult_deriv_A, inv_A_mult_b); return to_fvar(inv_A_mult_b, deriv); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/to_fvar.hpp0000644000176200001440000000335713766554456023310 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_TO_FVAR_HPP #define STAN_MATH_FWD_MAT_FUN_TO_FVAR_HPP #include #include #include #include namespace stan { namespace math { /** * Specialization of to_fvar for const matrices of fvars * * * @param[in,out] m A matrix of forward automatic differentation variables. * @return The input matrix of forward automatic differentiation variables. */ template inline const Eigen::Matrix& to_fvar(const Eigen::Matrix& m) { return m; } /** * Specialization of to_fvar for non-const matrices of fvars * * * @param[in,out] m A matrix of forward automatic differentation variables. * @return The input matrix of forward automatic differentiation variables. */ template inline Eigen::Matrix& to_fvar(Eigen::Matrix& m) { return m; } template inline Eigen::Matrix, R, C> to_fvar( const Eigen::Matrix& m) { Eigen::Matrix, R, C> m_fd(m.rows(), m.cols()); for (int i = 0; i < m.size(); ++i) { m_fd(i) = m(i); } return m_fd; } template inline Eigen::Matrix, R, C> to_fvar( const Eigen::Matrix& val, const Eigen::Matrix& deriv) { check_matching_dims("to_fvar", "value", val, "deriv", deriv); Eigen::Matrix, R, C> ret(val.rows(), val.cols()); for (int i = 0; i < val.rows(); i++) { for (int j = 0; j < val.cols(); j++) { ret(i, j).val_ = val(i, j); ret(i, j).d_ = deriv(i, j); } } return ret; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/tcrossprod.hpp0000644000176200001440000000105413766554456024042 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_TCROSSPROD_HPP #define STAN_MATH_FWD_MAT_FUN_TCROSSPROD_HPP #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R, R> tcrossprod( const Eigen::Matrix, R, C>& m) { if (m.rows() == 0) { return Eigen::Matrix, R, R>(0, 0); } return multiply(m, transpose(m)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/mdivide_right_tri_low.hpp0000644000176200001440000000752413766554456026225 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MDIVIDE_RIGHT_TRI_LOW_HPP #define STAN_MATH_FWD_MAT_FUN_MDIVIDE_RIGHT_TRI_LOW_HPP #include #include #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R1, C1> mdivide_right_tri_low( const Eigen::Matrix, R1, C1> &A, const Eigen::Matrix, R2, C2> &b) { check_square("mdivide_right_tri_low", "b", b); check_multiplicable("mdivide_right_tri_low", "A", A, "b", b); Eigen::Matrix A_mult_inv_b(A.rows(), b.cols()); Eigen::Matrix deriv_A_mult_inv_b(A.rows(), b.cols()); Eigen::Matrix deriv_b_mult_inv_b(b.rows(), b.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); val_b.setZero(); deriv_b.setZero(); for (size_type j = 0; j < A.cols(); j++) { for (size_type i = 0; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } for (size_type j = 0; j < b.cols(); j++) { for (size_type i = j; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } A_mult_inv_b = mdivide_right(val_A, val_b); deriv_A_mult_inv_b = mdivide_right(deriv_A, val_b); deriv_b_mult_inv_b = mdivide_right(deriv_b, val_b); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = deriv_A_mult_inv_b - multiply(A_mult_inv_b, deriv_b_mult_inv_b); return to_fvar(A_mult_inv_b, deriv); } template inline Eigen::Matrix, R1, C2> mdivide_right_tri_low( const Eigen::Matrix, R1, C1> &A, const Eigen::Matrix &b) { check_square("mdivide_right_tri_low", "b", b); check_multiplicable("mdivide_right_tri_low", "A", A, "b", b); Eigen::Matrix deriv_b_mult_inv_b(b.rows(), b.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); val_b.setZero(); for (int j = 0; j < A.cols(); j++) { for (int i = 0; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } for (size_type j = 0; j < b.cols(); j++) { for (size_type i = j; i < b.rows(); i++) { val_b(i, j) = b(i, j); } } return to_fvar(mdivide_right(val_A, val_b), mdivide_right(deriv_A, val_b)); } template inline Eigen::Matrix, R1, C2> mdivide_right_tri_low( const Eigen::Matrix &A, const Eigen::Matrix, R2, C2> &b) { check_square("mdivide_right_tri_low", "b", b); check_multiplicable("mdivide_right_tri_low", "A", A, "b", b); Eigen::Matrix A_mult_inv_b(A.rows(), b.cols()); Eigen::Matrix deriv_b_mult_inv_b(b.rows(), b.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); val_b.setZero(); deriv_b.setZero(); for (int j = 0; j < b.cols(); j++) { for (int i = j; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } A_mult_inv_b = mdivide_right(A, val_b); deriv_b_mult_inv_b = mdivide_right(deriv_b, val_b); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = -multiply(A_mult_inv_b, deriv_b_mult_inv_b); return to_fvar(A_mult_inv_b, deriv); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/squared_distance.hpp0000644000176200001440000001432113766554456025157 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_SQUARED_DISTANCE_HPP #define STAN_MATH_FWD_MAT_FUN_SQUARED_DISTANCE_HPP #include #include #include #include #include namespace stan { namespace math { /** * Returns the squared distance between the specified vectors * of the same dimensions. * * @tparam R Rows at compile time of vector inputs * @tparam C columns at compile time of vector inputs * @tparam T Child scalar type of fvar vector input * @param v1 First vector. * @param v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error If the vectors are not the same * size or if they are both not vector dimensioned. */ template inline fvar squared_distance(const Eigen::Matrix, R, C>& v1, const Eigen::Matrix& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); Eigen::Matrix, R, C> v3 = subtract(v1, v2); return dot_self(v3); } /** * Returns the squared distance between the specified vectors * of the same dimensions. * * @tparam R1 Rows at compile time of first vector input * @tparam C1 Columns at compile time of first vector input * @tparam R2 Rows at compile time of second vector input * @tparam C2 Columns at compile time of second vector input * @tparam T Child scalar type of fvar vector input * @param v1 First vector. * @param v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error If the vectors are not the same * size or if they are both not vector dimensioned. */ template inline fvar squared_distance(const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); Eigen::Matrix t_v2 = v2.transpose(); Eigen::Matrix, R1, C1> v3 = subtract(v1, t_v2); return dot_self(v3); } /** * Returns the squared distance between the specified vectors * of the same dimensions. * * @tparam R Rows at compile time of vector inputs * @tparam C columns at compile time of vector inputs * @tparam T Child scalar type of fvar vector input * @param v1 First vector. * @param v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error If the vectors are not the same * size or if they are both not vector dimensioned. */ template inline fvar squared_distance(const Eigen::Matrix& v1, const Eigen::Matrix, R, C>& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); Eigen::Matrix, R, C> v3 = subtract(v1, v2); return dot_self(v3); } /** * Returns the squared distance between the specified vectors * of the same dimensions. * * @tparam R1 Rows at compile time of first vector input * @tparam C1 Columns at compile time of first vector input * @tparam R2 Rows at compile time of second vector input * @tparam C2 Columns at compile time of second vector input * @tparam T Child scalar type of fvar vector input * @param v1 First vector. * @param v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error If the vectors are not the same * size or if they are both not vector dimensioned. */ template inline fvar squared_distance(const Eigen::Matrix& v1, const Eigen::Matrix, R2, C2>& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); Eigen::Matrix t_v1 = v1.transpose(); Eigen::Matrix, R2, C2> v3 = subtract(t_v1, v2); return dot_self(v3); } /** * Returns the squared distance between the specified vectors * of the same dimensions. * * @tparam R Rows at compile time of vector inputs * @tparam C columns at compile time of vector inputs * @tparam T Child scalar type of fvar vector input * @param v1 First vector. * @param v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error If the vectors are not the same * size or if they are both not vector dimensioned. */ template inline fvar squared_distance(const Eigen::Matrix, R, C>& v1, const Eigen::Matrix, R, C>& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); Eigen::Matrix, R, C> v3 = subtract(v1, v2); return dot_self(v3); } /** * Returns the squared distance between the specified vectors * of the same dimensions. * * @tparam R1 Rows at compile time of first vector input * @tparam C1 Columns at compile time of first vector input * @tparam R2 Rows at compile time of second vector input * @tparam C2 Columns at compile time of second vector input * @tparam T Child scalar type of fvar vector input * @param v1 First vector. * @param v2 Second vector. * @return Dot product of the vectors. * @throw std::domain_error If the vectors are not the same * size or if they are both not vector dimensioned. */ template inline fvar squared_distance(const Eigen::Matrix, R1, C1>& v1, const Eigen::Matrix, R2, C2>& v2) { check_vector("squared_distance", "v1", v1); check_vector("squared_distance", "v2", v2); check_matching_sizes("squared_distance", "v1", v1, "v2", v2); Eigen::Matrix, R2, C2> t_v1 = v1.transpose(); Eigen::Matrix, R2, C2> v3 = subtract(t_v1, v2); return dot_self(v3); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/inverse.hpp0000644000176200001440000000205013766554456023310 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_INVERSE_HPP #define STAN_MATH_FWD_MAT_FUN_INVERSE_HPP #include #include #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R, C> inverse( const Eigen::Matrix, R, C>& m) { check_square("inverse", "m", m); Eigen::Matrix m_deriv(m.rows(), m.cols()); Eigen::Matrix m_inv(m.rows(), m.cols()); for (size_type i = 0; i < m.rows(); i++) { for (size_type j = 0; j < m.cols(); j++) { m_inv(i, j) = m(i, j).val_; m_deriv(i, j) = m(i, j).d_; } } m_inv = inverse(m_inv); m_deriv = multiply(multiply(m_inv, m_deriv), m_inv); m_deriv = -m_deriv; return to_fvar(m_inv, m_deriv); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/determinant.hpp0000644000176200001440000000106213766554456024151 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_DETERMINANT_HPP #define STAN_MATH_FWD_MAT_FUN_DETERMINANT_HPP #include #include #include namespace stan { namespace math { template inline fvar determinant(const Eigen::Matrix, R, C>& m) { check_square("determinant", "m", m); const T vals = m.val().determinant(); return fvar(vals, vals * (m.val().inverse() * m.d()).trace()); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/qr_Q.hpp0000644000176200001440000000165313766554456022547 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_QR_Q_HPP #define STAN_MATH_FWD_MAT_FUN_QR_Q_HPP #include #include #include #include namespace stan { namespace math { template Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic> qr_Q( const Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic>& m) { using matrix_fwd_t = Eigen::Matrix, Eigen::Dynamic, Eigen::Dynamic>; check_nonzero_size("qr_Q", "m", m); check_greater_or_equal("qr_Q", "m.rows()", m.rows(), m.cols()); Eigen::HouseholderQR qr(m.rows(), m.cols()); qr.compute(m); matrix_fwd_t Q = qr.householderQ(); for (int i = 0; i < m.cols(); i++) { if (qr.matrixQR()(i, i) < 0.0) { Q.col(i) *= -1.0; } } return Q; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/log_determinant.hpp0000644000176200001440000000120013766554456025004 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_LOG_DETERMINANT_HPP #define STAN_MATH_FWD_MAT_FUN_LOG_DETERMINANT_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar log_determinant(const Eigen::Matrix, R, C>& m) { check_square("log_determinant", "m", m); return log(fabs(determinant(m))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/softmax.hpp0000644000176200001440000000252613766554456023326 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_SOFTMAX_HPP #define STAN_MATH_FWD_MAT_FUN_SOFTMAX_HPP #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, Eigen::Dynamic, 1> softmax( const Eigen::Matrix, Eigen::Dynamic, 1>& alpha) { using Eigen::Dynamic; using Eigen::Matrix; Matrix alpha_t(alpha.size()); for (int k = 0; k < alpha.size(); ++k) { alpha_t(k) = alpha(k).val_; } Matrix softmax_alpha_t = softmax(alpha_t); Matrix, Dynamic, 1> softmax_alpha(alpha.size()); for (int k = 0; k < alpha.size(); ++k) { softmax_alpha(k).val_ = softmax_alpha_t(k); softmax_alpha(k).d_ = 0; } for (int m = 0; m < alpha.size(); ++m) { T negative_alpha_m_d_times_softmax_alpha_t_m = -alpha(m).d_ * softmax_alpha_t(m); for (int k = 0; k < alpha.size(); ++k) { if (m == k) { softmax_alpha(k).d_ += softmax_alpha_t(k) * (alpha(m).d_ + negative_alpha_m_d_times_softmax_alpha_t_m); } else { softmax_alpha(k).d_ += negative_alpha_m_d_times_softmax_alpha_t_m * softmax_alpha_t(k); } } } return softmax_alpha; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/quad_form_sym.hpp0000644000176200001440000000367013766554456024513 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_QUAD_FORM_SYM_HPP #define STAN_MATH_FWD_MAT_FUN_QUAD_FORM_SYM_HPP #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, CB, CB> quad_form_sym( const Eigen::Matrix, RA, CA>& A, const Eigen::Matrix& B) { check_square("quad_form_sym", "A", A); check_multiplicable("quad_form_sym", "A", A, "B", B); check_symmetric("quad_form_sym", "A", A); Eigen::Matrix, CB, CB> ret(multiply(transpose(B), multiply(A, B))); return T(0.5) * (ret + transpose(ret)); } template inline fvar quad_form_sym(const Eigen::Matrix, RA, CA>& A, const Eigen::Matrix& B) { check_square("quad_form_sym", "A", A); check_multiplicable("quad_form_sym", "A", A, "B", B); check_symmetric("quad_form_sym", "A", A); return dot_product(B, multiply(A, B)); } template inline Eigen::Matrix, CB, CB> quad_form_sym( const Eigen::Matrix& A, const Eigen::Matrix, RB, CB>& B) { check_square("quad_form_sym", "A", A); check_multiplicable("quad_form_sym", "A", A, "B", B); check_symmetric("quad_form_sym", "A", A); Eigen::Matrix, CB, CB> ret(multiply(transpose(B), multiply(A, B))); return T(0.5) * (ret + transpose(ret)); } template inline fvar quad_form_sym(const Eigen::Matrix& A, const Eigen::Matrix, RB, 1>& B) { check_square("quad_form_sym", "A", A); check_multiplicable("quad_form_sym", "A", A, "B", B); check_symmetric("quad_form_sym", "A", A); return dot_product(B, multiply(A, B)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/log_sum_exp.hpp0000644000176200001440000000114313766554456024160 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_LOG_SUM_EXP_HPP #define STAN_MATH_FWD_MAT_FUN_LOG_SUM_EXP_HPP #include #include #include namespace stan { namespace math { template fvar log_sum_exp(const Eigen::Matrix, R, C>& v) { Eigen::Matrix vals = v.val(); Eigen::Matrix exp_vals = vals.array().exp(); return fvar(log_sum_exp(vals), v.d().cwiseProduct(exp_vals).sum() / exp_vals.sum()); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/multiply.hpp0000644000176200001440000001061113766554456023516 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MULTIPLY_HPP #define STAN_MATH_FWD_MAT_FUN_MULTIPLY_HPP #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R1, C1> multiply( const Eigen::Matrix, R1, C1>& m, const fvar& c) { Eigen::Matrix, R1, C1> res(m.rows(), m.cols()); for (int i = 0; i < m.rows(); i++) { for (int j = 0; j < m.cols(); j++) { res(i, j) = c * m(i, j); } } return res; } template inline Eigen::Matrix, R2, C2> multiply( const Eigen::Matrix, R2, C2>& m, double c) { Eigen::Matrix, R2, C2> res(m.rows(), m.cols()); for (int i = 0; i < m.rows(); i++) { for (int j = 0; j < m.cols(); j++) { res(i, j) = c * m(i, j); } } return res; } template inline Eigen::Matrix, R1, C1> multiply( const Eigen::Matrix& m, const fvar& c) { Eigen::Matrix, R1, C1> res(m.rows(), m.cols()); for (int i = 0; i < m.rows(); i++) { for (int j = 0; j < m.cols(); j++) { res(i, j) = c * m(i, j); } } return res; } template inline Eigen::Matrix, R1, C1> multiply( const fvar& c, const Eigen::Matrix, R1, C1>& m) { return multiply(m, c); } template inline Eigen::Matrix, R1, C1> multiply( double c, const Eigen::Matrix, R1, C1>& m) { return multiply(m, c); } template inline Eigen::Matrix, R1, C1> multiply( const fvar& c, const Eigen::Matrix& m) { return multiply(m, c); } template inline Eigen::Matrix, R1, C2> multiply( const Eigen::Matrix, R1, C1>& m1, const Eigen::Matrix, R2, C2>& m2) { check_multiplicable("multiply", "m1", m1, "m2", m2); Eigen::Matrix, R1, C2> result(m1.rows(), m2.cols()); for (size_type i = 0; i < m1.rows(); i++) { Eigen::Matrix, 1, C1> crow = m1.row(i); for (size_type j = 0; j < m2.cols(); j++) { Eigen::Matrix, R2, 1> ccol = m2.col(j); result(i, j) = dot_product(crow, ccol); } } return result; } template inline Eigen::Matrix, R1, C2> multiply( const Eigen::Matrix, R1, C1>& m1, const Eigen::Matrix& m2) { check_multiplicable("multiply", "m1", m1, "m2", m2); Eigen::Matrix, R1, C2> result(m1.rows(), m2.cols()); for (size_type i = 0; i < m1.rows(); i++) { Eigen::Matrix, 1, C1> crow = m1.row(i); for (size_type j = 0; j < m2.cols(); j++) { Eigen::Matrix ccol = m2.col(j); result(i, j) = dot_product(crow, ccol); } } return result; } template inline Eigen::Matrix, R1, C2> multiply( const Eigen::Matrix& m1, const Eigen::Matrix, R2, C2>& m2) { check_multiplicable("multiply", "m1", m1, "m2", m2); Eigen::Matrix, R1, C2> result(m1.rows(), m2.cols()); for (size_type i = 0; i < m1.rows(); i++) { Eigen::Matrix crow = m1.row(i); for (size_type j = 0; j < m2.cols(); j++) { Eigen::Matrix, R2, 1> ccol = m2.col(j); result(i, j) = dot_product(crow, ccol); } } return result; } template inline fvar multiply(const Eigen::Matrix, 1, C1>& rv, const Eigen::Matrix, R2, 1>& v) { check_multiplicable("multiply", "rv", rv, "v", v); return dot_product(rv, v); } template inline fvar multiply(const Eigen::Matrix, 1, C1>& rv, const Eigen::Matrix& v) { check_multiplicable("multiply", "rv", rv, "v", v); return dot_product(rv, v); } template inline fvar multiply(const Eigen::Matrix& rv, const Eigen::Matrix, R2, 1>& v) { check_multiplicable("multiply", "rv", rv, "v", v); return dot_product(rv, v); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/fun/mdivide_right.hpp0000644000176200001440000000705513766554456024465 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUN_MDIVIDE_RIGHT_HPP #define STAN_MATH_FWD_MAT_FUN_MDIVIDE_RIGHT_HPP #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { template inline Eigen::Matrix, R1, C2> mdivide_right( const Eigen::Matrix, R1, C1> &A, const Eigen::Matrix, R2, C2> &b) { check_square("mdivide_right", "b", b); check_multiplicable("mdivide_right", "A", A, "b", b); Eigen::Matrix A_mult_inv_b(A.rows(), b.cols()); Eigen::Matrix deriv_A_mult_inv_b(A.rows(), b.cols()); Eigen::Matrix deriv_b_mult_inv_b(b.rows(), b.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); for (int j = 0; j < A.cols(); j++) { for (int i = 0; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } for (int j = 0; j < b.cols(); j++) { for (int i = 0; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } A_mult_inv_b = mdivide_right(val_A, val_b); deriv_A_mult_inv_b = mdivide_right(deriv_A, val_b); deriv_b_mult_inv_b = mdivide_right(deriv_b, val_b); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = deriv_A_mult_inv_b - multiply(A_mult_inv_b, deriv_b_mult_inv_b); return to_fvar(A_mult_inv_b, deriv); } template inline Eigen::Matrix, R1, C2> mdivide_right( const Eigen::Matrix, R1, C1> &A, const Eigen::Matrix &b) { check_square("mdivide_right", "b", b); check_multiplicable("mdivide_right", "A", A, "b", b); Eigen::Matrix deriv_b_mult_inv_b(b.rows(), b.cols()); Eigen::Matrix val_A(A.rows(), A.cols()); Eigen::Matrix deriv_A(A.rows(), A.cols()); for (int j = 0; j < A.cols(); j++) { for (int i = 0; i < A.rows(); i++) { val_A(i, j) = A(i, j).val_; deriv_A(i, j) = A(i, j).d_; } } return to_fvar(mdivide_right(val_A, b), mdivide_right(deriv_A, b)); } template inline Eigen::Matrix, R1, C2> mdivide_right( const Eigen::Matrix &A, const Eigen::Matrix, R2, C2> &b) { check_square("mdivide_right", "b", b); check_multiplicable("mdivide_right", "A", A, "b", b); Eigen::Matrix A_mult_inv_b(A.rows(), b.cols()); Eigen::Matrix deriv_b_mult_inv_b(b.rows(), b.cols()); Eigen::Matrix val_b(b.rows(), b.cols()); Eigen::Matrix deriv_b(b.rows(), b.cols()); for (int j = 0; j < b.cols(); j++) { for (int i = 0; i < b.rows(); i++) { val_b(i, j) = b(i, j).val_; deriv_b(i, j) = b(i, j).d_; } } A_mult_inv_b = mdivide_right(A, val_b); deriv_b_mult_inv_b = mdivide_right(deriv_b, val_b); Eigen::Matrix deriv(A.rows(), b.cols()); deriv = -multiply(A_mult_inv_b, deriv_b_mult_inv_b); return to_fvar(A_mult_inv_b, deriv); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/vectorize/0000755000176200001440000000000013766554456022351 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/mat/vectorize/apply_scalar_unary.hpp0000644000176200001440000000212113766554456026746 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_VECTORIZE_APPLY_SCALAR_UNARY_HPP #define STAN_MATH_FWD_MAT_VECTORIZE_APPLY_SCALAR_UNARY_HPP #include #include namespace stan { namespace math { /** * Template specialization to fvar for vectorizing a unary scalar * function. This is a base scalar specialization. It applies * the function specified by the template parameter to the * argument. * * @tparam F Type of function to apply. * @tparam T Value and tangent type for for forward-mode * autodiff variable. */ template struct apply_scalar_unary > { /** * Function return type, which is same as the argument type for * the function, fvar<T>. */ using return_t = fvar; /** * Apply the function specified by F to the specified argument. * * @param x Argument variable. * @return Function applied to the variable. */ static inline return_t apply(const fvar& x) { return F::fun(x); } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/meta/0000755000176200001440000000000013766554456021265 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/mat/meta/operands_and_partials.hpp0000644000176200001440000000761413766554456026342 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_META_OPERANDS_AND_PARTIALS_HPP #define STAN_MATH_FWD_MAT_META_OPERANDS_AND_PARTIALS_HPP #include #include #include #include #include namespace stan { namespace math { namespace internal { // Vectorized Univariate template class ops_partials_edge>> { public: using Op = std::vector>; using partials_t = Eigen::Matrix; partials_t partials_; // For univariate use-cases broadcast_array partials_vec_; // For multivariate explicit ops_partials_edge(const Op& ops) : partials_(partials_t::Zero(ops.size())), partials_vec_(partials_), operands_(ops) {} private: template friend class stan::math::operands_and_partials; const Op& operands_; Dx dx() { Dx derivative(0); for (size_t i = 0; i < this->operands_.size(); ++i) { derivative += this->partials_[i] * this->operands_[i].d_; } return derivative; } }; template class ops_partials_edge, R, C>> { public: using partials_t = Eigen::Matrix; using Op = Eigen::Matrix, R, C>; partials_t partials_; // For univariate use-cases broadcast_array partials_vec_; // For multivariate explicit ops_partials_edge(const Op& ops) : partials_(partials_t::Zero(ops.rows(), ops.cols())), partials_vec_(partials_), operands_(ops) {} private: template friend class stan::math::operands_and_partials; const Op& operands_; Dx dx() { Dx derivative(0); for (int i = 0; i < this->operands_.size(); ++i) { derivative += this->partials_(i) * this->operands_(i).d_; } return derivative; } }; // Multivariate; vectors of eigen types template class ops_partials_edge, R, C>>> { public: using Op = std::vector, R, C>>; using partial_t = Eigen::Matrix; std::vector partials_vec_; explicit ops_partials_edge(const Op& ops) : partials_vec_(ops.size()), operands_(ops) { for (size_t i = 0; i < ops.size(); ++i) { partials_vec_[i] = partial_t::Zero(ops[i].rows(), ops[i].cols()); } } private: template friend class stan::math::operands_and_partials; const Op& operands_; Dx dx() { Dx derivative(0); for (size_t i = 0; i < this->operands_.size(); ++i) { for (int j = 0; j < this->operands_[i].size(); ++j) { derivative += this->partials_vec_[i](j) * this->operands_[i](j).d_; } } return derivative; } }; template class ops_partials_edge>>> { public: using Op = std::vector>>; using partial_t = std::vector; std::vector partials_vec_; explicit ops_partials_edge(const Op& ops) : partials_vec_(length(ops)), operands_(ops) { for (size_t i = 0; i < length(ops); ++i) { partials_vec_[i] = partial_t(length(ops[i]), 0.0); } } private: template friend class stan::math::operands_and_partials; const Op& operands_; Dx dx() { Dx derivative(0); for (size_t i = 0; i < this->operands_.size(); ++i) { for (size_t j = 0; j < this->operands_[i].size(); ++j) { derivative += this->partials_vec_[i][j] * this->operands_[i][j].d_; } } return derivative; } }; } // namespace internal } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/functor/0000755000176200001440000000000013766554456022017 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/mat/functor/hessian.hpp0000644000176200001440000000426013766554456024164 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUNCTOR_HESSIAN_HPP #define STAN_MATH_FWD_MAT_FUNCTOR_HESSIAN_HPP #include #include namespace stan { namespace math { /** * Calculate the value, the gradient, and the Hessian, * of the specified function at the specified argument in * time O(N^3) time and O(N^2) space. The advantage over the * mixed definition, which is faster for Hessians, is that this * version is itself differentiable. * *

The functor must implement * * * fvar\ \> * operator()(const * Eigen::Matrix\ \>, Eigen::Dynamic, 1\>&) * * * using only operations that are defined for the argument type. * * This latter constraint usually requires the functions to be * defined in terms of the libraries defined in Stan or in terms * of functions with appropriately general namespace imports that * eventually depend on functions defined in Stan. * * @tparam T Type of underlying scalar * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] grad gradient of function at argument * @param[out] H Hessian of function at argument */ template void hessian(const F& f, const Eigen::Matrix& x, T& fx, Eigen::Matrix& grad, Eigen::Matrix& H) { H.resize(x.size(), x.size()); grad.resize(x.size()); // size 0 separate because nothing to loop over in main body if (x.size() == 0) { fx = f(x); return; } Eigen::Matrix >, Eigen::Dynamic, 1> x_fvar(x.size()); for (int i = 0; i < x.size(); ++i) { for (int j = i; j < x.size(); ++j) { for (int k = 0; k < x.size(); ++k) { x_fvar(k) = fvar >(fvar(x(k), j == k), fvar(i == k, 0)); } fvar > fx_fvar = f(x_fvar); if (j == 0) { fx = fx_fvar.val_.val_; } if (i == j) { grad(i) = fx_fvar.d_.val_; } H(i, j) = fx_fvar.d_.d_; H(j, i) = H(i, j); } } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/functor/jacobian.hpp0000644000176200001440000000213413766554456024276 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUNCTOR_JACOBIAN_HPP #define STAN_MATH_FWD_MAT_FUNCTOR_JACOBIAN_HPP #include #include namespace stan { namespace math { template void jacobian(const F& f, const Eigen::Matrix& x, Eigen::Matrix& fx, Eigen::Matrix& J) { using Eigen::Dynamic; using Eigen::Matrix; Matrix, Dynamic, 1> x_fvar(x.size()); J.resize(x_fvar.size(), x.size()); fx.resize(x_fvar.size()); for (int k = 0; k < x.size(); ++k) { x_fvar(k) = fvar(x(k), 0); } x_fvar(0) = fvar(x(0), 1); Matrix, Dynamic, 1> fx_fvar = f(x_fvar); fx = fx_fvar.val(); J.col(0) = fx_fvar.d(); const fvar switch_fvar(0, 1); // flips the tangents on and off for (int i = 1; i < x.size(); ++i) { x_fvar(i - 1) -= switch_fvar; x_fvar(i) += switch_fvar; Matrix, Dynamic, 1> fx_fvar = f(x_fvar); J.col(i) = fx_fvar.d(); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/mat/functor/gradient.hpp0000644000176200001440000000322413766554456024326 0ustar liggesusers#ifndef STAN_MATH_FWD_MAT_FUNCTOR_GRADIENT_HPP #define STAN_MATH_FWD_MAT_FUNCTOR_GRADIENT_HPP #include #include namespace stan { namespace math { /** * Calculate the value and the gradient of the specified function * at the specified argument. * *

The functor must implement * * * fvar * operator()(const Eigen::Matrix&) * * * using only operations that are defined for * fvar. This latter constraint usually * requires the functions to be defined in terms of the libraries * defined in Stan or in terms of functions with appropriately * general namespace imports that eventually depend on functions * defined in Stan. * *

Time and memory usage is on the order of the size of the * fully unfolded expression for the function applied to the * argument, independently of dimension. * * @tparam F Type of function * @param[in] f Function * @param[in] x Argument to function * @param[out] fx Function applied to argument * @param[out] grad_fx Gradient of function at argument */ template void gradient(const F& f, const Eigen::Matrix& x, T& fx, Eigen::Matrix& grad_fx) { Eigen::Matrix, Eigen::Dynamic, 1> x_fvar(x.size()); grad_fx.resize(x.size()); for (int i = 0; i < x.size(); ++i) { for (int k = 0; k < x.size(); ++k) { x_fvar(k) = fvar(x(k), k == i); } fvar fx_fvar = f(x_fvar); if (i == 0) { fx = fx_fvar.val_; } grad_fx(i) = fx_fvar.d_; } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/arr/0000755000176200001440000000000013766604372020333 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/arr/fun/0000755000176200001440000000000013766554456021132 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/arr/fun/sum.hpp0000644000176200001440000000136513766554456022454 0ustar liggesusers#ifndef STAN_MATH_FWD_ARR_FUN_SUM_HPP #define STAN_MATH_FWD_ARR_FUN_SUM_HPP #include #include #include namespace stan { namespace math { /** * Return the sum of the entries of the specified standard * vector. * * @tparam T Type of vector entries. * @param m Vector. * @return Sum of vector entries. */ template inline fvar sum(const std::vector >& m) { if (m.size() == 0) { return 0.0; } std::vector vals(m.size()); std::vector tans(m.size()); for (size_t i = 0; i < m.size(); ++i) { vals[i] = m[i].val(); tans[i] = m[i].tangent(); } return fvar(sum(vals), sum(tans)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/arr/fun/to_fvar.hpp0000644000176200001440000000267113766554456023311 0ustar liggesusers#ifndef STAN_MATH_FWD_ARR_FUN_TO_FVAR_HPP #define STAN_MATH_FWD_ARR_FUN_TO_FVAR_HPP #include #include #include namespace stan { namespace math { template inline std::vector> to_fvar(const std::vector& v) { std::vector> x(v.size()); for (size_t i = 0; i < v.size(); ++i) { x[i] = T(v[i]); } return x; } template inline std::vector> to_fvar(const std::vector& v, const std::vector& d) { std::vector> x(v.size()); for (size_t i = 0; i < v.size(); ++i) { x[i] = fvar(v[i], d[i]); } return x; } /** * Specialization of to_fvar for const fvar input * * @tparam The inner type of the fvar. * @param[in,out] v A vector of forward automatic differentiation variable. * @return The input vector of forward automatic differentiation variable. */ template inline const std::vector>& to_fvar(const std::vector>& v) { return v; } /** * Specialization of to_fvar for non-const fvar input * * @tparam The inner type of the fvar. * @param[in,out] v A vector of forward automatic differentiation variable. * @return The input vector of forward automatic differentiation variable. */ template inline std::vector>& to_fvar(std::vector>& v) { return v; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/arr/fun/log_sum_exp.hpp0000644000176200001440000000130613766554456024164 0ustar liggesusers#ifndef STAN_MATH_FWD_ARR_FUN_LOG_SUM_EXP_HPP #define STAN_MATH_FWD_ARR_FUN_LOG_SUM_EXP_HPP #include #include #include namespace stan { namespace math { template fvar log_sum_exp(const std::vector >& v) { using std::exp; std::vector vals(v.size()); for (size_t i = 0; i < v.size(); ++i) { vals[i] = v[i].val_; } T deriv(0.0); T denominator(0.0); for (size_t i = 0; i < v.size(); ++i) { T exp_vi = exp(vals[i]); denominator += exp_vi; deriv += v[i].d_ * exp_vi; } return fvar(log_sum_exp(vals), deriv / denominator); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/0000755000176200001440000000000013766604372020471 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/scal/fun/0000755000176200001440000000000013766554456021270 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/scal/fun/bessel_second_kind.hpp0000644000176200001440000000116113766554456025615 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_BESSEL_SECOND_KIND_HPP #define STAN_MATH_FWD_SCAL_FUN_BESSEL_SECOND_KIND_HPP #include #include #include namespace stan { namespace math { template inline fvar bessel_second_kind(int v, const fvar& z) { T bessel_second_kind_z(bessel_second_kind(v, z.val_)); return fvar(bessel_second_kind_z, v * z.d_ * bessel_second_kind_z / z.val_ - z.d_ * bessel_second_kind(v + 1, z.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_inv_logit.hpp0000644000176200001440000000071713766554456024641 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_INV_LOGIT_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_INV_LOGIT_HPP #include #include #include namespace stan { namespace math { template inline fvar log_inv_logit(const fvar& x) { using std::exp; return fvar(log_inv_logit(x.val_), x.d_ / (1 + exp(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/ceil.hpp0000644000176200001440000000056213766554456022720 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_CEIL_HPP #define STAN_MATH_FWD_SCAL_FUN_CEIL_HPP #include #include #include namespace stan { namespace math { template inline fvar ceil(const fvar& x) { using std::ceil; return fvar(ceil(x.val_), 0); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/tan.hpp0000644000176200001440000000061613766554456022566 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_TAN_HPP #define STAN_MATH_FWD_SCAL_FUN_TAN_HPP #include #include namespace stan { namespace math { template inline fvar tan(const fvar& x) { using std::cos; using std::tan; return fvar(tan(x.val_), x.d_ / (cos(x.val_) * cos(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log1p.hpp0000644000176200001440000000062113766554456023022 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG1P_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG1P_HPP #include #include #include namespace stan { namespace math { template inline fvar log1p(const fvar& x) { return fvar(log1p(x.val_), x.d_ / (1 + x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log1p_exp.hpp0000644000176200001440000000067513766554456023707 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG1P_EXP_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG1P_EXP_HPP #include #include #include namespace stan { namespace math { template inline fvar log1p_exp(const fvar& x) { using std::exp; return fvar(log1p_exp(x.val_), x.d_ / (1 + exp(-x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log1m_inv_logit.hpp0000644000176200001440000000136013766554456025072 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG1M_INV_LOGIT_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG1M_INV_LOGIT_HPP #include #include #include #include namespace stan { namespace math { /** * Return the natural logarithm of one minus the inverse logit of * the specified argument. * * @tparam T scalar type of forward-mode autodiff variable * argument. * @param x argument * @return log of one minus the inverse logit of the argument */ template inline fvar log1m_inv_logit(const fvar& x) { using std::exp; return fvar(log1m_inv_logit(x.val_), -x.d_ / (1 + exp(-x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_inv_logit_diff.hpp0000644000176200001440000000344513766554456025632 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_INV_LOGIT_DIFF_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_INV_LOGIT_DIFF_HPP #include #include #include #include #include #include namespace stan { namespace math { /** * Returns fvar with the natural logarithm of the difference of the * inverse logits of the specified arguments and its gradients. * \f[ \mathrm{log\_inv\_logit\_diff}(x,y) = \ln\left(\frac{1}{1+\exp(-x)}-\frac{1}{1+\exp(-y)}\right) \f] \f[ \frac{\partial }{\partial x} = -\frac{e^x}{e^y-e^x}-\frac{e^x}{e^x+1} \f] \f[ \frac{\partial }{\partial x} = -\frac{e^y}{e^x-e^y}-\frac{e^y}{e^y+1} \f] * * @tparam T1 Type of x argument. * @tparam T2 Type of y argument. * @param x Argument. * @param y Argument. * @return Fvar with result of log difference of inverse logits of arguments * and gradients. */ template inline fvar log_inv_logit_diff(const fvar& x, const fvar& y) { return fvar( log_inv_logit_diff(x.val_, y.val_), -x.d_ * (inv(expm1(y.val_ - x.val_)) + inv_logit(x.val_)) - y.d_ * (inv(expm1(x.val_ - y.val_)) + inv_logit(y.val_))); } template inline fvar log_inv_logit_diff(const fvar& x, double y) { return fvar(log_inv_logit_diff(x.val_, y), -x.d_ * (inv(expm1(y - x.val_)) + inv_logit(x.val_))); } template inline fvar log_inv_logit_diff(double x, const fvar& y) { return fvar(log_inv_logit_diff(x, y.val_), -y.d_ * (inv(expm1(x - y.val_)) + inv_logit(y.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/tgamma.hpp0000644000176200001440000000125413766554456023251 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_TGAMMA_HPP #define STAN_MATH_FWD_SCAL_FUN_TGAMMA_HPP #include #include #include #include namespace stan { namespace math { /** * Return the result of applying the gamma function to the * specified argument. * * @tparam T Scalar type of autodiff variable. * @param x Argument. * @return Gamma function applied to argument. */ template inline fvar tgamma(const fvar& x) { T u = tgamma(x.val_); return fvar(u, x.d_ * u * digamma(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/owens_t.hpp0000644000176200001440000000424413766554456023463 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_OWENS_T_HPP #define STAN_MATH_FWD_SCAL_FUN_OWENS_T_HPP #include #include #include #include #include #include #include namespace stan { namespace math { /** * Return Owen's T function applied to the specified * arguments. * * @param x1 First argument. * @param x2 Second argument. * @return Owen's T function applied to the specified arguments. */ template inline fvar owens_t(const fvar& x1, const fvar& x2) { using std::exp; T neg_x1_sq_div_2 = -square(x1.val_) * 0.5; T one_p_x2_sq = 1.0 + square(x2.val_); return fvar(owens_t(x1.val_, x2.val_), -x1.d_ * (erf(x2.val_ * x1.val_ * INV_SQRT_2) * exp(neg_x1_sq_div_2) * INV_SQRT_TWO_PI * 0.5) + x2.d_ * exp(neg_x1_sq_div_2 * one_p_x2_sq) / (one_p_x2_sq * 2.0 * pi())); } /** * Return Owen's T function applied to the specified arguments. * * @param x1 First argument. * @param x2 Second argument. * @return Owen's T function applied to the specified arguments. */ template inline fvar owens_t(double x1, const fvar& x2) { using std::exp; T neg_x1_sq_div_2 = -square(x1) * 0.5; T one_p_x2_sq = 1.0 + square(x2.val_); return fvar( owens_t(x1, x2.val_), x2.d_ * exp(neg_x1_sq_div_2 * one_p_x2_sq) / (one_p_x2_sq * 2.0 * pi())); } /** * Return Owen's T function applied to the specified arguments. * * @param x1 First argument. * @param x2 Second argument. * @return Owen's T function applied to the specified arguments. */ template inline fvar owens_t(const fvar& x1, double x2) { using std::exp; T neg_x1_sq_div_2 = -square(x1.val_) * 0.5; return fvar(owens_t(x1.val_, x2), -x1.d_ * (erf(x2 * x1.val_ * INV_SQRT_2) * exp(neg_x1_sq_div_2) * INV_SQRT_TWO_PI * 0.5)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/sqrt.hpp0000644000176200001440000000065513766554456023000 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_SQRT_HPP #define STAN_MATH_FWD_SCAL_FUN_SQRT_HPP #include #include #include namespace stan { namespace math { template inline fvar sqrt(const fvar& x) { using std::sqrt; return fvar(sqrt(x.val_), 0.5 * x.d_ * inv_sqrt(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/fmod.hpp0000644000176200001440000000204113766554456022723 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FMOD_HPP #define STAN_MATH_FWD_SCAL_FUN_FMOD_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar fmod(const fvar& x1, const fvar& x2) { using std::floor; using std::fmod; return fvar(fmod(x1.val_, x2.val_), x1.d_ - x2.d_ * floor(x1.val_ / x2.val_)); } template inline fvar fmod(const fvar& x1, double x2) { using std::fmod; if (unlikely(is_any_nan(value_of(x1.val_), x2))) { return fvar(fmod(x1.val_, x2), NOT_A_NUMBER); } else { return fvar(fmod(x1.val_, x2), x1.d_ / x2); } } template inline fvar fmod(double x1, const fvar& x2) { using std::floor; using std::fmod; return fvar(fmod(x1, x2.val_), -x2.d_ * floor(x1 / x2.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/Phi_approx.hpp0000644000176200001440000000134013766554456024110 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_PHI_APPROX_HPP #define STAN_MATH_FWD_SCAL_FUN_PHI_APPROX_HPP #include #include #include #include namespace stan { namespace math { /** * Return an approximation of the unit normal cumulative * distribution function (CDF). * * @tparam T scalar type of forward-mode autodiff variable * argument. * @param x argument * @return approximate probability random sample is less than or * equal to argument */ template inline fvar Phi_approx(const fvar& x) { using std::pow; return inv_logit(0.07056 * pow(x, 3.0) + 1.5976 * x); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/cos.hpp0000644000176200001440000000062113766554456022564 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_COS_HPP #define STAN_MATH_FWD_SCAL_FUN_COS_HPP #include #include #include namespace stan { namespace math { template inline fvar cos(const fvar& x) { using std::cos; using std::sin; return fvar(cos(x.val_), x.d_ * -sin(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/floor.hpp0000644000176200001440000000056713766554456023132 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FLOOR_HPP #define STAN_MATH_FWD_SCAL_FUN_FLOOR_HPP #include #include #include namespace stan { namespace math { template inline fvar floor(const fvar& x) { using std::floor; return fvar(floor(x.val_), 0); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/round.hpp0000644000176200001440000000152013766554456023126 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ROUND_HPP #define STAN_MATH_FWD_SCAL_FUN_ROUND_HPP #include #include #include #include #include namespace stan { namespace math { /** * Return the closest integer to the specified argument, with * halfway cases rounded away from zero. * * The derivative is always zero. * * @tparam T Scalar type for autodiff variable. * @param x Argument. * @return The rounded value of the argument. */ template inline fvar round(const fvar& x) { return fvar(round(x.val_), is_nan(x.val_) ? std::numeric_limits::quiet_NaN() : 0.0); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/erf.hpp0000644000176200001440000000104413766554456022554 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ERF_HPP #define STAN_MATH_FWD_SCAL_FUN_ERF_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar erf(const fvar& x) { using std::exp; return fvar(erf(x.val_), x.d_ * exp(-square(x.val_)) * TWO_OVER_SQRT_PI); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/fmin.hpp0000644000176200001440000000356313766554456022741 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FMIN_HPP #define STAN_MATH_FWD_SCAL_FUN_FMIN_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar fmin(const fvar& x1, const fvar& x2) { if (unlikely(is_nan(x1.val_))) { if (is_nan(x2.val_)) { return fvar(fmin(x1.val_, x2.val_), NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } else if (unlikely(is_nan(x2.val_))) { return fvar(x1.val_, x1.d_); } else if (x1.val_ < x2.val_) { return fvar(x1.val_, x1.d_); } else if (x1.val_ == x2.val_) { return fvar(x1.val_, NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } template inline fvar fmin(double x1, const fvar& x2) { if (unlikely(is_nan(x1))) { if (is_nan(x2.val_)) { return fvar(fmin(x1, x2.val_), NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } else if (unlikely(is_nan(x2.val_))) { return fvar(x1, 0.0); } else if (x1 < x2.val_) { return fvar(x1, 0.0); } else if (x1 == x2.val_) { return fvar(x2.val_, NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } template inline fvar fmin(const fvar& x1, double x2) { if (unlikely(is_nan(x1.val_))) { if (is_nan(x2)) { return fvar(fmin(x1.val_, x2), NOT_A_NUMBER); } else { return fvar(x2, 0.0); } } else if (unlikely(is_nan(x2))) { return fvar(x1.val_, x1.d_); } else if (x1.val_ < x2) { return fvar(x1.val_, x1.d_); } else if (x1.val_ == x2) { return fvar(x1.val_, NOT_A_NUMBER); } else { return fvar(x2, 0.0); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/acos.hpp0000644000176200001440000000072113766554456022726 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ACOS_HPP #define STAN_MATH_FWD_SCAL_FUN_ACOS_HPP #include #include #include #include namespace stan { namespace math { template inline fvar acos(const fvar& x) { using std::acos; using std::sqrt; return fvar(acos(x.val_), x.d_ / -sqrt(1 - square(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_diff_exp.hpp0000644000176200001440000000313013766554456024423 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_DIFF_EXP_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_DIFF_EXP_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar log_diff_exp(const fvar& x1, const fvar& x2) { if (x1.val_ <= x2.val_) { if (x1.val_ < INFTY && x1.val_ == x2.val_) { return fvar(NEGATIVE_INFTY, NOT_A_NUMBER); } return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } return fvar( log_diff_exp(x1.val_, x2.val_), -(x1.d_ / expm1(x2.val_ - x1.val_) + x2.d_ / expm1(x1.val_ - x2.val_))); } template inline fvar log_diff_exp(const T1& x1, const fvar& x2) { if (x1 <= x2.val_) { if (x1 < INFTY && x1 == x2.val_) { return fvar(NEGATIVE_INFTY, x2.d_ * NEGATIVE_INFTY); } return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } return fvar(log_diff_exp(x1, x2.val_), -x2.d_ / expm1(x1 - x2.val_)); } template inline fvar log_diff_exp(const fvar& x1, const T2& x2) { if (x1.val_ <= x2) { if (x1.val_ < INFTY && x1.val_ == x2) { if (x2 == NEGATIVE_INFTY) { return fvar(NEGATIVE_INFTY, x1.d_); } return fvar(NEGATIVE_INFTY, x1.d_ * INFTY); } return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } return fvar(log_diff_exp(x1.val_, x2), -x1.d_ / expm1(x2 - x1.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/bessel_first_kind.hpp0000644000176200001440000000115013766554456025467 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_BESSEL_FIRST_KIND_HPP #define STAN_MATH_FWD_SCAL_FUN_BESSEL_FIRST_KIND_HPP #include #include #include namespace stan { namespace math { template inline fvar bessel_first_kind(int v, const fvar& z) { T bessel_first_kind_z(bessel_first_kind(v, z.val_)); return fvar(bessel_first_kind_z, v * z.d_ * bessel_first_kind_z / z.val_ - z.d_ * bessel_first_kind(v + 1, z.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inv_Phi.hpp0000644000176200001440000000107113766554456023374 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INV_PHI_HPP #define STAN_MATH_FWD_SCAL_FUN_INV_PHI_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar inv_Phi(const fvar& p) { using std::exp; T xv = inv_Phi(p.val_); return fvar(xv, p.d_ / exp(-0.5 * square(xv)) * SQRT_2_TIMES_SQRT_PI); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inv_sqrt.hpp0000644000176200001440000000064213766554456023650 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INV_SQRT_HPP #define STAN_MATH_FWD_SCAL_FUN_INV_SQRT_HPP #include #include namespace stan { namespace math { template inline fvar inv_sqrt(const fvar& x) { using std::sqrt; T sqrt_x(sqrt(x.val_)); return fvar(1 / sqrt_x, -0.5 * x.d_ / (x.val_ * sqrt_x)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/asinh.hpp0000644000176200001440000000075713766554456023114 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ASINH_HPP #define STAN_MATH_FWD_SCAL_FUN_ASINH_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar asinh(const fvar& x) { using std::sqrt; return fvar(asinh(x.val_), x.d_ / sqrt(square(x.val_) + 1)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/atanh.hpp0000644000176200001440000000131413766554456023073 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ATANH_HPP #define STAN_MATH_FWD_SCAL_FUN_ATANH_HPP #include #include #include #include namespace stan { namespace math { /** * Return inverse hyperbolic tangent of specified value. * * @tparam T scalar type of forward-mode autodiff variable * argument. * @param x Argument. * @return Inverse hyperbolic tangent of argument. * @throw std::domain_error if x < -1 or x > 1. */ template inline fvar atanh(const fvar& x) { return fvar(atanh(x.val_), x.d_ / (1 - square(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/sin.hpp0000644000176200001440000000057613766554456022602 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_SIN_HPP #define STAN_MATH_FWD_SCAL_FUN_SIN_HPP #include #include namespace stan { namespace math { template inline fvar sin(const fvar& x) { using std::cos; using std::sin; return fvar(sin(x.val_), x.d_ * cos(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/modified_bessel_second_kind.hpp0000644000176200001440000000130313766554456027453 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_MODIFIED_BESSEL_SECOND_KIND_HPP #define STAN_MATH_FWD_SCAL_FUN_MODIFIED_BESSEL_SECOND_KIND_HPP #include #include #include namespace stan { namespace math { template inline fvar modified_bessel_second_kind(int v, const fvar& z) { T modified_bessel_second_kind_z(modified_bessel_second_kind(v, z.val_)); return fvar(modified_bessel_second_kind_z, -v * z.d_ * modified_bessel_second_kind_z / z.val_ - z.d_ * modified_bessel_second_kind(v - 1, z.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/primitive_value.hpp0000644000176200001440000000133513766554456025207 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_PRIMITIVE_VALUE_HPP #define STAN_MATH_FWD_SCAL_FUN_PRIMITIVE_VALUE_HPP #include #include #include namespace stan { namespace math { /** * Return the primitive value of the specified forward-mode * autodiff variable. This function applies recursively to * higher-order autodiff types to return a primitive double value. * * @tparam T scalar type for autodiff variable. * @param v input variable. * @return primitive value of input. */ template inline double primitive_value(const fvar& v) { return primitive_value(v.val_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/lbeta.hpp0000644000176200001440000000206013766554456023066 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LBETA_HPP #define STAN_MATH_FWD_SCAL_FUN_LBETA_HPP #include #include #include #include namespace stan { namespace math { template inline fvar lbeta(const fvar& x1, const fvar& x2) { using boost::math::digamma; return fvar(lbeta(x1.val_, x2.val_), x1.d_ * digamma(x1.val_) + x2.d_ * digamma(x2.val_) - (x1.d_ + x2.d_) * digamma(x1.val_ + x2.val_)); } template inline fvar lbeta(double x1, const fvar& x2) { using boost::math::digamma; return fvar(lbeta(x1, x2.val_), x2.d_ * digamma(x2.val_) - x2.d_ * digamma(x1 + x2.val_)); } template inline fvar lbeta(const fvar& x1, double x2) { using boost::math::digamma; return fvar(lbeta(x1.val_, x2), x1.d_ * digamma(x1.val_) - x1.d_ * digamma(x1.val_ + x2)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/fmax.hpp0000644000176200001440000000514313766554456022737 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FMAX_HPP #define STAN_MATH_FWD_SCAL_FUN_FMAX_HPP #include #include #include #include #include namespace stan { namespace math { /** * Return the greater of the two specified arguments. If one is * greater than the other, return not-a-number. * * @param x1 First argument. * @param x2 Second argument. * @return maximum of arguments, and if one is NaN return the other */ template inline fvar fmax(const fvar& x1, const fvar& x2) { if (unlikely(is_nan(x1.val_))) { if (is_nan(x2.val_)) { return fvar(fmax(x1.val_, x2.val_), NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } else if (unlikely(is_nan(x2.val_))) { return fvar(x1.val_, x1.d_); } else if (x1.val_ > x2.val_) { return fvar(x1.val_, x1.d_); } else if (x1.val_ == x2.val_) { return fvar(x1.val_, NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } /** * Return the greater of the two specified arguments. If one is * greater than the other, return not-a-number. * * @param x1 First argument. * @param x2 Second argument. * @return maximum of arguments, and if one is NaN return the other */ template inline fvar fmax(double x1, const fvar& x2) { if (unlikely(is_nan(x1))) { if (is_nan(x2.val_)) { return fvar(fmax(x1, x2.val_), NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } else if (unlikely(is_nan(x2.val_))) { return fvar(x1, 0.0); } else if (x1 > x2.val_) { return fvar(x1, 0.0); } else if (x1 == x2.val_) { return fvar(x2.val_, NOT_A_NUMBER); } else { return fvar(x2.val_, x2.d_); } } /** * Return the greater of the two specified arguments. If one is * greater than the other, return not-a-number. * * @param x1 First argument. * @param x2 Second argument. * @return maximum of arguments, and if one is NaN return the other */ template inline fvar fmax(const fvar& x1, double x2) { if (unlikely(is_nan(x1.val_))) { if (is_nan(x2)) { return fvar(fmax(x1.val_, x2), NOT_A_NUMBER); } else { return fvar(x2, 0.0); } } else if (unlikely(is_nan(x2))) { return fvar(x1.val_, x1.d_); } else if (x1.val_ > x2) { return fvar(x1.val_, x1.d_); } else if (x1.val_ == x2) { return fvar(x1.val_, NOT_A_NUMBER); } else { return fvar(x2, 0.0); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/abs.hpp0000644000176200001440000000121713766554456022547 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ABS_HPP #define STAN_MATH_FWD_SCAL_FUN_ABS_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar abs(const fvar& x) { if (x.val_ > 0.0) { return x; } else if (x.val_ < 0.0) { return fvar(-x.val_, -x.d_); } else if (x.val_ == 0.0) { return fvar(0, 0); } else { return fvar(abs(x.val_), NOT_A_NUMBER); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/hypot.hpp0000644000176200001440000000443313766554456023150 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_HYPOT_HPP #define STAN_MATH_FWD_SCAL_FUN_HYPOT_HPP #include #include #include #include namespace stan { namespace math { /** * Return the length of the hypoteneuse of a right triangle with * opposite and adjacent side lengths given by the specified * arguments (C++11). In symbols, if the arguments are * 1 and x2, the result is sqrt(x1 * * x1 + x2 * x2). * * @tparam T Scalar type of autodiff variables. * @param x1 First argument. * @param x2 Second argument. * @return Length of hypoteneuse of right triangle with opposite * and adjacent side lengths x1 and x2. */ template inline fvar hypot(const fvar& x1, const fvar& x2) { using std::sqrt; T u = hypot(x1.val_, x2.val_); return fvar(u, (x1.d_ * x1.val_ + x2.d_ * x2.val_) / u); } /** * Return the length of the hypoteneuse of a right triangle with * opposite and adjacent side lengths given by the specified * arguments (C++11). In symbols, if the arguments are * 1 and x2, the result is sqrt(x1 * * x1 + x2 * x2). * * @tparam T Scalar type of autodiff variable. * @param x1 First argument. * @param x2 Second argument. * @return Length of hypoteneuse of right triangle with opposite * and adjacent side lengths x1 and x2. */ template inline fvar hypot(const fvar& x1, double x2) { using std::sqrt; T u = hypot(x1.val_, x2); return fvar(u, (x1.d_ * x1.val_) / u); } /** * Return the length of the hypoteneuse of a right triangle with * opposite and adjacent side lengths given by the specified * arguments (C++11). In symbols, if the arguments are * 1 and x2, the result is sqrt(x1 * * x1 + x2 * x2). * * @tparam T Scalar type of autodiff variable. * @param x1 First argument. * @param x2 Second argument. * @return Length of hypoteneuse of right triangle with opposite * and adjacent side lengths x1 and x2. */ template inline fvar hypot(double x1, const fvar& x2) { using std::sqrt; T u = hypot(x1, x2.val_); return fvar(u, (x2.d_ * x2.val_) / u); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log.hpp0000644000176200001440000000075713766554456022573 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_HPP #include #include #include namespace stan { namespace math { template inline fvar log(const fvar& x) { using std::log; if (x.val_ < 0.0) { return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } else { return fvar(log(x.val_), x.d_ / x.val_); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/multiply_log.hpp0000644000176200001440000000154013766554456024521 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_MULTIPLY_LOG_HPP #define STAN_MATH_FWD_SCAL_FUN_MULTIPLY_LOG_HPP #include #include #include namespace stan { namespace math { template inline fvar multiply_log(const fvar& x1, const fvar& x2) { using std::log; return fvar(multiply_log(x1.val_, x2.val_), x1.d_ * log(x2.val_) + x1.val_ * x2.d_ / x2.val_); } template inline fvar multiply_log(double x1, const fvar& x2) { using std::log; return fvar(multiply_log(x1, x2.val_), x1 * x2.d_ / x2.val_); } template inline fvar multiply_log(const fvar& x1, double x2) { using std::log; return fvar(multiply_log(x1.val_, x2), x1.d_ * log(x2)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/gamma_q.hpp0000644000176200001440000000352313766554456023406 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_GAMMA_Q_HPP #define STAN_MATH_FWD_SCAL_FUN_GAMMA_Q_HPP #include #include #include #include namespace stan { namespace math { template inline fvar gamma_q(const fvar& x1, const fvar& x2) { using boost::math::digamma; using std::exp; using std::fabs; using std::log; using std::pow; T u = gamma_q(x1.val_, x2.val_); T S = 0; T s = 1; T l = log(x2.val_); T g = tgamma(x1.val_); T dig = digamma(x1.val_); int k = 0; T delta = s / (x1.val_ * x1.val_); while (fabs(delta) > 1e-6) { S += delta; ++k; s *= -x2.val_ / k; delta = s / ((k + x1.val_) * (k + x1.val_)); } T der1 = (1.0 - u) * (dig - l) + exp(x1.val_ * l) * S / g; T der2 = -exp(-x2.val_) * pow(x2.val_, x1.val_ - 1.0) / g; return fvar(u, x1.d_ * der1 + x2.d_ * der2); } template inline fvar gamma_q(const fvar& x1, double x2) { using boost::math::digamma; using std::exp; using std::fabs; using std::log; using std::pow; T u = gamma_q(x1.val_, x2); T S = 0; double s = 1; double l = log(x2); T g = tgamma(x1.val_); T dig = digamma(x1.val_); int k = 0; T delta = s / (x1.val_ * x1.val_); while (fabs(delta) > 1e-6) { S += delta; ++k; s *= -x2 / k; delta = s / ((k + x1.val_) * (k + x1.val_)); } T der1 = (1.0 - u) * (dig - l) + exp(x1.val_ * l) * S / g; return fvar(u, x1.d_ * der1); } template inline fvar gamma_q(double x1, const fvar& x2) { using std::exp; using std::pow; T u = gamma_q(x1, x2.val_); double g = tgamma(x1); T der2 = -exp(-x2.val_) * pow(x2.val_, x1 - 1.0) / g; return fvar(u, x2.d_ * der2); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inv_cloglog.hpp0000644000176200001440000000071513766554456024306 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INV_CLOGLOG_HPP #define STAN_MATH_FWD_SCAL_FUN_INV_CLOGLOG_HPP #include #include #include namespace stan { namespace math { template inline fvar inv_cloglog(const fvar& x) { using std::exp; return fvar(inv_cloglog(x.val_), x.d_ * exp(x.val_ - exp(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/rising_factorial.hpp0000644000176200001440000000167713766554456025333 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_RISING_FACTORIAL_HPP #define STAN_MATH_FWD_SCAL_FUN_RISING_FACTORIAL_HPP #include #include #include #include namespace stan { namespace math { /** * Return autodiff variable with the gradient and * result of the rising factorial function applied * to the inputs. * Will throw for NaN x and for negative n, as * implemented in primitive function. * * @tparam T Scalar type of autodiff variable. * @param x Argument. * @param n Argument * @return tangent of rising factorial at arguments. */ template inline fvar rising_factorial(const fvar& x, int n) { T rising_fact(rising_factorial(x.val_, n)); return fvar(rising_fact, rising_fact * x.d_ * (digamma(x.val_ + n) - digamma(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/grad_inc_beta.hpp0000644000176200001440000000257613766554456024554 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_GRAD_INC_BETA_HPP #define STAN_MATH_FWD_SCAL_FUN_GRAD_INC_BETA_HPP #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Gradient of the incomplete beta function beta(a, b, z) with * respect to the first two arguments. * * Uses the equivalence to a hypergeometric function. See * http://dlmf.nist.gov/8.17#ii * * @tparam T type of fvar * @param[out] g1 d/da * @param[out] g2 d/db * @param[in] a a * @param[in] b b * @param[in] z z */ template void grad_inc_beta(fvar& g1, fvar& g2, fvar a, fvar b, fvar z) { fvar c1 = log(z); fvar c2 = log1m(z); fvar c3 = beta(a, b) * inc_beta(a, b, z); fvar C = exp(a * c1 + b * c2) / a; fvar dF1 = 0; fvar dF2 = 0; if (value_of(value_of(C))) { grad_2F1(dF1, dF2, a + b, fvar(1.0), a + 1, z); } g1 = (c1 - 1.0 / a) * c3 + C * (dF1 + dF2); g2 = c2 * c3 + C * dF1; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/lmgamma.hpp0000644000176200001440000000134713766554456023421 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LMGAMMA_HPP #define STAN_MATH_FWD_SCAL_FUN_LMGAMMA_HPP #include #include #include #include namespace stan { namespace math { template inline fvar::type> lmgamma( int x1, const fvar& x2) { using std::log; T deriv = 0; for (int count = 1; count < x1 + 1; count++) { deriv += x2.d_ * digamma(x2.val_ + (1.0 - count) / 2.0); } return fvar::type>(lmgamma(x1, x2.val_), deriv); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/asin.hpp0000644000176200001440000000072113766554456022733 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ASIN_HPP #define STAN_MATH_FWD_SCAL_FUN_ASIN_HPP #include #include #include #include namespace stan { namespace math { template inline fvar asin(const fvar& x) { using std::asin; using std::sqrt; return fvar(asin(x.val_), x.d_ / sqrt(1 - square(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/acosh.hpp0000644000176200001440000000070213766554456023075 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ACOSH_HPP #define STAN_MATH_FWD_SCAL_FUN_ACOSH_HPP #include #include #include #include namespace stan { namespace math { template inline fvar acosh(const fvar& x) { using std::sqrt; return fvar(acosh(x.val_), x.d_ / sqrt(square(x.val_) - 1)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/binomial_coefficient_log.hpp0000644000176200001440000000611513766554456026775 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_BINOMIAL_COEFFICIENT_LOG_HPP #define STAN_MATH_FWD_SCAL_FUN_BINOMIAL_COEFFICIENT_LOG_HPP #include #include #include #include namespace stan { namespace math { template inline fvar binomial_coefficient_log(const fvar& x1, const fvar& x2) { using boost::math::digamma; using std::log; const double cutoff = 1000; if ((x1.val_ < cutoff) || (x1.val_ - x2.val_ < cutoff)) { return fvar(binomial_coefficient_log(x1.val_, x2.val_), x1.d_ * digamma(x1.val_ + 1) - x2.d_ * digamma(x2.val_ + 1) - (x1.d_ - x2.d_) * digamma(x1.val_ - x2.val_ + 1)); } else { return fvar( binomial_coefficient_log(x1.val_, x2.val_), x2.d_ * log(x1.val_ - x2.val_) + x2.val_ * (x1.d_ - x2.d_) / (x1.val_ - x2.val_) + x1.d_ * log(x1.val_ / (x1.val_ - x2.val_)) + (x1.val_ + 0.5) / (x1.val_ / (x1.val_ - x2.val_)) * (x1.d_ * (x1.val_ - x2.val_) - (x1.d_ - x2.d_) * x1.val_) / ((x1.val_ - x2.val_) * (x1.val_ - x2.val_)) - x1.d_ / (12.0 * x1.val_ * x1.val_) - x2.d_ + (x1.d_ - x2.d_) / (12.0 * (x1.val_ - x2.val_) * (x1.val_ - x2.val_)) - digamma(x2.val_ + 1) * x2.d_); } } template inline fvar binomial_coefficient_log(const fvar& x1, double x2) { using boost::math::digamma; using std::log; const double cutoff = 1000; if ((x1.val_ < cutoff) || (x1.val_ - x2 < cutoff)) { return fvar( binomial_coefficient_log(x1.val_, x2), x1.d_ * digamma(x1.val_ + 1) - x1.d_ * digamma(x1.val_ - x2 + 1)); } else { return fvar(binomial_coefficient_log(x1.val_, x2), x2 * x1.d_ / (x1.val_ - x2) + x1.d_ * log(x1.val_ / (x1.val_ - x2)) + (x1.val_ + 0.5) / (x1.val_ / (x1.val_ - x2)) * (x1.d_ * (x1.val_ - x2) - x1.d_ * x1.val_) / ((x1.val_ - x2) * (x1.val_ - x2)) - x1.d_ / (12.0 * x1.val_ * x1.val_) + x1.d_ / (12.0 * (x1.val_ - x2) * (x1.val_ - x2))); } } template inline fvar binomial_coefficient_log(double x1, const fvar& x2) { using boost::math::digamma; using std::log; const double cutoff = 1000; if ((x1 < cutoff) || (x1 - x2.val_ < cutoff)) { return fvar( binomial_coefficient_log(x1, x2.val_), -x2.d_ * digamma(x2.val_ + 1) - x2.d_ * digamma(x1 - x2.val_ + 1)); } else { return fvar(binomial_coefficient_log(x1, x2.val_), x2.d_ * log(x1 - x2.val_) + x2.val_ * -x2.d_ / (x1 - x2.val_) - x2.d_ - x2.d_ / (12.0 * (x1 - x2.val_) * (x1 - x2.val_)) + x2.d_ * (x1 + 0.5) / (x1 - x2.val_) - digamma(x2.val_ + 1) * x2.d_); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/sinh.hpp0000644000176200001440000000060513766554456022743 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_SINH_HPP #define STAN_MATH_FWD_SCAL_FUN_SINH_HPP #include #include namespace stan { namespace math { template inline fvar sinh(const fvar& x) { using std::cosh; using std::sinh; return fvar(sinh(x.val_), x.d_ * cosh(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/fabs.hpp0000644000176200001440000000132013766554456022710 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FABS_HPP #define STAN_MATH_FWD_SCAL_FUN_FABS_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar fabs(const fvar& x) { using std::fabs; if (unlikely(is_nan(value_of(x.val_)))) { return fvar(fabs(x.val_), NOT_A_NUMBER); } else if (x.val_ > 0.0) { return x; } else if (x.val_ < 0.0) { return fvar(-x.val_, -x.d_); } else { return fvar(0, 0); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/logit.hpp0000644000176200001440000000113713766554456023121 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOGIT_HPP #define STAN_MATH_FWD_SCAL_FUN_LOGIT_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar logit(const fvar& x) { if (x.val_ > 1 || x.val_ < 0) { return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } else { return fvar(logit(x.val_), x.d_ / (x.val_ - square(x.val_))); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/beta.hpp0000644000176200001440000000446513766554456022725 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_BETA_HPP #define STAN_MATH_FWD_SCAL_FUN_BETA_HPP #include #include #include #include namespace stan { namespace math { /** * Return fvar with the beta function applied to the specified * arguments and its gradient. * * The beta function is defined for \f$a > 0\f$ and \f$b > 0\f$ by * * \f$\mbox{B}(a, b) = \frac{\Gamma(a) \Gamma(b)}{\Gamma(a+b)}\f$. * \f[ \mbox{beta}(\alpha, \beta) = \begin{cases} \int_0^1 u^{\alpha - 1} (1 - u)^{\beta - 1} \, du & \mbox{if } \alpha, \beta>0 \\[6pt] \textrm{NaN} & \mbox{if } \alpha = \textrm{NaN or } \beta = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{beta}(\alpha, \beta)}{\partial \alpha} = \begin{cases} \left(\psi(\alpha)-\psi(\alpha+\beta)\right)*\mbox{beta}(\alpha, \beta) & \mbox{if } \alpha, \beta>0 \\[6pt] \textrm{NaN} & \mbox{if } \alpha = \textrm{NaN or } \beta = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{beta}(\alpha, \beta)}{\partial \beta} = \begin{cases} \left(\psi(\beta)-\psi(\alpha+\beta)\right)*\mbox{beta}(\alpha, \beta) & \mbox{if } \alpha, \beta>0 \\[6pt] \textrm{NaN} & \mbox{if } \alpha = \textrm{NaN or } \beta = \textrm{NaN} \end{cases} \f] * * @tparam T Type of values. * @param x1 First value * @param x2 Second value * @return Fvar with result beta function of arguments and gradients. */ template inline fvar beta(const fvar& x1, const fvar& x2) { const T beta_ab = beta(x1.val_, x2.val_); return fvar(beta_ab, beta_ab * (x1.d_ * digamma(x1.val_) + x2.d_ * digamma(x2.val_) - (x1.d_ + x2.d_) * digamma(x1.val_ + x2.val_))); } template inline fvar beta(double x1, const fvar& x2) { const T beta_ab = beta(x1, x2.val_); return fvar(beta_ab, x2.d_ * (digamma(x2.val_) - digamma(x1 + x2.val_)) * beta_ab); } template inline fvar beta(const fvar& x1, double x2) { const T beta_ab = beta(x1.val_, x2); return fvar(beta_ab, x1.d_ * (digamma(x1.val_) - digamma(x1.val_ + x2)) * beta_ab); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log1m_exp.hpp0000644000176200001440000000153313766554456023676 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG1M_EXP_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG1M_EXP_HPP #include #include #include #include #include #include namespace stan { namespace math { /** * Return the natural logarithm of one minus the * exponentiation of the specified argument. * * @tparam T Scalar type of autodiff variable. * @param x Argument. * @return log of one minus the exponentiation of the argument. */ template inline fvar log1m_exp(const fvar& x) { if (x.val_ >= 0) { return fvar(NOT_A_NUMBER); } return fvar(log1m_exp(x.val_), x.d_ / -expm1(-x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/binary_log_loss.hpp0000644000176200001440000000113113766554456025162 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_BINARY_LOG_LOSS_HPP #define STAN_MATH_FWD_SCAL_FUN_BINARY_LOG_LOSS_HPP #include #include #include namespace stan { namespace math { template inline fvar binary_log_loss(int y, const fvar& y_hat) { if (y) { return fvar(binary_log_loss(y, y_hat.val_), -y_hat.d_ / y_hat.val_); } else { return fvar(binary_log_loss(y, y_hat.val_), y_hat.d_ / (1.0 - y_hat.val_)); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/lgamma.hpp0000644000176200001440000000126413766554456023242 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LGAMMA_HPP #define STAN_MATH_FWD_SCAL_FUN_LGAMMA_HPP #include #include #include #include namespace stan { namespace math { /** * Return the natural logarithm of the gamma function applied to * the specified argument. * * @tparam T Scalar type of autodiff variable. * @param x Argument. * @return natural logarithm of the gamma function of argument. */ template inline fvar lgamma(const fvar& x) { return fvar(lgamma(x.val_), x.d_ * digamma(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inv_logit.hpp0000644000176200001440000000130413766554456023771 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INV_LOGIT_HPP #define STAN_MATH_FWD_SCAL_FUN_INV_LOGIT_HPP #include #include #include namespace stan { namespace math { /** * Returns the inverse logit function applied to the argument. * * @tparam T scalar type of forward-mode autodiff variable * argument. * @param x argument * @return inverse logit of argument */ template inline fvar inv_logit(const fvar& x) { using std::exp; using std::pow; return fvar(inv_logit(x.val_), x.d_ * inv_logit(x.val_) * (1 - inv_logit(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/tanh.hpp0000644000176200001440000000057413766554456022741 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_TANH_HPP #define STAN_MATH_FWD_SCAL_FUN_TANH_HPP #include #include namespace stan { namespace math { template inline fvar tanh(const fvar& x) { using std::tanh; T u = tanh(x.val_); return fvar(u, x.d_ * (1 - u * u)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inv_square.hpp0000644000176200001440000000071113766554456024154 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INV_SQUARE_HPP #define STAN_MATH_FWD_SCAL_FUN_INV_SQUARE_HPP #include #include #include namespace stan { namespace math { template inline fvar inv_square(const fvar& x) { T square_x(square(x.val_)); return fvar(1 / square_x, -2 * x.d_ / (square_x * x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log1m.hpp0000644000176200001440000000062113766554456023017 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG1M_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG1M_HPP #include #include #include namespace stan { namespace math { template inline fvar log1m(const fvar& x) { return fvar(log1m(x.val_), -x.d_ / (1 - x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/falling_factorial.hpp0000644000176200001440000000171613766554456025446 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FALLING_FACTORIAL_HPP #define STAN_MATH_FWD_SCAL_FUN_FALLING_FACTORIAL_HPP #include #include #include #include namespace stan { namespace math { /** * Return autodiff variable with the gradient and * result of the falling factorial function applied * to the inputs. * Will throw for NaN x and for negative n, as * implemented in primitive function. * * @tparam T Scalar type of autodiff variable. * @param x Argument. * @param n Argument * @return tangent of falling factorial at arguments. */ template inline fvar falling_factorial(const fvar& x, int n) { T falling_fact(falling_factorial(x.val_, n)); return fvar( falling_fact, falling_fact * (digamma(x.val_ + 1) - digamma(x.val_ - n + 1)) * x.d_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/square.hpp0000644000176200001440000000062313766554456023302 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_SQUARE_HPP #define STAN_MATH_FWD_SCAL_FUN_SQUARE_HPP #include #include #include namespace stan { namespace math { template inline fvar square(const fvar& x) { return fvar(square(x.val_), x.d_ * 2 * x.val_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/modified_bessel_first_kind.hpp0000644000176200001440000000127213766554456027334 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_MODIFIED_BESSEL_FIRST_KIND_HPP #define STAN_MATH_FWD_SCAL_FUN_MODIFIED_BESSEL_FIRST_KIND_HPP #include #include #include namespace stan { namespace math { template inline fvar modified_bessel_first_kind(int v, const fvar& z) { T modified_bessel_first_kind_z(modified_bessel_first_kind(v, z.val_)); return fvar(modified_bessel_first_kind_z, -v * z.d_ * modified_bessel_first_kind_z / z.val_ + z.d_ * modified_bessel_first_kind(v - 1, z.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/gamma_p.hpp0000644000176200001440000000322413766554456023403 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_GAMMA_P_HPP #define STAN_MATH_FWD_SCAL_FUN_GAMMA_P_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar gamma_p(const fvar &x1, const fvar &x2) { using std::exp; using std::log; T u = gamma_p(x1.val_, x2.val_); if (is_inf(x1.val_)) { return fvar(u, std::numeric_limits::quiet_NaN()); } if (is_inf(x2.val_)) { return fvar(u, std::numeric_limits::quiet_NaN()); } T der1 = grad_reg_lower_inc_gamma(x1.val_, x2.val_, 1.0e-10); T der2 = exp(-x2.val_ + (x1.val_ - 1.0) * log(x2.val_) - lgamma(x1.val_)); return fvar(u, x1.d_ * der1 + x2.d_ * der2); } template inline fvar gamma_p(const fvar &x1, double x2) { T u = gamma_p(x1.val_, x2); if (is_inf(x1.val_)) { return fvar(u, std::numeric_limits::quiet_NaN()); } if (is_inf(x2)) { return fvar(u, std::numeric_limits::quiet_NaN()); } T der1 = grad_reg_lower_inc_gamma(x1.val_, x2, 1.0e-10); return fvar(u, x1.d_ * der1); } template inline fvar gamma_p(double x1, const fvar &x2) { using std::exp; using std::log; T u = gamma_p(x1, x2.val_); if (is_inf(x1)) { return fvar(u, std::numeric_limits::quiet_NaN()); } T der2 = exp(-x2.val_ + (x1 - 1.0) * log(x2.val_) - lgamma(x1)); return fvar(u, x2.d_ * der2); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/to_fvar.hpp0000644000176200001440000000154713766554456023450 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_TO_FVAR_HPP #define STAN_MATH_FWD_SCAL_FUN_TO_FVAR_HPP #include #include namespace stan { namespace math { template inline fvar to_fvar(const T& x) { return fvar(x); } /** * Specialization of to_fvar for const fvars * * * @param[in,out] x A forward automatic differentation variables. * @return The input forward automatic differentiation variables. */ template inline const fvar& to_fvar(const fvar& x) { return x; } /** * Specialization of to_fvar for non-const fvars * * * @param[in,out] x A forward automatic differentation variables. * @return The input forward automatic differentiation variables. */ template inline fvar& to_fvar(fvar& x) { return x; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/exp2.hpp0000644000176200001440000000075013766554456022661 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_EXP2_HPP #define STAN_MATH_FWD_SCAL_FUN_EXP2_HPP #include #include #include #include #include namespace stan { namespace math { template inline fvar exp2(const fvar& x) { using std::log; return fvar(exp2(x.val_), x.d_ * exp2(x.val_) * LOG_2); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log2.hpp0000644000176200001440000000126713766554456022652 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG2_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG2_HPP #include #include #include #include namespace stan { namespace math { /** * Return the base two logarithm of the specified argument. * * @tparam T scalar type * @param x argument * @return base two logarithm of argument */ template inline fvar log2(const fvar& x) { if (x.val_ < 0.0) { return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } else { return fvar(log2(x.val_), x.d_ / (x.val_ * LOG_2)); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/fdim.hpp0000644000176200001440000000325013766554456022720 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FDIM_HPP #define STAN_MATH_FWD_SCAL_FUN_FDIM_HPP #include #include #include namespace stan { namespace math { /** * Return the positive difference of the specified values (C++11). * * @tparam T Scalar type of autodiff variables. * @param x First argument. * @param y Second argument. * @return Return the differences of the arguments if it is * positive and 0 otherwise. */ template inline fvar fdim(const fvar& x, const fvar& y) { if (x.val_ < y.val_) { return fvar(fdim(x.val_, y.val_), 0); } else { return fvar(fdim(x.val_, y.val_), x.d_ - y.d_); } } /** * Return the positive difference of the specified values (C++11). * * @tparam T Scalar type of autodiff variables. * @param x First argument. * @param y Second argument. * @return Return the differences of the arguments if it is * positive and 0 otherwise. */ template inline fvar fdim(const fvar& x, double y) { if (x.val_ < y) { return fvar(fdim(x.val_, y), 0); } else { return fvar(fdim(x.val_, y), x.d_); } } /** * Return the positive difference of the specified values (C++11). * * @tparam T Scalar type of autodiff variables. * @param x First argument. * @param y Second argument. * @return Return the differences of the arguments if it is * positive and 0 otherwise. */ template inline fvar fdim(double x, const fvar& y) { if (x < y.val_) { return fvar(fdim(x, y.val_), 0); } else { return fvar(fdim(x, y.val_), -y.d_); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inc_beta.hpp0000644000176200001440000000211613766554456023545 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INC_BETA_HPP #define STAN_MATH_FWD_SCAL_FUN_INC_BETA_HPP #include #include #include #include #include #include #include #include #include namespace stan { namespace math { template inline fvar inc_beta(const fvar& a, const fvar& b, const fvar& x) { using std::exp; using std::pow; T d_a; T d_b; T d_x; const T beta_ab = beta(a.val_, b.val_); grad_reg_inc_beta(d_a, d_b, a.val_, b.val_, x.val_, digamma(a.val_), digamma(b.val_), digamma(a.val_ + b.val_), beta_ab); d_x = pow((1 - x.val_), b.val_ - 1) * pow(x.val_, a.val_ - 1) / beta_ab; return fvar(inc_beta(a.val_, b.val_, x.val_), a.d_ * d_a + b.d_ * d_b + x.d_ * d_x); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/pow.hpp0000644000176200001440000000246213766554456022612 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_POW_HPP #define STAN_MATH_FWD_SCAL_FUN_POW_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar pow(const fvar& x1, const fvar& x2) { using std::log; using std::pow; T pow_x1_x2(pow(x1.val_, x2.val_)); return fvar(pow_x1_x2, (x2.d_ * log(x1.val_) + x2.val_ * x1.d_ / x1.val_) * pow_x1_x2); } template inline fvar pow(double x1, const fvar& x2) { using std::log; using std::pow; T u = pow(x1, x2.val_); return fvar(u, x2.d_ * log(x1) * u); } template inline fvar pow(const fvar& x1, double x2) { using std::pow; using std::sqrt; if (x2 == -2) { return inv_square(x1); } if (x2 == -1) { return inv(x1); } if (x2 == -0.5) { return inv_sqrt(x1); } if (x2 == 0.5) { return sqrt(x1); } if (x2 == 1.0) { return x1; } if (x2 == 2.0) { return square(x1); } return fvar(pow(x1.val_, x2), x1.d_ * x2 * pow(x1.val_, x2 - 1)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/cosh.hpp0000644000176200001440000000062713766554456022742 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_COSH_HPP #define STAN_MATH_FWD_SCAL_FUN_COSH_HPP #include #include #include namespace stan { namespace math { template inline fvar cosh(const fvar& x) { using std::cosh; using std::sinh; return fvar(cosh(x.val_), x.d_ * sinh(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/exp.hpp0000644000176200001440000000057513766554456022604 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_EXP_HPP #define STAN_MATH_FWD_SCAL_FUN_EXP_HPP #include #include #include namespace stan { namespace math { template inline fvar exp(const fvar& x) { using std::exp; return fvar(exp(x.val_), x.d_ * exp(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/value_of.hpp0000644000176200001440000000066013766554456023603 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_VALUE_OF_HPP #define STAN_MATH_FWD_SCAL_FUN_VALUE_OF_HPP #include #include namespace stan { namespace math { /** * Return the value of the specified variable. * * @param v Variable. * @return Value of variable. */ template inline T value_of(const fvar& v) { return v.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_falling_factorial.hpp0000644000176200001440000000223213766554456026301 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_FALLING_FACTORIAL_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_FALLING_FACTORIAL_HPP #include #include #include #include namespace stan { namespace math { template inline fvar log_falling_factorial(const fvar& x, const fvar& n) { using boost::math::digamma; return fvar(log_falling_factorial(x.val_, n.val_), (digamma(x.val_ + 1) - digamma(x.val_ - n.val_ + 1)) * x.d_ + digamma(x.val_ - n.val_ + 1) * n.d_); } template inline fvar log_falling_factorial(double x, const fvar& n) { using boost::math::digamma; return fvar(log_falling_factorial(x, n.val_), digamma(x - n.val_ + 1) * n.d_); } template inline fvar log_falling_factorial(const fvar& x, double n) { using boost::math::digamma; return fvar(log_falling_factorial(x.val_, n), (digamma(x.val_ + 1) - digamma(x.val_ - n + 1)) * x.d_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/erfc.hpp0000644000176200001440000000105213766554456022716 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ERFC_HPP #define STAN_MATH_FWD_SCAL_FUN_ERFC_HPP #include #include #include #include #include #include namespace stan { namespace math { template inline fvar erfc(const fvar& x) { using std::exp; return fvar(erfc(x.val_), -x.d_ * exp(-square(x.val_)) * TWO_OVER_SQRT_PI); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/value_of_rec.hpp0000644000176200001440000000110213766554456024424 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_VALUE_OF_REC_HPP #define STAN_MATH_FWD_SCAL_FUN_VALUE_OF_REC_HPP #include #include #include namespace stan { namespace math { /** * Return the value of the specified variable. * * T must implement value_of_rec. * * @tparam T Scalar type * @param v Variable. * @return Value of variable. */ template inline double value_of_rec(const fvar& v) { return value_of_rec(v.val_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/is_nan.hpp0000644000176200001440000000111113766554456023242 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_IS_NAN_HPP #define STAN_MATH_FWD_SCAL_FUN_IS_NAN_HPP #include #include #include namespace stan { namespace math { /** * Returns 1 if the input's value is NaN and 0 otherwise. * * Delegates to is_nan. * * @param x Value to test. * @return 1 if the value is NaN and 0 otherwise. */ template inline int is_nan(const fvar& x) { return is_nan(x.val()); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/Phi.hpp0000644000176200001440000000100413766554456022514 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_PHI_HPP #define STAN_MATH_FWD_SCAL_FUN_PHI_HPP #include #include #include #include namespace stan { namespace math { template inline fvar Phi(const fvar& x) { using std::exp; using std::sqrt; T xv = x.val_; return fvar(Phi(xv), x.d_ * exp(xv * xv / -2.0) / sqrt(2.0 * pi())); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log10.hpp0000644000176200001440000000102713766554456022723 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG10_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG10_HPP #include #include #include namespace stan { namespace math { template inline fvar log10(const fvar& x) { using std::log; using std::log10; if (x.val_ < 0.0) { return fvar(NOT_A_NUMBER, NOT_A_NUMBER); } else { return fvar(log10(x.val_), x.d_ / (x.val_ * LOG_10)); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/atan2.hpp0000644000176200001440000000170213766554456023006 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ATAN2_HPP #define STAN_MATH_FWD_SCAL_FUN_ATAN2_HPP #include #include #include #include namespace stan { namespace math { template inline fvar atan2(const fvar& x1, const fvar& x2) { using std::atan2; return fvar(atan2(x1.val_, x2.val_), (x1.d_ * x2.val_ - x1.val_ * x2.d_) / (square(x2.val_) + square(x1.val_))); } template inline fvar atan2(double x1, const fvar& x2) { using std::atan2; return fvar(atan2(x1, x2.val_), (-x1 * x2.d_) / (square(x1) + square(x2.val_))); } template inline fvar atan2(const fvar& x1, double x2) { using std::atan2; return fvar(atan2(x1.val_, x2), (x1.d_ * x2) / (square(x2) + square(x1.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_sum_exp.hpp0000644000176200001440000000214013766554456024317 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_SUM_EXP_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_SUM_EXP_HPP #include #include #include #include namespace stan { namespace math { template inline fvar log_sum_exp(const fvar& x1, const fvar& x2) { using std::exp; return fvar(log_sum_exp(x1.val_, x2.val_), x1.d_ / (1 + exp(x2.val_ - x1.val_)) + x2.d_ / (exp(x1.val_ - x2.val_) + 1)); } template inline fvar log_sum_exp(double x1, const fvar& x2) { using std::exp; if (x1 == NEGATIVE_INFTY) { return fvar(x2.val_, x2.d_); } return fvar(log_sum_exp(x1, x2.val_), x2.d_ / (exp(x1 - x2.val_) + 1)); } template inline fvar log_sum_exp(const fvar& x1, double x2) { using std::exp; if (x2 == NEGATIVE_INFTY) { return fvar(x1.val_, x1.d_); } return fvar(log_sum_exp(x1.val_, x2), x1.d_ / (1 + exp(x2 - x1.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/is_inf.hpp0000644000176200001440000000112313766554456023245 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_IS_INF_HPP #define STAN_MATH_FWD_SCAL_FUN_IS_INF_HPP #include #include #include namespace stan { namespace math { /** * Returns 1 if the input's value is infinite and 0 otherwise. * * Delegates to is_inf. * * @param x Value to test. * @return 1 if the value is infinite and 0 otherwise. */ template inline int is_inf(const fvar& x) { return is_inf(x.val()); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_rising_factorial.hpp0000644000176200001440000000173113766554456026163 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_RISING_FACTORIAL_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_RISING_FACTORIAL_HPP #include #include #include #include namespace stan { namespace math { template inline fvar log_rising_factorial(const fvar& x, const fvar& n) { return fvar( log_rising_factorial(x.val_, n.val_), digamma(x.val_ + n.val_) * (x.d_ + n.d_) - digamma(x.val_) * x.d_); } template inline fvar log_rising_factorial(const fvar& x, double n) { return fvar(log_rising_factorial(x.val_, n), (digamma(x.val_ + n) - digamma(x.val_)) * x.d_); } template inline fvar log_rising_factorial(double x, const fvar& n) { return fvar(log_rising_factorial(x, n.val_), digamma(x + n.val_) * n.d_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/expm1.hpp0000644000176200001440000000066313766554456023040 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_EXPM1_HPP #define STAN_MATH_FWD_SCAL_FUN_EXPM1_HPP #include #include #include #include namespace stan { namespace math { template inline fvar expm1(const fvar& x) { using std::exp; return fvar(expm1(x.val_), x.d_ * exp(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/inv.hpp0000644000176200001440000000061313766554456022575 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_INV_HPP #define STAN_MATH_FWD_SCAL_FUN_INV_HPP #include #include #include namespace stan { namespace math { template inline fvar inv(const fvar& x) { return fvar(1 / x.val_, -x.d_ / square(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/atan.hpp0000644000176200001440000000067213766554456022731 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_ATAN_HPP #define STAN_MATH_FWD_SCAL_FUN_ATAN_HPP #include #include #include #include namespace stan { namespace math { template inline fvar atan(const fvar& x) { using std::atan; return fvar(atan(x.val_), x.d_ / (1 + square(x.val_))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/trigamma.hpp0000644000176200001440000000115313766554456023602 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_TRIGAMMA_HPP #define STAN_MATH_FWD_SCAL_FUN_TRIGAMMA_HPP #include #include #include namespace stan { namespace math { /** * Return the value of the trigamma function at the specified * argument (i.e., the second derivative of the log Gamma function * at the specified argument). * * @param u argument * @return trigamma function at argument */ template inline fvar trigamma(const fvar& u) { return trigamma_impl(u); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/cbrt.hpp0000644000176200001440000000107113766554456022732 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_CBRT_HPP #define STAN_MATH_FWD_SCAL_FUN_CBRT_HPP #include #include #include namespace stan { namespace math { /** * Return cube root of specified argument. * * @tparam T Scalar type of autodiff variable. * @param x Argument. * @return Cube root of argument. */ template inline fvar cbrt(const fvar& x) { return fvar(cbrt(x.val_), x.d_ / (3 * square(cbrt(x.val_)))); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/digamma.hpp0000644000176200001440000000127713766554456023407 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_DIGAMMA_HPP #define STAN_MATH_FWD_SCAL_FUN_DIGAMMA_HPP #include #include #include #include namespace stan { namespace math { /** * Return the derivative of the log gamma function at the * specified argument. * * @tparam T scalar type of autodiff variable * @param[in] x argument * @return derivative of the log gamma function at the specified * argument */ template inline fvar digamma(const fvar& x) { return fvar(digamma(x.val_), x.d_ * trigamma(x.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/trunc.hpp0000644000176200001440000000113313766554456023132 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_TRUNC_HPP #define STAN_MATH_FWD_SCAL_FUN_TRUNC_HPP #include #include #include namespace stan { namespace math { /** * Return the nearest integral value that is not larger in * magnitude than the specified argument. * * @tparam T Scalar type of autodiff variable. * @param[in] x Argument. * @return The truncated argument. */ template inline fvar trunc(const fvar& x) { return fvar(trunc(x.val_), 0); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/ldexp.hpp0000644000176200001440000000121313766554456023112 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LDEXP_HPP #define STAN_MATH_FWD_SCAL_FUN_LDEXP_HPP #include #include #include namespace stan { namespace math { /** * Returns the product of a (the significand) times * 2 to power b (the exponent). * * @tparam T Scalar type of significand * @param[in] a the significand * @param[in] b an integer that is the exponent * @return product of a times 2 to the power b */ template inline fvar ldexp(const fvar& a, int b) { return fvar(ldexp(a.val_, b), ldexp(a.d_, b)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/fma.hpp0000644000176200001440000000757313766554456022560 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_FMA_HPP #define STAN_MATH_FWD_SCAL_FUN_FMA_HPP #include #include #include namespace stan { namespace math { /** * The fused multiply-add operation (C99). * * This double-based operation delegates to fma. * * The function is defined by * * fma(a, b, c) = (a * b) + c. * * \f[ \mbox{fma}(x, y, z) = \begin{cases} x\cdot y+z & \mbox{if } -\infty\leq x, y, z \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fma}(x, y, z)}{\partial x} = \begin{cases} y & \mbox{if } -\infty\leq x, y, z \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fma}(x, y, z)}{\partial y} = \begin{cases} x & \mbox{if } -\infty\leq x, y, z \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] \f[ \frac{\partial\, \mbox{fma}(x, y, z)}{\partial z} = \begin{cases} 1 & \mbox{if } -\infty\leq x, y, z \leq \infty \\[6pt] \textrm{NaN} & \mbox{if } x = \textrm{NaN} \end{cases} \f] * * @param x1 First value. * @param x2 Second value. * @param x3 Third value. * @return Product of the first two values plus the third. */ template inline fvar::type> fma( const fvar& x1, const fvar& x2, const fvar& x3) { return fvar::type>( fma(x1.val_, x2.val_, x3.val_), x1.d_ * x2.val_ + x2.d_ * x1.val_ + x3.d_); } /** * See all-var input signature for details on the function and derivatives. */ template inline fvar::type> fma( const T1& x1, const fvar& x2, const fvar& x3) { return fvar::type>( fma(x1, x2.val_, x3.val_), x2.d_ * x1 + x3.d_); } /** * See all-var input signature for details on the function and derivatives. */ template inline fvar::type> fma( const fvar& x1, const T2& x2, const fvar& x3) { return fvar::type>( fma(x1.val_, x2, x3.val_), x1.d_ * x2 + x3.d_); } /** * See all-var input signature for details on the function and derivatives. */ template inline fvar::type> fma( const fvar& x1, const fvar& x2, const T3& x3) { return fvar::type>( fma(x1.val_, x2.val_, x3), x1.d_ * x2.val_ + x2.d_ * x1.val_); } /** * See all-var input signature for details on the function and derivatives. */ template inline fvar::type> fma( const T1& x1, const T2& x2, const fvar& x3) { return fvar::type>( fma(x1, x2, x3.val_), x3.d_); } /** * See all-var input signature for details on the function and derivatives. */ template inline fvar::type> fma( const fvar& x1, const T2& x2, const T3& x3) { return fvar::type>( fma(x1.val_, x2, x3), x1.d_ * x2); } /** * See all-var input signature for details on the function and derivatives. */ template inline fvar::type> fma( const T1& x1, const fvar& x2, const T3& x3) { return fvar::type>( fma(x1, x2.val_, x3), x2.d_ * x1); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/fun/log_mix.hpp0000644000176200001440000002152313766554456023442 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_FUN_LOG_MIX_HPP #define STAN_MATH_FWD_SCAL_FUN_LOG_MIX_HPP #include #include #include #include #include #include #include namespace stan { namespace math { /* Returns an array of size N with partials of log_mix wrt to its * parameters instantiated as fvar * * @tparam T_theta theta scalar type * @tparam T_lambda1 lambda_1 scalar type * @tparam T_lambda2 lambda_2 scalar type * * @param[in] N output array size * @param[in] theta_d mixing proportion theta * @param[in] lambda1_d log_density with mixing proportion theta * @param[in] lambda2_d log_density with mixing proportion 1.0 - theta * @param[out] partials_array array of partials derivatives */ template inline void log_mix_partial_helper( const T_theta& theta, const T_lambda1& lambda1, const T_lambda2& lambda2, typename boost::math::tools::promote_args< T_theta, T_lambda1, T_lambda2>::type (&partials_array)[N]) { using boost::math::tools::promote_args; using std::exp; using partial_return_type = typename promote_args::type; typename promote_args::type lam2_m_lam1 = lambda2 - lambda1; typename promote_args::type exp_lam2_m_lam1 = exp(lam2_m_lam1); typename promote_args::type one_m_exp_lam2_m_lam1 = 1.0 - exp_lam2_m_lam1; typename promote_args::type one_m_t = 1.0 - theta; partial_return_type one_m_t_prod_exp_lam2_m_lam1 = one_m_t * exp_lam2_m_lam1; partial_return_type t_plus_one_m_t_prod_exp_lam2_m_lam1 = theta + one_m_t_prod_exp_lam2_m_lam1; partial_return_type one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1 = 1.0 / t_plus_one_m_t_prod_exp_lam2_m_lam1; unsigned int offset = 0; if (std::is_same::value) { partials_array[offset] = one_m_exp_lam2_m_lam1 * one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1; ++offset; } if (std::is_same::value) { partials_array[offset] = theta * one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1; ++offset; } if (std::is_same::value) { partials_array[offset] = one_m_t_prod_exp_lam2_m_lam1 * one_d_t_plus_one_m_t_prod_exp_lam2_m_lam1; } } /** * Return the log mixture density with specified mixing proportion * and log densities and its derivative at each. * * \f[ * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \log \left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right). * \f] * * \f[ * \frac{\partial}{\partial \theta} * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \dfrac{\exp(\lambda_1) - \exp(\lambda_2)} * {\left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right)} * \f] * * \f[ * \frac{\partial}{\partial \lambda_1} * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \dfrac{\theta \exp(\lambda_1)} * {\left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right)} * \f] * * \f[ * \frac{\partial}{\partial \lambda_2} * \mbox{log\_mix}(\theta, \lambda_1, \lambda_2) * = \dfrac{\theta \exp(\lambda_2)} * {\left( \theta \exp(\lambda_1) + (1 - \theta) \exp(\lambda_2) \right)} * \f] * * @tparam T scalar type. * * @param[in] theta mixing proportion in [0, 1]. * @param[in] lambda1 first log density. * @param[in] lambda2 second log density. * * @return log mixture of densities in specified proportion */ template inline fvar log_mix(const fvar& theta, const fvar& lambda1, const fvar& lambda2) { if (lambda1.val_ > lambda2.val_) { fvar partial_deriv_array[3]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1.val_, lambda2.val_), theta.d_ * value_of(partial_deriv_array[0]) + lambda1.d_ * value_of(partial_deriv_array[1]) + lambda2.d_ * value_of(partial_deriv_array[2])); } else { fvar partial_deriv_array[3]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1.val_, lambda2.val_), -theta.d_ * value_of(partial_deriv_array[0]) + lambda1.d_ * value_of(partial_deriv_array[2]) + lambda2.d_ * value_of(partial_deriv_array[1])); } } template inline fvar log_mix(const fvar& theta, const fvar& lambda1, double lambda2) { if (lambda1.val_ > lambda2) { fvar partial_deriv_array[2]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1.val_, lambda2), theta.d_ * value_of(partial_deriv_array[0]) + lambda1.d_ * value_of(partial_deriv_array[1])); } else { fvar partial_deriv_array[2]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1.val_, lambda2), -theta.d_ * value_of(partial_deriv_array[0]) + lambda1.d_ * value_of(partial_deriv_array[1])); } } template inline fvar log_mix(const fvar& theta, double lambda1, const fvar& lambda2) { if (lambda1 > lambda2.val_) { fvar partial_deriv_array[2]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1, lambda2.val_), theta.d_ * value_of(partial_deriv_array[0]) + lambda2.d_ * value_of(partial_deriv_array[1])); } else { fvar partial_deriv_array[2]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1, lambda2.val_), -theta.d_ * value_of(partial_deriv_array[0]) + lambda2.d_ * value_of(partial_deriv_array[1])); } } template inline fvar log_mix(double theta, const fvar& lambda1, const fvar& lambda2) { if (lambda1.val_ > lambda2.val_) { fvar partial_deriv_array[2]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta, lambda1.val_, lambda2.val_), lambda1.d_ * value_of(partial_deriv_array[0]) + lambda2.d_ * value_of(partial_deriv_array[1])); } else { fvar partial_deriv_array[2]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta, lambda1.val_, lambda2.val_), lambda1.d_ * value_of(partial_deriv_array[1]) + lambda2.d_ * value_of(partial_deriv_array[0])); } } template inline fvar log_mix(const fvar& theta, double lambda1, double lambda2) { if (lambda1 > lambda2) { fvar partial_deriv_array[1]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1, lambda2), theta.d_ * value_of(partial_deriv_array[0])); } else { fvar partial_deriv_array[1]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta.val_, lambda1, lambda2), -theta.d_ * value_of(partial_deriv_array[0])); } } template inline fvar log_mix(double theta, const fvar& lambda1, double lambda2) { if (lambda1.val_ > lambda2) { fvar partial_deriv_array[1]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta, lambda1.val_, lambda2), lambda1.d_ * value_of(partial_deriv_array[0])); } else { fvar partial_deriv_array[1]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta, lambda1.val_, lambda2), lambda1.d_ * value_of(partial_deriv_array[0])); } } template inline fvar log_mix(double theta, double lambda1, const fvar& lambda2) { if (lambda1 > lambda2.val_) { fvar partial_deriv_array[1]; log_mix_partial_helper(theta, lambda1, lambda2, partial_deriv_array); return fvar(log_mix(theta, lambda1, lambda2.val_), lambda2.d_ * value_of(partial_deriv_array[0])); } else { fvar partial_deriv_array[1]; log_mix_partial_helper(1.0 - theta, lambda2, lambda1, partial_deriv_array); return fvar(log_mix(theta, lambda1, lambda2.val_), lambda2.d_ * value_of(partial_deriv_array[0])); } } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/meta/0000755000176200001440000000000013766554456021426 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/scal/meta/partials_type.hpp0000644000176200001440000000065213766554456025022 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_META_PARTIALS_TYPE_HPP #define STAN_MATH_FWD_SCAL_META_PARTIALS_TYPE_HPP #include #include #include #include namespace stan { template struct partials_type> { using type = typename std::decay_t::Scalar; }; } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/meta/is_fvar.hpp0000644000176200001440000000110313766554456023563 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_META_IS_FVAR_HPP #define STAN_MATH_FWD_SCAL_META_IS_FVAR_HPP #include #include #include namespace stan { namespace internal { template struct is_fvar_impl : std::false_type {}; template struct is_fvar_impl> : std::true_type {}; } // namespace internal template struct is_fvar>::value>> : std::true_type {}; } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/scal/meta/operands_and_partials.hpp0000644000176200001440000001043113766554456026472 0ustar liggesusers#ifndef STAN_MATH_FWD_SCAL_META_OPERANDS_AND_PARTIALS_HPP #define STAN_MATH_FWD_SCAL_META_OPERANDS_AND_PARTIALS_HPP #include #include #include namespace stan { namespace math { namespace internal { template class ops_partials_edge > { public: using Op = fvar; Dx partial_; broadcast_array partials_; explicit ops_partials_edge(const Op& op) : partial_(0), partials_(partial_), operand_(op) {} private: template friend class stan::math::operands_and_partials; const Op& operand_; Dx dx() { return this->partials_[0] * this->operand_.d_; } }; } // namespace internal /** * This class builds partial derivatives with respect to a set of * operands. There are two reason for the generality of this * class. The first is to handle vector and scalar arguments * without needing to write additional code. The second is to use * this class for writing probability distributions that handle * primitives, reverse mode, and forward mode variables * seamlessly. * * Conceptually, this class is used when we want to manually calculate * the derivative of a function and store this manual result on the * autodiff stack in a sort of "compressed" form. Think of it like an * easy-to-use interface to rev/core/precomputed_gradients. * * This class now supports multivariate use-cases as well by * exposing edge#_.partials_vec * * This is the specialization for when the return type is fvar, * which should be for forward mode and all higher-order cases. * * NB: since ops_partials_edge.partials_ and ops_partials_edge.partials_vec * are sometimes represented internally as a broadcast_array, we need to take * care with assignments to them. Indeed, we can assign any right hand side * which allows for indexing to a broadcast_array. The resulting behaviour is * that the entry for the first index is what gets assigned. The most common * use-case should be where the rhs is some container of length 1. * * @tparam Op1 type of the first operand * @tparam Op2 type of the second operand * @tparam Op3 type of the third operand * @tparam Op4 type of the fourth operand * @tparam Op5 type of the fifth operand * @tparam T_return_type return type of the expression. This defaults * to a template metaprogram that calculates the scalar promotion of * Op1 -- Op5 */ template class operands_and_partials > { public: internal::ops_partials_edge edge1_; internal::ops_partials_edge edge2_; internal::ops_partials_edge edge3_; internal::ops_partials_edge edge4_; internal::ops_partials_edge edge5_; using T_return_type = fvar; explicit operands_and_partials(const Op1& o1) : edge1_(o1) {} operands_and_partials(const Op1& o1, const Op2& o2) : edge1_(o1), edge2_(o2) {} operands_and_partials(const Op1& o1, const Op2& o2, const Op3& o3) : edge1_(o1), edge2_(o2), edge3_(o3) {} operands_and_partials(const Op1& o1, const Op2& o2, const Op3& o3, const Op4& o4) : edge1_(o1), edge2_(o2), edge3_(o3), edge4_(o4) {} operands_and_partials(const Op1& o1, const Op2& o2, const Op3& o3, const Op4& o4, const Op5& o5) : edge1_(o1), edge2_(o2), edge3_(o3), edge4_(o4), edge5_(o5) {} /** * Build the node to be stored on the autodiff graph. * This should contain both the value and the tangent. * * For scalars, we don't calculate any tangents. * For reverse mode, we end up returning a type of var that will calculate * the appropriate adjoint using the stored operands and partials. * Forward mode just calculates the tangent on the spot and returns it in * a vanilla fvar. * * @param value the return value of the function we are compressing * @return the value with its derivative */ T_return_type build(Dx value) { Dx deriv = edge1_.dx() + edge2_.dx() + edge3_.dx() + edge4_.dx() + edge5_.dx(); return T_return_type(value, deriv); } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/0000755000176200001440000000000013766604372020477 5ustar liggesusersStanHeaders/inst/include/stan/math/fwd/core/fvar.hpp0000644000176200001440000001577713766554456022176 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_FVAR_HPP #define STAN_MATH_FWD_CORE_FVAR_HPP #include #include #include #include namespace stan { namespace math { /** * This template class represents scalars used in forward-mode * automatic differentiation, which consist of values and * directional derivatives of the specified template type. When * performing operations on instances of this class, all operands * should be either primitive integer or double values or dual * numbers representing derivatives in the same direction. The * typical use case is to have a unit length directional * derivative in the direction of a single independent variable. * * By using reverse-mode automatic derivative variables, * second-order derivatives may * be calculated. By using fvar<Wikipedia * page on automatic differentiation describes how * forward-mode automatic differentiation works mathematically in * terms of dual numbers. * * @tparam T type of value and tangent */ template struct fvar { /** * The value of this variable. */ T val_; /** * The tangent (derivative) of this variable. */ T d_; /** * The Type inside of the fvar. */ using Scalar = T; /** * Return the value of this variable. * * @return value of this variable */ T val() const { return val_; } /** * Return the tangent (derivative) of this variable. * * @return tangent of this variable */ T tangent() const { return d_; } /** * Construct a forward variable with zero value and tangent. */ fvar() : val_(0), d_(0) {} /** * Construct a forward variable with value and tangent set to * the value and tangent of the specified variable. * * @param[in] x variable to be copied */ fvar(const fvar& x) : val_(x.val_), d_(x.d_) {} /** * Construct a forward variable with the specified value and * zero tangent. * * @tparam V type of value (must be assignable to T) * @param[in] v value */ template ::value>> fvar(const V& v) : val_(v), d_(0) {} // NOLINT(runtime/explicit) /** * Construct a forward variable with the specified value and * tangent. * * @tparam V type of value (must be assignable to the value and * tangent type T) * @tparam D type of tangent (must be assignable to the value and * tangent type T) * @param[in] v value * @param[in] d tangent */ template fvar(const V& v, const D& d) : val_(v), d_(d) {} /** * Add the specified variable to this variable and return a * reference to this variable. * * @param[in] x2 variable to add * @return reference to this variable after addition */ inline fvar& operator+=(const fvar& x2) { val_ += x2.val_; d_ += x2.d_; return *this; } /** * Add the specified value to this variable and return a * reference to this variable. * * @param[in] x2 value to add * @return reference to this variable after addition */ inline fvar& operator+=(double x2) { val_ += x2; return *this; } /** * Subtract the specified variable from this variable and return a * reference to this variable. * * @param[in] x2 variable to subtract * @return reference to this variable after subtraction */ inline fvar& operator-=(const fvar& x2) { val_ -= x2.val_; d_ -= x2.d_; return *this; } /** * Subtract the specified value from this variable and return a * reference to this variable. * * @param[in] x2 value to add * @return reference to this variable after subtraction */ inline fvar& operator-=(double x2) { val_ -= x2; return *this; } /** * Multiply this variable by the the specified variable and * return a reference to this variable. * * @param[in] x2 variable to multiply * @return reference to this variable after multiplication */ inline fvar& operator*=(const fvar& x2) { d_ = d_ * x2.val_ + val_ * x2.d_; val_ *= x2.val_; return *this; } /** * Multiply this variable by the the specified value and * return a reference to this variable. * * @param[in] x2 value to multiply * @return reference to this variable after multiplication */ inline fvar& operator*=(double x2) { val_ *= x2; d_ *= x2; return *this; } /** * Divide this variable by the the specified variable and * return a reference to this variable. * * @param[in] x2 variable to divide this variable by * @return reference to this variable after division */ inline fvar& operator/=(const fvar& x2) { d_ = (d_ * x2.val_ - val_ * x2.d_) / (x2.val_ * x2.val_); val_ /= x2.val_; return *this; } /** * Divide this value by the the specified variable and * return a reference to this variable. * * @param[in] x2 value to divide this variable by * @return reference to this variable after division */ inline fvar& operator/=(double x2) { val_ /= x2; d_ /= x2; return *this; } /** * Increment this variable by one and return a reference to this * variable after the increment. * * @return reference to this variable after increment */ inline fvar& operator++() { ++val_; return *this; } /** * Increment this variable by one and return a reference to a * copy of this variable before it was incremented. * * @return reference to copy of this variable before increment */ inline fvar operator++(int /*dummy*/) { fvar result(val_, d_); ++val_; return result; } /** * Decrement this variable by one and return a reference to this * variable after the decrement. * * @return reference to this variable after decrement */ inline fvar& operator--() { --val_; return *this; } /** * Decrement this variable by one and return a reference to a * copy of this variable before it was decremented. * * @return reference to copy of this variable before decrement */ inline fvar operator--(int /*dummy*/) { fvar result(val_, d_); --val_; return result; } /** * Write the value of the specified variable to the specified * output stream, returning a reference to the output stream. * * @param[in,out] os stream for writing value * @param[in] v variable whose value is written * @return reference to the specified output stream */ friend std::ostream& operator<<(std::ostream& os, const fvar& v) { return os << v.val_; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_greater_than.hpp0000644000176200001440000000266613766554456025607 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_GREATER_THAN_HPP #define STAN_MATH_FWD_CORE_OPERATOR_GREATER_THAN_HPP #include namespace stan { namespace math { /** * Return true if the first argument has a greater value than the * second as defined by >. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a greater value than the * second */ template inline bool operator>(const fvar& x, const fvar& y) { return x.val_ > y.val_; } /** * Return true if the first argument has a greater value than the * second as defined by >. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a greater value than the * second */ template inline bool operator>(const fvar& x, double y) { return x.val_ > y; } /** * Return true if the first argument has a greater value than the * second as defined by >. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a greater value than the * second */ template inline bool operator>(double x, const fvar& y) { return x > y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/std_numeric_limits.hpp0000644000176200001440000001076413766554456025124 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_STD_NUMERIC_LIMITS_HPP #define STAN_MATH_FWD_CORE_STD_NUMERIC_LIMITS_HPP #include #include namespace std { template struct numeric_limits > { static const bool is_specialized; static constexpr stan::math::fvar min() { return numeric_limits::min(); } static constexpr stan::math::fvar max() { return numeric_limits::max(); } static const int digits; static const int digits10; static const bool is_signed; static const bool is_integer; static const bool is_exact; static const int radix; static constexpr stan::math::fvar epsilon() { return numeric_limits::epsilon(); } static constexpr stan::math::fvar round_error() { return numeric_limits::round_error(); } static const int min_exponent; static const int min_exponent10; static const int max_exponent; static const int max_exponent10; static const bool has_infinity; static const bool has_quiet_NaN; static const bool has_signaling_NaN; static const float_denorm_style has_denorm; static const bool has_denorm_loss; static constexpr stan::math::fvar infinity() { return numeric_limits::infinity(); } static constexpr stan::math::fvar quiet_NaN() { return numeric_limits::quiet_NaN(); } static constexpr stan::math::fvar signaling_NaN() { return numeric_limits::signaling_NaN(); } static constexpr stan::math::fvar denorm_min() { return numeric_limits::denorm_min(); } static const bool is_iec559; static const bool is_bounded; static const bool is_modulo; static const bool traps; static const bool tinyness_before; static const float_round_style round_style; }; template const bool numeric_limits >::is_specialized = true; template const int numeric_limits >::digits = numeric_limits::digits; template const int numeric_limits >::digits10 = numeric_limits::digits10; template const bool numeric_limits >::is_signed = numeric_limits::is_signed; template const bool numeric_limits >::is_integer = numeric_limits::is_integer; template const bool numeric_limits >::is_exact = numeric_limits::is_exact; template const int numeric_limits >::radix = numeric_limits::radix; template const int numeric_limits >::min_exponent = numeric_limits::min_exponent; template const int numeric_limits >::min_exponent10 = numeric_limits::min_exponent10; template const int numeric_limits >::max_exponent = numeric_limits::max_exponent; template const int numeric_limits >::max_exponent10 = numeric_limits::max_exponent10; template const bool numeric_limits >::has_infinity = numeric_limits::has_infinity; template const bool numeric_limits >::has_quiet_NaN = numeric_limits::has_quiet_NaN; template const bool numeric_limits >::has_signaling_NaN = numeric_limits::has_signaling_NaN; template const float_denorm_style numeric_limits >::has_denorm = numeric_limits::has_denorm; template const bool numeric_limits >::has_denorm_loss = numeric_limits::has_denorm_loss; template const bool numeric_limits >::is_iec559 = numeric_limits::is_iec559; template const bool numeric_limits >::is_bounded = numeric_limits::is_bounded; template const bool numeric_limits >::is_modulo = numeric_limits::is_modulo; template const bool numeric_limits >::traps = numeric_limits::traps; template const bool numeric_limits >::tinyness_before = numeric_limits::tinyness_before; template const float_round_style numeric_limits >::round_style = numeric_limits::round_style; } // namespace std #endif StanHeaders/inst/include/stan/math/fwd/core/operator_logical_and.hpp0000644000176200001440000000260413766554456025370 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_LOGICAL_AND_HPP #define STAN_MATH_FWD_CORE_OPERATOR_LOGICAL_AND_HPP #include namespace stan { namespace math { /** * Return the logical conjunction of the values of the two * arguments as defined by &&. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return disjuntion of the argument's values */ template inline bool operator&&(const fvar& x, const fvar& y) { return x.val_ && y.val_; } /** * Return the logical conjunction of the values of the two * arguments as defined by &&. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return conjunction of first argument's value and second * argument */ template inline bool operator&&(const fvar& x, double y) { return x.val_ && y; } /** * Return the logical conjunction of the values of the two * arguments as defined by &&. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return conjunction of first argument and the second * argument's value */ template inline bool operator&&(double x, const fvar& y) { return x && y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_less_than_or_equal.hpp0000644000176200001440000000311213766554456026776 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_LESS_THAN_OR_EQUAL_HPP #define STAN_MATH_FWD_CORE_OPERATOR_LESS_THAN_OR_EQUAL_HPP #include namespace stan { namespace math { /** * Return true if the first argument has a value less than or * equal to the value of the second argument as defined by * <=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument's value is less than or * equal to the second argument's value */ template inline bool operator<=(const fvar& x, const fvar& y) { return x.val_ <= y.val_; } /** * Return true if the first argument has a value less than or * equal to the second argument as defined by <=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument's value is less than or * equal to the second argument */ template inline bool operator<=(const fvar& x, double y) { return x.val_ <= y; } /** * Return true if the first argument is less than or equal to the * second argument's value as defined by <=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument is less than or equal to the * second argument's value */ template inline bool operator<=(double x, const fvar& y) { return x <= y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_logical_or.hpp0000644000176200001440000000260213766554456025244 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_LOGICAL_OR_HPP #define STAN_MATH_FWD_CORE_OPERATOR_LOGICAL_OR_HPP #include namespace stan { namespace math { /** * Return the logical disjunction of the values of the two * arguments as defined by ||. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return disjuntion of the argument's values */ template inline bool operator||(const fvar& x, const fvar& y) { return x.val_ || y.val_; } /** * Return the logical disjunction of the values of the two * arguments as defined by ||. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return disjunction of first argument's value and second * argument */ template inline bool operator||(const fvar& x, double y) { return x.val_ || y; } /** * Return the logical disjunction of the values of the two * arguments as defined by ||. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return disjunction of first argument and the second * argument's value */ template inline bool operator||(double x, const fvar& y) { return x || y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_division.hpp0000644000176200001440000000264713766554456024767 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_DIVISION_HPP #define STAN_MATH_FWD_CORE_OPERATOR_DIVISION_HPP #include namespace stan { namespace math { /** * Return the result of dividing the first argument by the second. * * @tparam T type of fvar value and tangent * @param x1 first argument * @param x2 second argument * @return first argument divided by second argument */ template inline fvar operator/(const fvar& x1, const fvar& x2) { return fvar(x1.val_ / x2.val_, (x1.d_ * x2.val_ - x1.val_ * x2.d_) / (x2.val_ * x2.val_)); } /** * Return the result of dividing the first argument by the second. * * @tparam T type of fvar value and tangent * @param x1 first argument * @param x2 second argument * @return first argument divided by second argument */ template inline fvar operator/(const fvar& x1, double x2) { return fvar(x1.val_ / x2, x1.d_ / x2); } /** * Return the result of dividing the first argument by the second. * * @tparam T type of fvar value and tangent * @param x1 first argument * @param x2 second argument * @return first argument divided by second argument */ template inline fvar operator/(double x1, const fvar& x2) { // TODO(carpenter): store x1 / x2.val_ and reuse return fvar(x1 / x2.val_, -x1 * x2.d_ / (x2.val_ * x2.val_)); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_equal.hpp0000644000176200001440000000255413766554456024247 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_EQUAL_HPP #define STAN_MATH_FWD_CORE_OPERATOR_EQUAL_HPP #include namespace stan { namespace math { /** * Return true if the specified variables have equal values as * defined by ==. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the arguments have equal values */ template inline bool operator==(const fvar& x, const fvar& y) { return x.val_ == y.val_; } /** * Return true if the the first variable has a value equal to * the second argument as defined by * by ==. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the arguments have equal values */ template inline bool operator==(const fvar& x, double y) { return x.val_ == y; } /** * Return true if the the first argument is equal to the value of * the second argument as defined by by ==. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the arguments have equal values */ template inline bool operator==(double x, const fvar& y) { return x == y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_not_equal.hpp0000644000176200001440000000271213766554456025123 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_NOT_EQUAL_HPP #define STAN_MATH_FWD_CORE_OPERATOR_NOT_EQUAL_HPP #include namespace stan { namespace math { /** * Return true if the value of the two arguments are not equal as * defined by !=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the values of the arguments are not equal */ template inline bool operator!=(const fvar& x, const fvar& y) { return x.val_ != y.val_; } /** * Return true if the value of the first argument is not equal to * the second argument as defined by !=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the value of the first argument is not equal to * the second argument */ template inline bool operator!=(const fvar& x, double y) { return x.val_ != y; } /** * Return true if the first argument is not equal to the value of * the second argument as defined by !=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument is not equal to the value of * the second argument */ template inline bool operator!=(double x, const fvar& y) { return x != y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_subtraction.hpp0000644000176200001440000000230113766554456025463 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_SUBTRACTION_HPP #define STAN_MATH_FWD_CORE_OPERATOR_SUBTRACTION_HPP #include namespace stan { namespace math { /** * Return the difference of the specified arguments. * * @tparam T type of values and tangents * @param x1 first argument * @param x2 second argument * @return difference of the arguments */ template inline fvar operator-(const fvar& x1, const fvar& x2) { return fvar(x1.val_ - x2.val_, x1.d_ - x2.d_); } /** * Return the difference of the specified arguments. * * @tparam T type of values and tangents * @param x1 first argument * @param x2 second argument * @return difference of the arguments */ template inline fvar operator-(double x1, const fvar& x2) { return fvar(x1 - x2.val_, -x2.d_); } /** * Return the difference of the specified arguments. * * @tparam T type of values and tangents * @param x1 first argument * @param x2 second argument * @return difference of the arguments */ template inline fvar operator-(const fvar& x1, double x2) { return fvar(x1.val_ - x2, x1.d_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_multiplication.hpp0000644000176200001440000000230713766554456026171 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_MULTIPLICATION_HPP #define STAN_MATH_FWD_CORE_OPERATOR_MULTIPLICATION_HPP #include namespace stan { namespace math { /** * Return the product of the two arguments. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return product of arguments */ template inline fvar operator*(const fvar& x, const fvar& y) { return fvar(x.val_ * y.val_, x.d_ * y.val_ + x.val_ * y.d_); } /** * Return the product of the two arguments. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return product of arguments */ template inline fvar operator*(double x, const fvar& y) { return fvar(x * y.val_, x * y.d_); } /** * Return the product of the two arguments. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return product of arguments */ template inline fvar operator*(const fvar& x, double y) { return fvar(x.val_ * y, x.d_ * y); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_less_than.hpp0000644000176200001440000000276713766554456025126 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_LESS_THAN_HPP #define STAN_MATH_FWD_CORE_OPERATOR_LESS_THAN_HPP #include namespace stan { namespace math { /** * Return true if the first argument has a value less than the * value of the second argument as defined by <. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument's value is less than the * second argument's value */ template inline bool operator<(const fvar& x, const fvar& y) { return x.val_ < y.val_; } /** * Return true if the first argument is less than the value of the * second argument as defined by <. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument is less than the second's * value argument */ template inline bool operator<(double x, const fvar& y) { return x < y.val_; } /** * Return true if the first argument has a value less than the * second argument as defined by <. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a value less than the * second argument * argument */ template inline bool operator<(const fvar& x, double y) { return x.val_ < y; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_unary_plus.hpp0000644000176200001440000000110213766554456025325 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_UNARY_PLUS_HPP #define STAN_MATH_FWD_CORE_OPERATOR_UNARY_PLUS_HPP #include namespace stan { namespace math { /** * Returns the argument. It is included for completeness. The * primitive unary operator+ exists to promote * integer to floating point values. * * @tparam T value and tangent type of the argument * @param x argument * @return the argument */ template inline fvar operator+(const fvar& x) { return x; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_addition.hpp0000644000176200001440000000225113766554456024725 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_ADDITION_HPP #define STAN_MATH_FWD_CORE_OPERATOR_ADDITION_HPP #include namespace stan { namespace math { /** * Return the sum of the specified forward mode addends. * * @tparam T type of values and tangents * @param x1 first addend * @param x2 second addend * @return sum of addends */ template inline fvar operator+(const fvar& x1, const fvar& x2) { return fvar(x1.val_ + x2.val_, x1.d_ + x2.d_); } /** * Return the sum of the specified double and forward mode addends. * * @tparam T type of values and tangents * @param x1 first addend * @param x2 second addend * @return sum of addends */ template inline fvar operator+(double x1, const fvar& x2) { return fvar(x1 + x2.val_, x2.d_); } /** * Return the sum of the specified forward mode and double addends. * * @tparam T type of values and tangents * @param x1 first addend * @param x2 second addend * @return sum of addends */ template inline fvar operator+(const fvar& x1, double x2) { return fvar(x1.val_ + x2, x1.d_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_unary_not.hpp0000644000176200001440000000100513766554456025144 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_UNARY_NOT_HPP #define STAN_MATH_FWD_CORE_OPERATOR_UNARY_NOT_HPP #include namespace stan { namespace math { /** * Return the negation of the value of the argument as defined by * !. * * @tparam value and tangent type for variables * @param[in] x argument * @return negation of argument value */ template inline bool operator!(const fvar& x) { return !x.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_unary_minus.hpp0000644000176200001440000000076413766554456025512 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_UNARY_MINUS_HPP #define STAN_MATH_FWD_CORE_OPERATOR_UNARY_MINUS_HPP #include namespace stan { namespace math { /** * Return the negation of the specified argument. * * @tparam value and tangent type of the argument * @param[in] x argument * @return negation of argument */ template inline fvar operator-(const fvar& x) { return fvar(-x.val_, -x.d_); } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core/operator_greater_than_or_equal.hpp0000644000176200001440000000314613766554456027470 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_OPERATOR_GREATER_THAN_OR_EQUAL_HPP #define STAN_MATH_FWD_CORE_OPERATOR_GREATER_THAN_OR_EQUAL_HPP #include namespace stan { namespace math { /** * Return true if the value of the first argument is greater than or * equal to that of the second as defined by >=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a value greater than or * equal to that of the second */ template inline bool operator>=(const fvar& x, const fvar& y) { return x.val_ >= y.val_; } /** * Return true if the value of the first argument has a value * greater than or equal to the second argument as defined by * >=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a value greater than or * equal to that of the second */ template inline bool operator>=(const fvar& x, double y) { return x.val_ >= y; } /** * Return true if the first argument is greater than or equal to * the value of the second argument as defined by * >=. * * @tparam value and tangent type for variables * @param[in] x first argument * @param[in] y second argument * @return true if the first argument has a value greater than or * equal to that of the second */ template inline bool operator>=(double x, const fvar& y) { return x >= y.val_; } } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/fwd/core.hpp0000644000176200001440000000173513766554456021225 0ustar liggesusers#ifndef STAN_MATH_FWD_CORE_HPP #define STAN_MATH_FWD_CORE_HPP #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #endif StanHeaders/inst/include/stan/math/memory/0000755000176200001440000000000013766554456020306 5ustar liggesusersStanHeaders/inst/include/stan/math/memory/stack_alloc.hpp0000644000176200001440000002133413766554456023301 0ustar liggesusers#ifndef STAN_MATH_MEMORY_STACK_ALLOC_HPP #define STAN_MATH_MEMORY_STACK_ALLOC_HPP // TODO(Bob): replaces this ifdef in C++11, until then this // is best we can do to get safe pointer casts to uints. #include #include #include #include #include #include #include namespace stan { namespace math { /** * Return true if the specified pointer is aligned * on the number of bytes. * * This doesn't really make sense other than for powers of 2. * * @param ptr Pointer to test. * @param bytes_aligned Number of bytes of alignment required. * @return true if pointer is aligned. * @tparam Type of object to which pointer points. */ template bool is_aligned(T* ptr, unsigned int bytes_aligned) { return (reinterpret_cast(ptr) % bytes_aligned) == 0U; } namespace internal { const size_t DEFAULT_INITIAL_NBYTES = 1 << 16; // 64KB // FIXME: enforce alignment // big fun to inline, but only called twice inline char* eight_byte_aligned_malloc(size_t size) { char* ptr = static_cast(malloc(size)); if (!ptr) { return ptr; // malloc failed to alloc } if (!is_aligned(ptr, 8U)) { std::stringstream s; s << "invalid alignment to 8 bytes, ptr=" << reinterpret_cast(ptr) << std::endl; throw std::runtime_error(s.str()); } return ptr; } } // namespace internal /** * An instance of this class provides a memory pool through * which blocks of raw memory may be allocated and then collected * simultaneously. * * This class is useful in settings where large numbers of small * objects are allocated and then collected all at once. This may * include objects whose destructors have no effect. * * Memory is allocated on a stack of blocks. Each block allocated * is twice as large as the previous one. The memory may be * recovered, with the blocks being reused, or all blocks may be * freed, resetting the stack of blocks to its original state. * * Alignment up to 8 byte boundaries guaranteed for the first malloc, * and after that it's up to the caller. On 64-bit architectures, * all struct values should be padded to 8-byte boundaries if they * contain an 8-byte member or a virtual function. */ class stack_alloc { private: std::vector blocks_; // storage for blocks, // may be bigger than cur_block_ std::vector sizes_; // could store initial & shift for others size_t cur_block_; // index into blocks_ for next alloc char* cur_block_end_; // ptr to cur_block_ptr_ + sizes_[cur_block_] char* next_loc_; // ptr to next available spot in cur // block // next three for keeping track of nested allocations on top of stack: std::vector nested_cur_blocks_; std::vector nested_next_locs_; std::vector nested_cur_block_ends_; /** * Moves us to the next block of memory, allocating that block * if necessary, and allocates len bytes of memory within that * block. * * @param size_t $len Number of bytes to allocate. * @return A pointer to the allocated memory. */ char* move_to_next_block(size_t len) { char* result; ++cur_block_; // Find the next block (if any) containing at least len bytes. while ((cur_block_ < blocks_.size()) && (sizes_[cur_block_] < len)) { ++cur_block_; } // Allocate a new block if necessary. if (unlikely(cur_block_ >= blocks_.size())) { // New block should be max(2*size of last block, len) bytes. size_t newsize = sizes_.back() * 2; if (newsize < len) { newsize = len; } blocks_.push_back(internal::eight_byte_aligned_malloc(newsize)); if (!blocks_.back()) { throw std::bad_alloc(); } sizes_.push_back(newsize); } result = blocks_[cur_block_]; // Get the object's state back in order. next_loc_ = result + len; cur_block_end_ = result + sizes_[cur_block_]; return result; } public: /** * Construct a resizable stack allocator initially holding the * specified number of bytes. * * @param initial_nbytes Initial number of bytes for the * allocator. Defaults to (1 << 16) = 64KB initial bytes. * @throws std::runtime_error if the underlying malloc is not 8-byte * aligned. */ explicit stack_alloc(size_t initial_nbytes = internal::DEFAULT_INITIAL_NBYTES) : blocks_(1, internal::eight_byte_aligned_malloc(initial_nbytes)), sizes_(1, initial_nbytes), cur_block_(0), cur_block_end_(blocks_[0] + initial_nbytes), next_loc_(blocks_[0]) { if (!blocks_[0]) { throw std::bad_alloc(); // no msg allowed in bad_alloc ctor } } /** * Destroy this memory allocator. * * This is implemented as a no-op as there is no destruction * required. */ ~stack_alloc() { // free ALL blocks for (auto& block : blocks_) { if (block) { free(block); } } } /** * Return a newly allocated block of memory of the appropriate * size managed by the stack allocator. * * The allocated pointer will be 8-byte aligned. * * This function may call C++'s malloc() function, * with any exceptions percolated throught this function. * * @param len Number of bytes to allocate. * @return A pointer to the allocated memory. */ inline void* alloc(size_t len) { // Typically, just return and increment the next location. char* result = next_loc_; next_loc_ += len; // Occasionally, we have to switch blocks. if (unlikely(next_loc_ >= cur_block_end_)) { result = move_to_next_block(len); } return reinterpret_cast(result); } /** * Allocate an array on the arena of the specified size to hold * values of the specified template parameter type. * * @tparam T type of entries in allocated array. * @param[in] n size of array to allocate. * @return new array allocated on the arena. */ template inline T* alloc_array(size_t n) { return static_cast(alloc(n * sizeof(T))); } /** * Recover all the memory used by the stack allocator. The stack * of memory blocks allocated so far will be available for further * allocations. To free memory back to the system, use the * function free_all(). */ inline void recover_all() { cur_block_ = 0; next_loc_ = blocks_[0]; cur_block_end_ = next_loc_ + sizes_[0]; } /** * Store current positions before doing nested operation so can * recover back to start. */ inline void start_nested() { nested_cur_blocks_.push_back(cur_block_); nested_next_locs_.push_back(next_loc_); nested_cur_block_ends_.push_back(cur_block_end_); } /** * recover memory back to the last start_nested call. */ inline void recover_nested() { if (unlikely(nested_cur_blocks_.empty())) { recover_all(); } cur_block_ = nested_cur_blocks_.back(); nested_cur_blocks_.pop_back(); next_loc_ = nested_next_locs_.back(); nested_next_locs_.pop_back(); cur_block_end_ = nested_cur_block_ends_.back(); nested_cur_block_ends_.pop_back(); } /** * Free all memory used by the stack allocator other than the * initial block allocation back to the system. Note: the * destructor will free all memory. */ inline void free_all() { // frees all BUT the first (index 0) block for (size_t i = 1; i < blocks_.size(); ++i) { if (blocks_[i]) { free(blocks_[i]); } } sizes_.resize(1); blocks_.resize(1); recover_all(); } /** * Return number of bytes allocated to this instance by the heap. * This is not the same as the number of bytes allocated through * calls to memalloc_. The latter number is not calculatable * because space is wasted at the end of blocks if the next * alloc request doesn't fit. (Perhaps we could trim down to * what is actually used?) * * @return number of bytes allocated to this instance */ inline size_t bytes_allocated() const { size_t sum = 0; for (size_t i = 0; i <= cur_block_; ++i) { sum += sizes_[i]; } return sum; } /** * Indicates whether the memory in the pointer * is in the stack. * * @param[in] ptr memory location * @return true if the pointer is in the stack, * false otherwise. */ inline bool in_stack(const void* ptr) const { for (size_t i = 0; i < cur_block_; ++i) { if (ptr >= blocks_[i] && ptr < blocks_[i] + sizes_[i]) { return true; } } if (ptr >= blocks_[cur_block_] && ptr < next_loc_) { return true; } return false; } }; } // namespace math } // namespace stan #endif StanHeaders/inst/include/stan/math/opencl/0000755000176200001440000000000013766554456020256 5ustar liggesusersStanHeaders/inst/include/stan/math/opencl/diagonal_multiply.hpp0000644000176200001440000000245713766554456024514 0ustar liggesusers#ifndef STAN_MATH_OPENCL_DIAGONAL_MULTIPLY_HPP #define STAN_MATH_OPENCL_DIAGONAL_MULTIPLY_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include namespace stan { namespace math { /** * Multiplies the diagonal of a matrix on the OpenCL device with the specified * scalar. * * @param A input matrix * @param scalar scalar * @return copy of the input matrix with the diagonal multiplied by scalar */ template > inline matrix_cl> diagonal_multiply( const matrix_cl& A, const T2 scalar) { matrix_cl> B(A); if (B.size() == 0) { return B; } // For rectangular matrices int min_dim = B.rows(); if (B.cols() < min_dim) { min_dim = B.cols(); } try { opencl_kernels::scalar_mul_diagonal(cl::NDRange(min_dim), B, scalar, B.rows(), min_dim); } catch (const cl::Error& e) { check_opencl_error("diagonal_multiply", e); } return B; } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/triangular_transpose.hpp0000644000176200001440000000366013766554456025242 0ustar liggesusers#ifndef STAN_MATH_OPENCL_TRIANGULAR_TRANSPOSE_HPP #define STAN_MATH_OPENCL_TRIANGULAR_TRANSPOSE_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Copies a lower/upper triangular of a matrix to it's upper/lower. * * @tparam triangular_map Specifies if the copy is * lower-to-upper or upper-to-lower triangular. The value * must be of type TriangularMap * * @throw std::invalid_argument if the matrix is not square. * */ template template inline void matrix_cl>::triangular_transpose() try { if (this->size() == 0 || this->size() == 1) { return; } check_size_match("triangular_transpose ((OpenCL))", "Expecting a square matrix; rows of ", "A", this->rows(), "columns of ", "A", this->cols()); cl::CommandQueue cmdQueue = opencl_context.queue(); opencl_kernels::triangular_transpose(cl::NDRange(this->rows(), this->cols()), *this, this->rows(), this->cols(), triangular_map); this->view_ = (triangular_map == TriangularMapCL::LowerToUpper && !contains_nonzero(this->view_, matrix_cl_view::Lower)) || (triangular_map == TriangularMapCL::UpperToLower && !contains_nonzero(this->view_, matrix_cl_view::Upper)) ? matrix_cl_view::Diagonal : matrix_cl_view::Entire; } catch (const cl::Error& e) { check_opencl_error("triangular_transpose", e); } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/buffer_types.hpp0000644000176200001440000000263713766554456023474 0ustar liggesusers#ifndef STAN_MATH_OPENCL_BUFFER_TYPES_HPP #define STAN_MATH_OPENCL_BUFFER_TYPES_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // An in_buffer signifies a cl::Buffer argument used as input. struct in_buffer {}; // An out_buffer signifies a cl::Buffer argument used as output. struct out_buffer {}; // An in_out_buffer signifies a cl::Buffer argument used as both input and // output. struct in_out_buffer {}; namespace internal { /** * meta template struct for changing read/write buffer argument types to * cl::Buffer types. * @tparam T A template typename that for cases of non-read/write buffers * will return a typedef holding only it's original type. For read and write * buffers this will return a cl::Buffer type. */ template struct to_buffer { using type = T; }; template <> struct to_buffer { using type = cl::Buffer; }; template <> struct to_buffer { using type = cl::Buffer; }; template <> struct to_buffer { using type = cl::Buffer; }; // Alias for making const cl::Buffer argument types template using to_const_buffer_t = const typename internal::to_buffer::type; } // namespace internal } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/copy.hpp0000644000176200001440000002446313766554456021752 0ustar liggesusers#ifndef STAN_MATH_OPENCL_COPY_HPP #define STAN_MATH_OPENCL_COPY_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Copies the source Eigen matrix to * the destination matrix that is stored * on the OpenCL device. * * @param src source Eigen matrix * @return matrix_cl with a copy of the data in the source matrix */ template , require_eigen_t...> inline matrix_cl to_matrix_cl(Mat&& src) { matrix_cl dst(src.rows(), src.cols()); if (src.size() == 0) { return dst; } try { cl::Event transfer_event; cl::CommandQueue& queue = opencl_context.queue(); queue.enqueueWriteBuffer( dst.buffer(), opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(Mat_scalar) * src.size(), src.eval().data(), nullptr, &transfer_event); dst.add_write_event(transfer_event); } catch (const cl::Error& e) { check_opencl_error("copy Eigen->(OpenCL)", e); } return dst; } /** * Copies the source std::vector to * the destination matrix that is stored * on the OpenCL device. * * @param src source std::vector * @return matrix_cl with a copy of the data in the source matrix */ template , require_std_vector_t...> inline matrix_cl to_matrix_cl(Vec&& src) { matrix_cl dst(src.size(), 1); if (src.size() == 0) { return dst; } try { cl::Event transfer_event; cl::CommandQueue& queue = opencl_context.queue(); queue.enqueueWriteBuffer( dst.buffer(), opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(Vec_scalar) * src.size(), src.data(), nullptr, &transfer_event); dst.add_write_event(transfer_event); } catch (const cl::Error& e) { check_opencl_error("copy Eigen->(OpenCL)", e); } return dst; } /** * Copies the source matrix that is stored * on the OpenCL device to the destination Eigen * matrix. * * @param src source matrix on the OpenCL device * @return Eigen matrix with a copy of the data in the source matrix */ template > inline Eigen::Matrix from_matrix_cl(const matrix_cl& src) { Eigen::Matrix dst(src.rows(), src.cols()); if (src.size() == 0) { return dst; } try { /** * Reads the contents of the OpenCL buffer * starting at the offset 0 to the Eigen * matrix * CL_TRUE denotes that the call is blocking * We do not want to pass data back to the CPU until all of the jobs * called on the source matrix are finished. */ cl::Event copy_event; const cl::CommandQueue queue = opencl_context.queue(); queue.enqueueReadBuffer(src.buffer(), opencl_context.in_order(), 0, sizeof(T) * dst.size(), dst.data(), &src.write_events(), ©_event); copy_event.wait(); src.clear_write_events(); } catch (const cl::Error& e) { check_opencl_error("copy (OpenCL)->Eigen", e); } return dst; } /** * Packs the flat triagnular matrix on the OpenCL device and * copies it to the std::vector. * * @param src the flat triangular source matrix on the OpenCL device * @return the packed std::vector * @throw std::invalid_argument if the matrix is not triangular */ template > inline std::vector packed_copy(const matrix_cl& src) { check_triangular("packed_copy", "src", src); const int packed_size = src.rows() * (src.rows() + 1) / 2; std::vector dst(packed_size); if (dst.size() == 0) { return dst; } try { const cl::CommandQueue queue = opencl_context.queue(); matrix_cl packed(packed_size, 1); stan::math::opencl_kernels::pack(cl::NDRange(src.rows(), src.rows()), packed, src, src.rows(), src.rows(), src.view()); const std::vector mat_events = vec_concat(packed.read_write_events(), src.write_events()); cl::Event copy_event; queue.enqueueReadBuffer(packed.buffer(), opencl_context.in_order(), 0, sizeof(T) * packed_size, dst.data(), &mat_events, ©_event); copy_event.wait(); src.clear_write_events(); } catch (const cl::Error& e) { check_opencl_error("packed_copy (OpenCL->std::vector)", e); } return dst; } /** * Copies the packed triangular matrix from * the source std::vector to an OpenCL buffer and * unpacks it to a flat matrix on the OpenCL device. * * @tparam matrix_view the triangularity of the source matrix * @param src the packed source std::vector * @param rows the number of rows in the flat matrix * @return the destination flat matrix on the OpenCL device * @throw std::invalid_argument if the * size of the vector does not match the expected size * for the packed triangular matrix */ template , require_std_vector_t...> inline matrix_cl packed_copy(Vec&& src, int rows) { const int packed_size = rows * (rows + 1) / 2; check_size_match("copy (packed std::vector -> OpenCL)", "src.size()", src.size(), "rows * (rows + 1) / 2", packed_size); matrix_cl dst(rows, rows, matrix_view); if (dst.size() == 0) { return dst; } try { matrix_cl packed(packed_size, 1); cl::Event packed_event; const cl::CommandQueue queue = opencl_context.queue(); queue.enqueueWriteBuffer( packed.buffer(), opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(Vec_scalar) * packed_size, src.data(), nullptr, &packed_event); packed.add_write_event(packed_event); stan::math::opencl_kernels::unpack(cl::NDRange(dst.rows(), dst.rows()), dst, packed, dst.rows(), dst.rows(), matrix_view); } catch (const cl::Error& e) { check_opencl_error("packed_copy (std::vector->OpenCL)", e); } return dst; } /** * Copies the source matrix to the * destination matrix. Both matrices * are stored on the OpenCL device. * * @param src source matrix * @return matrix_cl with copies of values in the source matrix * @throw std::invalid_argument if the * matrices do not have matching dimensions */ template > inline matrix_cl copy_cl(const matrix_cl& src) { matrix_cl dst(src.rows(), src.cols(), src.view()); if (src.size() == 0) { return dst; } try { /** * Copies the contents of the src buffer to the dst buffer * see the matrix_cl(matrix_cl&) constructor * for explanation */ cl::CommandQueue queue = opencl_context.queue(); const std::vector mat_events = vec_concat(dst.read_write_events(), src.write_events()); cl::Event copy_event; queue.enqueueCopyBuffer(src.buffer(), dst.buffer(), 0, 0, sizeof(T) * src.size(), &mat_events, ©_event); dst.add_write_event(copy_event); src.add_read_event(copy_event); } catch (const cl::Error& e) { check_opencl_error("copy_cl (OpenCL)->(OpenCL)", e); } return dst; } /** * Copy A 1 by 1 source matrix from the Device to the host. * @tparam T An arithmetic type to pass the value from the OpenCL matrix to. * @param src A 1x1 matrix on the device. * @return dst Arithmetic to receive the matrix_cl value. */ template > inline T from_matrix_cl_error_code(const matrix_cl& src) { T dst; check_size_match("copy_error_code ((OpenCL) -> (OpenCL))", "src.rows()", src.rows(), "dst.rows()", 1); check_size_match("copy_error_code ((OpenCL) -> (OpenCL))", "src.cols()", src.cols(), "dst.cols()", 1); try { cl::Event copy_event; const cl::CommandQueue queue = opencl_context.queue(); queue.enqueueReadBuffer(src.buffer(), opencl_context.in_order(), 0, sizeof(T), &dst, &src.write_events(), ©_event); copy_event.wait(); src.clear_write_events(); } catch (const cl::Error& e) { check_opencl_error("copy_error_code (OpenCL)->(OpenCL)", e); } return dst; } /** * Copy an arithmetic type to the device. * @tparam T An arithmetic type to pass the value from the OpenCL matrix to. * @param src Arithmetic to receive the matrix_cl value. * @return A 1x1 matrix on the device. */ template >> inline matrix_cl> to_matrix_cl(T&& src) { matrix_cl> dst(1, 1); check_size_match("to_matrix_cl ((OpenCL) -> (OpenCL))", "src.rows()", dst.rows(), "dst.rows()", 1); check_size_match("to_matrix_cl ((OpenCL) -> (OpenCL))", "src.cols()", dst.cols(), "dst.cols()", 1); try { cl::Event copy_event; const cl::CommandQueue queue = opencl_context.queue(); queue.enqueueWriteBuffer( dst.buffer(), opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(std::decay_t), &src, &dst.write_events(), ©_event); dst.add_write_event(copy_event); } catch (const cl::Error& e) { check_opencl_error("to_matrix_cl (OpenCL)->(OpenCL)", e); } return dst; } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/0000755000176200001440000000000013766554456021046 5ustar liggesusersStanHeaders/inst/include/stan/math/opencl/err/check_matching_dims.hpp0000644000176200001440000000231413766554456025522 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_MATCHING_DIMS_HPP #define STAN_MATH_OPENCL_ERR_CHECK_MATCHING_DIMS_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { /** * Check if two matrix_cls have the same dimensions. * * @param function Function name (for error messages) * @param name1 Variable name for the first matrix (for error messages) * @param y1 First matrix_cl * @param name2 Variable name for the second matrix (for error messages) * @param y2 Second matrix_cl * * @throw std::invalid_argument * if the dimensions of the matrices do not match */ template inline void check_matching_dims(const char* function, const char* name1, const matrix_cl& y1, const char* name2, const matrix_cl& y2) { check_size_match(function, "Rows of ", name1, y1.rows(), "rows of ", name2, y2.rows()); check_size_match(function, "Columns of ", name1, y1.cols(), "columns of ", name2, y2.cols()); } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_diagonal_zeros.hpp0000644000176200001440000000332713766554456025721 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_DIAGONAL_ZEROS_HPP #define STAN_MATH_OPENCL_ERR_CHECK_DIAGONAL_ZEROS_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include namespace stan { namespace math { /** * Check if the matrix_cl has zeros on the diagonal * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param y matrix_cl to test * * @throw std::domain_error if * any diagonal element of the matrix is zero. */ template > inline void check_diagonal_zeros(const char* function, const char* name, const matrix_cl& y) { if (y.size() == 0) { return; } cl::CommandQueue cmd_queue = opencl_context.queue(); cl::Context ctx = opencl_context.context(); try { int zero_on_diagonal_flag = 0; matrix_cl zeros_flag(1, 1); zeros_flag = to_matrix_cl(zero_on_diagonal_flag); opencl_kernels::check_diagonal_zeros(cl::NDRange(y.rows(), y.cols()), y, zeros_flag, y.rows(), y.cols()); zero_on_diagonal_flag = from_matrix_cl_error_code(zeros_flag); // if zeros were found on the diagonal if (zero_on_diagonal_flag) { domain_error(function, name, "has zeros on the diagonal.", ""); } } catch (const cl::Error& e) { check_opencl_error("diag_zeros_check", e); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_nan.hpp0000644000176200001440000000264313766554456023475 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_NAN_HPP #define STAN_MATH_OPENCL_ERR_CHECK_NAN_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include namespace stan { namespace math { /** * Check if the matrix_cl has NaN values * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param y matrix_cl to test * * @throw std::domain_error if * any element of the matrix is NaN. */ template > inline void check_nan(const char* function, const char* name, const matrix_cl& y) { if (y.size() == 0) { return; } try { int nan_flag = 0; matrix_cl nan_chk(1, 1); nan_chk = to_matrix_cl(nan_flag); opencl_kernels::check_nan(cl::NDRange(y.rows(), y.cols()), y, nan_chk, y.rows(), y.cols()); nan_flag = from_matrix_cl_error_code(nan_chk); if (nan_flag) { domain_error(function, name, "has NaN values", ""); } } catch (const cl::Error& e) { check_opencl_error("nan_check", e); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_vector.hpp0000644000176200001440000000254013766554456024217 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_VECTOR_HPP #define STAN_MATH_OPENCL_ERR_CHECK_VECTOR_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include namespace stan { namespace math { /** * Check if the matrix is either a row vector or column vector. * This function checks the runtime size of the matrix to check * whether it is a row or column vector. * @tparam T Scalar type of the matrix * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param x Matrix * @throw std::invalid_argument if x is not a row or column * vector. */ template inline void check_vector(const char* function, const char* name, const matrix_cl& x) { if (x.rows() == 1) { return; } if (x.cols() == 1) { return; } std::ostringstream msg; msg << ") has " << x.rows() << " rows and " << x.cols() << " columns but it should be a vector so it should " << "either have 1 row or 1 column"; std::string msg_str(msg.str()); invalid_argument(function, name, typename scalar_type::type(), "(", msg_str.c_str()); } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_symmetric.hpp0000644000176200001440000000325313766554456024733 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_SYMMETRIC_HPP #define STAN_MATH_OPENCL_ERR_CHECK_SYMMETRIC_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Check if the matrix_cl is symmetric * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param y matrix_cl to test * * @throw std::domain_error if * the matrix is not symmetric. */ template > inline void check_symmetric(const char* function, const char* name, const matrix_cl& y) { if (y.size() == 0) { return; } check_square(function, name, y); try { int symmetric_flag = 1; matrix_cl symm_flag(1, 1); symm_flag = to_matrix_cl(symmetric_flag); opencl_kernels::check_symmetric(cl::NDRange(y.rows(), y.cols()), y, symm_flag, y.rows(), y.cols(), math::CONSTRAINT_TOLERANCE); symmetric_flag = from_matrix_cl_error_code(symm_flag); if (!symmetric_flag) { domain_error(function, name, "is not symmetric", ""); } } catch (const cl::Error& e) { check_opencl_error("symmetric_check", e); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_invalid_matrix_view.hpp0000644000176200001440000000207413766554456026763 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_INVALID_MATRIX_VIEW_HPP #define STAN_MATH_OPENCL_ERR_CHECK_INVALID_MATRIX_VIEW_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { /** * Check if the matrix_cl has an invalid view. * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param A matrix_cl to test * @param invalid_view the view that is not allowed * * @throw std::domain_error if the matrix_cl * size is not 1 */ template inline void check_invalid_matrix_view(const char* function, const char* name, const matrix_cl& A, const matrix_cl_view invalid_view) { if (A.view() == invalid_view) { invalid_argument(function, name, " has an invalid view.", ""); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_opencl.hpp0000644000176200001440000002261513766554456024202 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_OPENCL_HPP #define STAN_MATH_OPENCL_ERR_CHECK_OPENCL_HPP #ifdef STAN_OPENCL #include #include #include #include #include /** @file stan/math/opencl/err/check_opencl.hpp * @brief checking OpenCL error numbers */ namespace stan { namespace math { /** * Throws the domain error with specifying the OpenCL error that * occured. It outputs the OpenCL errors that are specified * in OpenCL 2.0. If no matching error number is found, * it throws the error with the number. * @param function the name of the function where the error occurred * @param e The error number */ inline void check_opencl_error(const char *function, const cl::Error &e) { switch (e.err()) { case 0: // CL_SUCCESS - no need to throw return; case -1: system_error(function, e.what(), e.err(), "CL_DEVICE_NOT_FOUND"); case -2: system_error(function, e.what(), e.err(), "CL_DEVICE_NOT_AVAILABLE"); case -3: system_error(function, e.what(), e.err(), "CL_COMPILER_NOT_AVAILABLE"); case -4: system_error(function, e.what(), e.err(), "CL_MEM_OBJECT_ALLOCATION_FAILURE"); case -5: system_error(function, e.what(), e.err(), "CL_OUT_OF_RESOURCES"); case -6: system_error(function, e.what(), e.err(), "CL_OUT_OF_HOST_MEMORY"); case -7: system_error(function, e.what(), e.err(), "CL_PROFILING_INFO_NOT_AVAILABLE"); case -8: system_error(function, e.what(), e.err(), "CL_MEM_COPY_OVERLAP"); case -9: system_error(function, e.what(), e.err(), "CL_IMAGE_FORMAT_MISMATCH"); case -10: system_error(function, e.what(), e.err(), "CL_IMAGE_FORMAT_NOT_SUPPORTED"); case -11: system_error(function, e.what(), e.err(), "CL_BUILD_PROGRAM_FAILURE"); case -12: system_error(function, e.what(), e.err(), "CL_MAP_FAILURE"); case -13: system_error(function, e.what(), e.err(), "CL_MISALIGNED_SUB_BUFFER_OFFSET"); case -14: system_error(function, e.what(), e.err(), "CL_EXEC_STATUS_ERROR_FOR_EVENTS_IN_WAIT_LIST"); case -15: system_error(function, e.what(), e.err(), "CL_COMPILE_PROGRAM_FAILURE"); case -16: system_error(function, e.what(), e.err(), "CL_LINKER_NOT_AVAILABLE"); case -17: system_error(function, e.what(), e.err(), "CL_LINK_PROGRAM_FAILURE"); case -18: system_error(function, e.what(), e.err(), "CL_DEVICE_PARTITION_FAILED"); case -19: system_error(function, e.what(), e.err(), "CL_KERNEL_ARG_INFO_NOT_AVAILABLE"); case -30: system_error(function, e.what(), e.err(), "CL_INVALID_VALUE"); case -31: system_error(function, e.what(), e.err(), "CL_INVALID_DEVICE_TYPE"); case -32: system_error(function, e.what(), e.err(), "CL_INVALID_PLATFORM"); case -33: system_error(function, e.what(), e.err(), "CL_INVALID_DEVICE"); case -34: system_error(function, e.what(), e.err(), "CL_INVALID_CONTEXT"); case -35: system_error(function, e.what(), e.err(), "CL_INVALID_QUEUE_PROPERTIES"); case -36: system_error(function, e.what(), e.err(), "CL_INVALID_COMMAND_QUEUE"); case -37: system_error(function, e.what(), e.err(), "CL_INVALID_HOST_PTR"); case -38: system_error(function, e.what(), e.err(), "CL_INVALID_MEM_OBJECT"); case -39: system_error(function, e.what(), e.err(), "CL_INVALID_IMAGE_FORMAT_DESCRIPTOR"); case -40: system_error(function, e.what(), e.err(), "CL_INVALID_IMAGE_SIZE"); case -41: system_error(function, e.what(), e.err(), "CL_INVALID_SAMPLER"); case -42: system_error(function, e.what(), e.err(), "CL_INVALID_BINARY"); case -43: system_error(function, e.what(), e.err(), "CL_INVALID_BUILD_OPTIONS"); case -44: system_error(function, e.what(), e.err(), "CL_INVALID_PROGRAM"); case -45: system_error(function, e.what(), e.err(), "CL_INVALID_PROGRAM_EXECUTABLE"); case -46: system_error(function, e.what(), e.err(), "CL_INVALID_KERNEL_NAME"); case -47: system_error(function, e.what(), e.err(), "CL_INVALID_KERNEL_DEFINITION"); case -48: system_error(function, e.what(), e.err(), "CL_INVALID_KERNEL"); case -49: system_error(function, e.what(), e.err(), "CL_INVALID_ARG_INDEX"); case -50: system_error(function, e.what(), e.err(), "CL_INVALID_ARG_VALUE"); case -51: system_error(function, e.what(), e.err(), "CL_INVALID_ARG_SIZE"); case -52: system_error(function, e.what(), e.err(), "CL_INVALID_KERNEL_ARGS"); case -53: system_error(function, e.what(), e.err(), "CL_INVALID_WORK_DIMENSION"); case -54: system_error(function, e.what(), e.err(), "CL_INVALID_WORK_GROUP_SIZE"); case -55: system_error(function, e.what(), e.err(), "CL_INVALID_WORK_ITEM_SIZE"); case -56: system_error(function, e.what(), e.err(), "CL_INVALID_GLOBAL_OFFSET"); case -57: system_error(function, e.what(), e.err(), "CL_INVALID_EVENT_WAIT_LIST"); case -58: system_error(function, e.what(), e.err(), "CL_INVALID_EVENT"); case -59: system_error(function, e.what(), e.err(), "CL_INVALID_OPERATION"); case -60: system_error(function, e.what(), e.err(), "CL_INVALID_GL_OBJECT"); case -61: system_error(function, e.what(), e.err(), "CL_INVALID_BUFFER_SIZE"); case -62: system_error(function, e.what(), e.err(), "CL_INVALID_MIP_LEVEL"); case -63: system_error(function, e.what(), e.err(), "CL_INVALID_GLOBAL_WORK_SIZE"); case -64: system_error(function, e.what(), e.err(), "CL_INVALID_PROPERTY"); case -65: system_error(function, e.what(), e.err(), "CL_INVALID_IMAGE_DESCRIPTOR"); case -66: system_error(function, e.what(), e.err(), "CL_INVALID_COMPILER_OPTIONS"); case -67: system_error(function, e.what(), e.err(), "CL_INVALID_LINKER_OPTIONS"); case -68: system_error(function, e.what(), e.err(), "CL_INVALID_DEVICE_PARTITION_COUNT"); case -69: system_error(function, e.what(), e.err(), "CL_INVALID_PIPE_SIZE"); case -70: system_error(function, e.what(), e.err(), "CL_INVALID_DEVICE_QUEUE"); case -1000: system_error(function, e.what(), e.err(), "CL_INVALID_GL_SHAREGROUP_REFERENCE_KHR"); case -1001: system_error(function, e.what(), e.err(), "CL_PLATFORM_NOT_FOUND_KHR"); case -1002: system_error(function, e.what(), e.err(), "CL_INVALID_D3D10_DEVICE_KHR"); case -1003: system_error(function, e.what(), e.err(), "CL_INVALID_D3D10_RESOURCE_KHR"); case -1004: system_error(function, e.what(), e.err(), "CL_D3D10_RESOURCE_ALREADY_ACQUIRED_KHR"); case -1005: system_error(function, e.what(), e.err(), "CL_D3D10_RESOURCE_NOT_ACQUIRED_KHR"); case -1006: system_error(function, e.what(), e.err(), "CL_INVALID_D3D11_DEVICE_KHR"); case -1007: system_error(function, e.what(), e.err(), "CL_INVALID_D3D11_RESOURCE_KHR"); case -1008: system_error(function, e.what(), e.err(), "CL_D3D11_RESOURCE_ALREADY_ACQUIRED_KHR"); case -1009: system_error(function, e.what(), e.err(), "CL_D3D11_RESOURCE_NOT_ACQUIRED_KHR"); case -101: system_error(function, e.what(), e.err(), "CL_INVALID_D3D9_DEVICE_NV "); case -1011: system_error(function, e.what(), e.err(), "CL_INVALID_D3D9_RESOURCE_NV "); case -1012: system_error(function, e.what(), e.err(), "CL_D3D9_RESOURCE_ALREADY_ACQUIRED_NV " "CL_DX9_RESOURCE_ALREADY_ACQUIRED_INTEL"); case -1013: system_error(function, e.what(), e.err(), "CL_D3D9_RESOURCE_NOT_ACQUIRED_NV " "CL_DX9_RESOURCE_NOT_ACQUIRED_INTEL"); case -1092: system_error(function, e.what(), e.err(), "CL_EGL_RESOURCE_NOT_ACQUIRED_KHR"); case -1093: system_error(function, e.what(), e.err(), "CL_INVALID_EGL_OBJECT_KHR"); case -1094: system_error(function, e.what(), e.err(), "CL_INVALID_ACCELERATOR_INTEL"); case -1095: system_error(function, e.what(), e.err(), "CL_INVALID_ACCELERATOR_TYPE_INTEL"); case -1096: system_error(function, e.what(), e.err(), "CL_INVALID_ACCELERATOR_DESCRIPTOR_INTEL"); case -1097: system_error(function, e.what(), e.err(), "CL_ACCELERATOR_TYPE_NOT_SUPPORTED_INTEL"); case -1098: system_error(function, e.what(), e.err(), "CL_INVALID_VA_API_MEDIA_ADAPTER_INTEL"); case -1099: system_error(function, e.what(), e.err(), "CL_INVALID_VA_API_MEDIA_SURFACE_INTEL"); case -1100: system_error(function, e.what(), e.err(), "CL_VA_API_MEDIA_SURFACE_ALREADY_ACQUIRED_INTEL"); case -1101: system_error(function, e.what(), e.err(), "CL_VA_API_MEDIA_SURFACE_NOT_ACQUIRED_INTEL"); case -9999: system_error(function, e.what(), e.err(), "ILLEGAL_READ_OR_WRITE_NVIDIA"); default: system_error(function, e.what(), e.err(), std::to_string(e.err()).c_str()); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_mat_size_one.hpp0000644000176200001440000000277713766554456025405 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_MAT_SIZE_ONE_HPP #define STAN_MATH_OPENCL_ERR_CHECK_MAT_SIZE_ONE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { /** * Check if the matrix_cl has a single element. * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param A matrix_cl to test * * @throw std::domain_error if the matrix_cl * size is not 1 */ template inline void check_mat_size_one(const char* function, const char* name, const matrix_cl& A) { if (A.size() != 1) { invalid_argument(function, name, "should have exactly one element.", ""); } } /** * Check if the matrix_cl has a single element. * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param A matrix_cl to test * * @throw std::domain_error if the matrix_cl * size is not 1 */ template inline void check_mat_not_size_one(const char* function, const char* name, const matrix_cl& A) { if (A.size() == 1) { invalid_argument(function, name, "should not have exactly one element.", ""); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_square.hpp0000644000176200001440000000156113766554456024217 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_SQUARE_HPP #define STAN_MATH_OPENCL_ERR_CHECK_SQUARE_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { /** * Check if the matrix_cl is square. * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param y matrix_cl to test * * @throw std::invalid_argument if the matrix_cl * is not square */ template inline void check_square(const char* function, const char* name, const matrix_cl& y) { check_size_match(function, "Expecting a square matrix; rows of ", name, y.rows(), "columns of ", name, y.cols()); } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/err/check_triangular.hpp0000644000176200001440000000214513766554456025066 0ustar liggesusers#ifndef STAN_MATH_OPENCL_ERR_CHECK_TRIANGULAR_HPP #define STAN_MATH_OPENCL_ERR_CHECK_TRIANGULAR_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { /** * Check if the matrix_cl is either upper triangular or lower * triangular. * * @param function Function name (for error messages) * @param name Variable name (for error messages) * @param A matrix_cl to test * * @throw std::invalid_argument if the matrix_cl * is not triangular */ template inline void check_triangular(const char* function, const char* name, const matrix_cl& A) { if (A.view() != matrix_cl_view::Lower && A.view() != matrix_cl_view::Upper) { invalid_argument("tri_inverse(OpenCL)", "A.view()", static_cast(A.view()), "is ", ". Only triangular input matrices are supported!"); } } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/scalar_type.hpp0000644000176200001440000000061313766554456023275 0ustar liggesusers#ifndef STAN_MATH_OPENCL_SCALAR_TYPE_HPP #define STAN_MATH_OPENCL_SCALAR_TYPE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { template struct scalar_type> { using type = typename scalar_type::type; }; } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/multiply_transpose.hpp0000644000176200001440000000350113766554456024743 0ustar liggesusers#ifndef STAN_MATH_OPENCL_MULTIPLY_TRANSPOSE_HPP #define STAN_MATH_OPENCL_MULTIPLY_TRANSPOSE_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include namespace stan { namespace math { /** * Computes the product of a square OpenCL matrix with its transpose. * * Computes the matrix multiplication C = A x A^T * * @param A input matrix * @return the product of the input matrix and its transpose * */ template > inline matrix_cl multiply_transpose(const matrix_cl& A) { matrix_cl temp(A.rows(), A.rows(), A.view() == matrix_cl_view::Diagonal ? matrix_cl_view::Diagonal : matrix_cl_view::Entire); if (A.size() == 0) { return temp; } // padding the matrices so the dimensions are divisible with local // improves performance becasuse we can omit if statements in the // multiply kernel int local = opencl_kernels::multiply_transpose.make_functor.get_opts().at( "THREAD_BLOCK_SIZE"); int Mpad = ((A.rows() + local - 1) / local) * local; int wpt = opencl_kernels::multiply_transpose.make_functor.get_opts().at( "WORK_PER_THREAD"); try { opencl_kernels::multiply_transpose(cl::NDRange(Mpad, Mpad / wpt), cl::NDRange(local, local / wpt), A, temp, A.rows(), A.cols()); } catch (cl::Error& e) { check_opencl_error("multiply self transpose", e); } return temp; } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernel_cl.hpp0000644000176200001440000002646513766554456022742 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNEL_CL_HPP #define STAN_MATH_OPENCL_KERNEL_CL_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { namespace internal { /** * Extracts the kernel's arguments, used in the global and local kernel * constructor. * @tparam For this general template the function will return back the * value passed in. * @param t The type that will be returned. * @return the input t. */ template inline const T& get_kernel_args(const T& t) { return t; } /** * Extracts the kernel's arguments, used in the global and local kernel * constructor. * @tparam K The type of the \c matrix_cl. * @param m The \c matrix with an OpenCL Buffer. * @return The OpenCL Buffer. */ template inline const cl::Buffer& get_kernel_args(const stan::math::matrix_cl& m) { return m.buffer(); } /** * Helper function for assigning events to a \c matrix_cl. * * @tparam T Whether the assignment is to an \c in_buffer, \c out_buffer, or \c * in_out_buffer. * @tparam K The type of the \c matrix_cl. * */ template struct assign_event_helper { /** * Assigns the event to the \c matrix_cl. * @param e the event to be assigned. * @param m The \c matrix_cl to be assigned to. */ inline void set(const cl::Event& e, const stan::math::matrix_cl& m) {} }; // Specialization for \c in_buffer template struct assign_event_helper { inline void set(const cl::Event& e, const stan::math::matrix_cl& m) { m.add_read_event(e); } }; // Specialization for \c out_buffer template struct assign_event_helper { inline void set(const cl::Event& e, const stan::math::matrix_cl& m) { m.add_write_event(e); } }; // Specialization for \c in_out_buffer template struct assign_event_helper { inline void set(const cl::Event& e, const stan::math::matrix_cl& m) { m.add_read_write_event(e); } }; /** * Assigns the event to a \c matrix_cl. * @tparam T The type to be assigned, if not a matrix_cl this function * will do nothing. * @tparam K The type of the \c matrix_cl. * @param e The event to be assigned. */ template inline void assign_event(const cl::Event& e, const T&) {} /** * Assigns the event to a \c matrix_cl * @tparam T The type to be assigned, if not a matrix_cl will do nothing. * @tparam K The type of the \c matrix_cl. * @param e The event to be assigned. * @param m The \c matrix_cl to be assigned */ template inline void assign_event(const cl::Event& e, const stan::math::matrix_cl& m) { assign_event_helper helper; helper.set(e, m); } template ...> inline void assign_events(const T&) {} /** * Adds the event to any \c matrix_cls in the arguments depending on whether * they are \c in_buffer, \c out_buffer, or \c in_out_buffers. * @tparam Arg Arguments given during kernel creation that specify the kernel * signature. * @tparam Args Arguments given during kernel creation that specify the kernel * signature. * @tparam CallArg First argument type used to call the kernel * @tparam CallArgs Other argument types used to call the kernel. * @param new_event The cl::Event generated involving the arguments. * @param m Arguments to the kernel that may be \c matrix_cls or not. * Non-matrices are ignored. * @param args Arguments to the kernel that may be matrices or not. * Non-matrices are ignored. */ template inline void assign_events(const cl::Event& new_event, CallArg& m, CallArgs&... args) { assign_event(new_event, m); assign_events(new_event, args...); } /** * Helper function to select OpenCL event vectors from an \c matrix_cl * @tparam T For non \c matrix_cl types, the type of the first argument. * Otherwise this is the in/out/inout buffer type. * @tparam K For \c matrix_cl types, the type of the matrix_cl */ template struct select_event_helper { /** * Get the events from a matrix_cl. For non \c matrix_cl types this will do * nothing. * @param m A type to extract the event from. */ inline const std::vector get(const T& m) { return std::vector(); } }; // Specialization for in_buffer template struct select_event_helper { inline const std::vector get(const stan::math::matrix_cl& m) { return m.write_events(); } }; // Specialization for out_buffer template struct select_event_helper { inline const std::vector get(const stan::math::matrix_cl& m) { return m.read_events(); } }; // Specialization for in_out_buffer template struct select_event_helper { inline const std::vector get(const stan::math::matrix_cl& m) { return m.read_write_events(); } }; /** * Select events from kernel arguments. Does nothing for non \c matrix_cl types. * @tparam T The argument type for a non \c matrix_cl, else the in/out/in_out * buffer types. * @tparam K The type of the \c matrix_cl * @param m If an \c matrix_cl, gets the event vector, else this argument does * nothing. * @return A vector of OpenCL events. */ template inline const std::vector select_events(const T& m) { select_event_helper helper; return helper.get(m); } // Specialization for \c matrix_cl template inline const std::vector select_events( const stan::math::matrix_cl& m) { select_event_helper helper; return helper.get(m); } } // namespace internal /** * Compile an OpenCL kernel. * * @param name The name for the kernel * @param sources A std::vector of strings containing the code for the kernel. * @param options The values of macros to be passed at compile time. */ inline auto compile_kernel(const char* name, const std::vector& sources, std::map& options) { std::string kernel_opts = ""; for (auto&& comp_opts : options) { kernel_opts += std::string(" -D") + comp_opts.first + "=" + std::to_string(comp_opts.second); } cl::Program program(opencl_context.context(), sources); try { program.build({opencl_context.device()}, kernel_opts.c_str()); return cl::Kernel(program, name); } catch (const cl::Error& e) { // in case of CL_BUILD_PROGRAM_FAILURE, print the build error if (e.err() == -11) { std::string buildlog = program.getBuildInfo( opencl_context.device()[0]); system_error("compile_kernel", name, e.err(), buildlog.c_str()); } else { check_opencl_error(name, e); } } return cl::Kernel(); // never reached because check_opencl_error throws } /** * Functor used for compiling kernels. * * @tparam Args Parameter pack of all kernel argument types. */ template class kernel_functor { private: cl::Kernel kernel_; std::map opts_; public: /** * functor to access the kernel compiler. * @param name The name for the kernel. * @param sources A std::vector of strings containing the code for the kernel. * @param options The values of macros to be passed at compile time. */ kernel_functor(const char* name, const std::vector& sources, const std::map& options) { auto base_opts = opencl_context.base_opts(); for (auto& it : options) { if (base_opts[it.first] > it.second) { base_opts[it.first] = it.second; } } kernel_ = compile_kernel(name, sources, base_opts); opts_ = base_opts; } auto operator()() const { return cl::KernelFunctor(kernel_); } /** * @return The options that the kernel was compiled with. */ inline const std::map& get_opts() const { return opts_; } }; /** * Creates functor for kernels * * @tparam Args Parameter pack of all kernel argument types. */ template struct kernel_cl { const kernel_functor&...> make_functor; /** * Creates functor for kernels that only need access to defining * the global work size. * @param name The name for the kernel * @param sources A std::vector of strings containing the code for the kernel. * @param options The values of macros to be passed at compile time. */ kernel_cl(const char* name, const std::vector& sources, const std::map& options = {}) : make_functor(name, sources, options) {} /** * Executes a kernel * @tparam CallArgs The types of the callee arguments. * @tparam Args Parameter pack of all kernel argument types. * @param global_thread_size The global work size. * @param args The arguments to pass to the kernel. * @return An Opencl event. */ template auto operator()(cl::NDRange global_thread_size, const CallArgs&... args) const { auto f = make_functor(); const std::vector kernel_events = vec_concat(internal::select_events(args)...); cl::EnqueueArgs eargs(opencl_context.queue(), kernel_events, global_thread_size); cl::Event kern_event = f(eargs, internal::get_kernel_args(args)...); internal::assign_events(kern_event, args...); return kern_event; } /** * Executes a kernel * @tparam CallArgs The types of the callee arguments. * @tparam Args Parameter pack of all kernel argument types. * @param global_thread_size The global work size. * @param thread_block_size The thread block size. * @param args The arguments to pass to the kernel. * @return An Opencl event. */ template auto operator()(cl::NDRange global_thread_size, cl::NDRange thread_block_size, const CallArgs&... args) const { auto f = make_functor(); const std::vector kernel_events = vec_concat(internal::select_events(args)...); cl::EnqueueArgs eargs(opencl_context.queue(), kernel_events, global_thread_size, thread_block_size); cl::Event kern_event = f(eargs, internal::get_kernel_args(args)...); internal::assign_events(kern_event, args...); return kern_event; } /** * Retrieves an option used for compiling the kernel. * @param option_name which option to retrieve * @return option value */ int get_option(const std::string option_name) const { return make_functor.get_opts().at(option_name); } }; } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/0000755000176200001440000000000013766554456021721 5ustar liggesusersStanHeaders/inst/include/stan/math/opencl/kernels/add.hpp0000644000176200001440000000667513766554456023200 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_ADD_HPP #define STAN_MATH_OPENCL_KERNELS_ADD_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string add_kernel_code = STRINGIFY( // \endcond /** * Matrix addition on the OpenCL device * * @param[out] C Output matrix. * @param[in] A LHS of matrix addition. * @param[in] B RHS of matrix addition. * @param rows Number of rows for matrix A. * @param cols Number of cols for matrix A. * @param view_A triangular part of matrix A to use * @param view_B triangular part of matrix B to use * @note Code is a const char* held in * add_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void add(__global double *C, __global double *A, __global double *B, unsigned int rows, unsigned int cols, int view_A, int view_B) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < rows && j < cols) { double a; if ((!contains_nonzero(view_A, LOWER) && j < i) || (!contains_nonzero(view_A, UPPER) && j > i)) { a = 0; } else { a = A(i, j); } double b; if ((!contains_nonzero(view_B, LOWER) && j < i) || (!contains_nonzero(view_B, UPPER) && j > i)) { b = 0; } else { b = B(i, j); } C(i, j) = a + b; } } // \cond ); // \endcond /** * See the docs for \link kernels/add.hpp add() \endlink */ const kernel_cl add("add", {indexing_helpers, view_kernel_helpers, add_kernel_code}); // \cond static const std::string add_batch_kernel_code = STRINGIFY( // \endcond /** * Sums a batch of matrices. Buffer A contains * batch_size matrices of size rows x cols. All elements * at matching indices are summed up and stored to the * resulting matrix B. * * @param[out] B buffer of the result matrix. * @param[in] A buffer containing the entire batch. * @param rows Number of rows for a single matrix in the batch. * @param cols Number of cols for a single matrix in the batch. * @param batch_size Number of matrices in the batch. * @note Code is a const char* held in * add_batch_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void add_batch(__global double *B, __global double *A, unsigned int rows, unsigned int cols, unsigned int batch_size) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < rows && j < cols) { double temp = 0.0; for (int k = 0; k < batch_size; k++) { temp += A_batch(i, j, k); } B(i, j) = temp; } } // \cond ); // \endcond /** * See the docs for \link kernels/add.hpp add_batch() \endlink */ const kernel_cl add_batch( "add_batch", {indexing_helpers, add_batch_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/check_diagonal_zeros.hpp0000644000176200001440000000310613766554456026567 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_CHECK_DIAGONAL_ZEROS_HPP #define STAN_MATH_OPENCL_KERNELS_CHECK_DIAGONAL_ZEROS_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string is_zero_on_diagonal_kernel_code = STRINGIFY( // \endcond /** * Check if the matrix_cl has zeros on the diagonal * * @param[in] A Matrix to check. * @param[out] flag the flag to be written to if any diagonal is zero. * @param rows The number of rows for A. * @param cols The number of cols of A. * @note Code is a const char* held in * is_zero_on_diagonal_kernel_code. * Kernel for stan/math/opencl/err/check_diagonal_zeros.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void is_zero_on_diagonal(__global double *A, __global int *flag, unsigned int rows, unsigned int cols) { const int i = get_global_id(0); if (i < rows && i < cols) { if (A(i, i) == 0) { flag[0] = 1; } } } // \cond ); // \endcond /** * See the docs for \link kernels/check_diagonal_zeros.hpp * check_diagonal_zeros() \endlink */ const kernel_cl check_diagonal_zeros( "is_zero_on_diagonal", {indexing_helpers, is_zero_on_diagonal_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/transpose.hpp0000644000176200001440000000261713766554456024456 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_TRANSPOSE_HPP #define STAN_MATH_OPENCL_KERNELS_TRANSPOSE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string transpose_kernel_code = STRINGIFY( // \endcond /** * Takes the transpose of the matrix on the OpenCL device. * * @param[out] B The output matrix to hold transpose of A. * @param[in] A The input matrix to transpose into B. * @param rows The number of rows for A. * @param cols The number of columns for A. * @note Code is a const char* held in * transpose_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void transpose(__global double *B, __global double *A, unsigned int rows, unsigned int cols) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { BT(j, i) = A(i, j); } } // \cond ); // \endcond /** * See the docs for \link kernels/transpose.hpp transpose() \endlink */ const kernel_cl transpose( "transpose", {indexing_helpers, transpose_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/helpers.hpp0000644000176200001440000000235413766554456024100 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_HELPERS_HPP #define STAN_MATH_OPENCL_KERNELS_HELPERS_HPP #ifdef STAN_OPENCL #include namespace stan { namespace math { namespace opencl_kernels { /* * Defines helper macros for common matrix indexing operations */ static const std::string indexing_helpers = R"( // Matrix access helpers #ifndef A_batch #define A_batch(i,j,k) A[(k) * cols * rows + (j) * rows + (i)] #endif #ifndef A #define A(i,j) A[(j) * rows + (i)] #endif #ifndef B #define B(i,j) B[(j) * rows + (i)] #endif #ifndef C #define C(i,j) C[(j) * rows + (i)] #endif // Transpose #ifndef BT #define BT(i,j) B[(j) * cols + (i)] #endif #ifndef AT #define AT(i,j) A[(j) * cols + (i)] #endif // Moving between two buffers #ifndef src #define src(i,j) src[(j) * src_rows + (i)] #endif #ifndef dst #define dst(i,j) dst[(j) * dst_rows + (i)] #endif )"; /* * Defines a helper macro for kernels with 2D local size */ static const std::string thread_block_helpers = R"( // The local memory column for each thread block #define THREAD_BLOCK_SIZE_COL (THREAD_BLOCK_SIZE/WORK_PER_THREAD) )"; } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/triangular_transpose.hpp0000644000176200001440000000354013766554456026702 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_TRIANGULAR_TRANSPOSE_HPP #define STAN_MATH_OPENCL_KERNELS_TRIANGULAR_TRANSPOSE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string triangular_transpose_kernel_code = STRINGIFY( // \endcond /** * Copies a lower/upper triangular of a matrix to it's upper/lower. * * @param[in,out] A The matrix. * @param rows The number of rows in A. * @param cols The number of cols in A. * @param copy_direction A value of zero or one specifying * which direction to copy * LOWER_TO_UPPER: 1 * UPPER_TO_LOWER: 0 * @note Code is a const char* held in * triangular_transpose_kernel_code. * Used in mat/opencl/triangular_transpose.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void triangular_transpose(__global double* A, unsigned int rows, unsigned int cols, unsigned int copy_direction) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { if (copy_direction == LOWER_TO_UPPER && i > j) { A(j, i) = A(i, j); } else if (copy_direction == UPPER_TO_LOWER && i > j) { A(i, j) = A(j, i); } } } // \cond ); // \endcond /** * See the docs for \link kernels/triangular_transpose.hpp * triangular_transpose() \endlink */ const kernel_cl triangular_transpose( "triangular_transpose", {indexing_helpers, triangular_transpose_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/check_nan.hpp0000644000176200001440000000274313766554456024351 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_CHECK_NAN_HPP #define STAN_MATH_OPENCL_KERNELS_CHECK_NAN_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string is_nan_kernel_code = STRINGIFY( // \endcond /** * Check if the matrix_cl has NaN values * * @param[in] A The matrix to check. * @param rows The number of rows in matrix A. * @param cols The number of columns in matrix A. * @param[out] flag the flag to be written to if any diagonal is zero. * @note Code is a const char* held in * is_nan_kernel_code. * Kernel for stan/math/opencl/err/check_nan.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void is_nan(__global double *A, __global int *flag, unsigned int rows, unsigned int cols) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < rows && j < cols) { if (isnan(A(i, j))) { flag[0] = 1; } } } // \cond ); // \endcond /** * See the docs for \link kernels/check_nan.hpp is_nan() \endlink */ const kernel_cl check_nan( "is_nan", {indexing_helpers, is_nan_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/neg_rect_lower_tri_multiply.hpp0000644000176200001440000001273713766554456030257 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_NEGATIVE_RECT_LOWER_TRI_MULTIPLY_HPP #define STAN_MATH_OPENCL_KERNELS_NEGATIVE_RECT_LOWER_TRI_MULTIPLY_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string neg_rect_lower_tri_multiply_kernel_code = STRINGIFY( // \endcond /** * Calculates C = -B * A where B is rectangular and A is a lower * triangular. * For a full guide to the inverse lower triangular kernels see the link * here. * * ![Inverse Calculation](https://goo.gl/6jBjEG) * * Graphically, this kernel calculates `-temp * C1` where temp is the * C2 * A3 calculation from * \link kernels/inv_lower_tri_multiply.hpp inv_lower_tri_multiply() \endlink * The kernel is executed using (N, N, m) threads, where N is the size of * the input matrices. * @param[in, out] A Input matrix that is being inverted. * @param[in] temp Temporary matrix with the intermediate results. * @param A_rows Number of rows for A. * @param rows The number of rows in a single matrix of the batch * @note Code is a const char* held in * neg_rect_lower_tri_multiply_kernel_code * Used in math/opencl/tri_inverse.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void neg_rect_lower_tri_multiply( __global double* A, const __global double* temp, const int A_rows, const int rows) { int result_matrix_id = get_global_id(2); int offset = result_matrix_id * rows * 2; const int thread_block_row = get_local_id(0); const int thread_block_col = get_local_id(1); const int i = THREAD_BLOCK_SIZE * get_group_id(0) + thread_block_row; const int j = THREAD_BLOCK_SIZE * get_group_id(1) + thread_block_col; __local double temp_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; __local double C1_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; double acc[WORK_PER_THREAD] = {0}; const int num_tiles = (rows + THREAD_BLOCK_SIZE - 1) / THREAD_BLOCK_SIZE; for (int tile_ind = 0; tile_ind < num_tiles; tile_ind++) { // each thread copies WORK_PER_THREAD values to the local // memory for (int w = 0; w < WORK_PER_THREAD; w++) { const int tiled_i = THREAD_BLOCK_SIZE * tile_ind + thread_block_row; const int tiled_j = THREAD_BLOCK_SIZE * tile_ind + thread_block_col; const int temp_global_col = tiled_j + w * THREAD_BLOCK_SIZE_COL; // {C2}{A2}_global_{col}{row} specifies which global element for each // matrix the thread is in charge of moving to local memory. const int C1_global_col = offset + j + w * THREAD_BLOCK_SIZE_COL; const int C1_global_row = tiled_i + offset; // Which {col}{row} location in the local memory the thread is in // charge of. const int local_col = thread_block_col + w * THREAD_BLOCK_SIZE_COL; const int local_row = thread_block_row; if ((temp_global_col) < rows && i < rows) { temp_local[local_col][local_row] = temp[result_matrix_id * rows * rows + temp_global_col * rows + i]; } else { temp_local[local_col][local_row] = 0.0; } // Element above the diagonal will not be transferred. if (C1_global_col <= C1_global_row && C1_global_col < A_rows && C1_global_row < A_rows) { C1_local[local_col][local_row] = A[C1_global_col * A_rows + C1_global_row]; } else { C1_local[local_col][local_row] = 0; } } // wait until all tile values are loaded to the local memory barrier(CLK_LOCAL_MEM_FENCE); for (int block_ind = 0; block_ind < THREAD_BLOCK_SIZE; block_ind++) { for (int w = 0; w < WORK_PER_THREAD; w++) { // Which {col}{row} location in the local memory the thread is in // charge of. const int local_col = thread_block_col + w * THREAD_BLOCK_SIZE_COL; const int local_row = thread_block_row; acc[w] += temp_local[block_ind][local_row] * C1_local[local_col][block_ind]; } } barrier(CLK_LOCAL_MEM_FENCE); } // A_global_{row}{col} tells the thread which local memory it needs // to move to the final output const int A_global_row = i + rows + offset; const int A_global_col_offset = offset + j; // each thread saves WORK_PER_THREAD values for (int w = 0; w < WORK_PER_THREAD; w++) { const int A_global_col = A_global_col_offset + w * THREAD_BLOCK_SIZE_COL; if (A_global_col < A_rows && (i + rows + offset) < A_rows) { A[A_global_col * A_rows + i + rows + offset] = -acc[w]; } } } // \cond ); // \endcond /** * See the docs * for \link kernels/neg_rect_lower_tri_multiply.hpp * neg_rect_lower_tri_multiply() \endlink */ const kernel_cl neg_rect_lower_tri_multiply( "neg_rect_lower_tri_multiply", {thread_block_helpers, neg_rect_lower_tri_multiply_kernel_code}, {{"THREAD_BLOCK_SIZE", 32}, {"WORK_PER_THREAD", 8}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/scalar_mul_diagonal.hpp0000644000176200001440000000251713766554456026417 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_SCALAR_MUL_DIAGONAL_HPP #define STAN_MATH_OPENCL_KERNELS_SCALAR_MUL_DIAGONAL_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string scalar_mul_diagonal_kernel_code = STRINGIFY( // \endcond /** * Multiplication of the matrix A diagonal with a scalar * * @param[in, out] A matrix A * @param[in] scalar the value with which to multiply the diagonal of A * @param[in] rows the number of rows in A * @param[in] min_dim the size of the smaller dimension of A */ __kernel void scalar_mul_diagonal(__global double *A, const double scalar, const unsigned int rows, const unsigned int min_dim) { int i = get_global_id(0); if (i < min_dim) { A(i, i) *= scalar; } } // \cond ); // \endcond /** * See the docs for \link kernels/scalar_mul_diagonal.hpp add() \endlink */ const kernel_cl scalar_mul_diagonal( "scalar_mul_diagonal", {indexing_helpers, scalar_mul_diagonal_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/pack.hpp0000644000176200001440000000370113766554456023351 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_PACK_HPP #define STAN_MATH_OPENCL_KERNELS_PACK_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string pack_kernel_code = STRINGIFY( // \endcond /** * Packs a flat matrix to a packed triangular matrix * * @param[out] A packed buffer * @param[in] B flat matrix * @param rows number of columns for matrix B * @param cols number of columns for matrix B * @param view parameter that defines the triangularity of the * input matrix * LOWER - lower triangular * UPPER - upper triangular * if the view parameter is not specified * @note Code is a const char* held in * pack_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void pack(__global double* A, __global double* B, unsigned int rows, unsigned int cols, unsigned int view) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { // the packed matrices are stored in row major if (view == LOWER) { const int column_offset = j * rows - (j * (j - 1)) / 2; const int row_offset = (i - j); if (j <= i) { A[column_offset + row_offset] = B(i, j); } } else { const int column_offset = j * (j + 1) / 2; if (j >= i) { A[column_offset + i] = B(i, j); } } } } // \cond ); // \endcond /** * See the docs for \link kernels/pack.hpp pack() \endlink */ const kernel_cl pack( "pack", {indexing_helpers, pack_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/ordered_logistic_glm_lpmf.hpp0000644000176200001440000001544613766554456027642 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_ORDERED_LOGISTIC_GLM_LPMF_HPP #define STAN_MATH_OPENCL_KERNELS_ORDERED_LOGISTIC_GLM_LPMF_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const char* ordered_logistic_glm_kernel_code = STRINGIFY( // \endcond /** * GPU implementation of ordinal regression Generalized Linear Model (GLM). * * Must be run with at least N_instances threads and local size equal to * LOCAL_SIZE_. * @param[out] location_sum partially summed location (1 value per work * group) * @param[out] logp_global partially summed log probabiltiy (1 value per * work group) * @param[out] location_derivative derivative wrt location * @param[out] cuts_derivative partially summed derivative wrt cuts (1 * column per work group) * @param[in] y_global a scalar or vector of classes. * @param[in] x design matrix * @param[in] beta weight vector * @param[in] cuts cutpoints vector * @param N_instances number of cases * @param N_attributes number of attributes * @param N_classes number of classes * @param is_y_vector 0 or 1 - whether y is a vector (alternatively it is a * scalar) * @param need_location_derivative interpreted as boolean - whether * location_derivative needs to be computed * @param need_cuts_derivative interpreted as boolean - whether * cuts_derivative needs to be computed */ __kernel void ordered_logistic_glm( __global double* location_sum, __global double* logp_global, __global double* location_derivative, __global double* cuts_derivative, const __global int* y_global, const __global double* x, const __global double* beta, const __global double* cuts, const int N_instances, const int N_attributes, const int N_classes, const int is_y_vector, const int need_location_derivative, const int need_cuts_derivative) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wg_id = get_group_id(0); const int ngroups = get_num_groups(0); __local double local_storage[LOCAL_SIZE_]; double logp = 0; double d1 = 0; double d2 = 0; double location = 0; int y; // Most calculations only happen for relevant data within next if. // Exceptions are reductions between threads that need barriers. if (gid < N_instances) { for (int i = 0, j = 0; i < N_attributes; i++, j += N_instances) { location += x[j + gid] * beta[i]; } y = y_global[gid * is_y_vector]; if (y < 1 || y > N_classes) { location = NAN; } else { const double cut_y1 = y == N_classes ? INFINITY : cuts[y - 1]; const double cut_y2 = y == 1 ? -INFINITY : cuts[y - 2]; const double cut1 = location - cut_y1; const double cut2 = location - cut_y2; if (y != N_classes) { logp -= log1p_exp(cut1); } if (y != 1) { logp -= log1p_exp(-cut2); } if (y != 1 && y != N_classes) { logp += log1m_exp(cut1 - cut2); } if (need_location_derivative || need_cuts_derivative) { double exp_cuts_diff = exp(cut_y2 - cut_y1); if (cut2 > 0) { double exp_m_cut2 = exp(-cut2); d1 = exp_m_cut2 / (1 + exp_m_cut2); } else { d1 = 1 / (1 + exp(cut2)); } d1 -= exp_cuts_diff / (exp_cuts_diff - 1); d2 = 1 / (1 - exp_cuts_diff); if (cut1 > 0) { double exp_m_cut1 = exp(-cut1); d2 -= exp_m_cut1 / (1 + exp_m_cut1); } else { d2 -= 1 / (1 + exp(cut1)); } if (need_location_derivative) { location_derivative[gid] = d1 - d2; } } } } if (need_cuts_derivative) { for (int i = 0; i < N_classes - 1; i++) { local_storage[lid] = 0; if (gid < N_instances) { if (y - 1 == i) { local_storage[lid] = d2; } else if (y - 2 == i) { local_storage[lid] = -d1; } } // Sum cuts_derivative, calculated by different threads. // Since we can't sum between different work groups, we emit one // number per work group. These must be summed on CPU for final // result. barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { cuts_derivative[wg_id + i * ngroups] = local_storage[0]; } barrier(CLK_LOCAL_MEM_FENCE); } } local_storage[lid] = logp; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { logp_global[wg_id] = local_storage[0]; } barrier(CLK_LOCAL_MEM_FENCE); local_storage[lid] = location; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { location_sum[wg_id] = local_storage[0]; } } // \cond ); // \endcond /** * See the docs for \link kernels/ordered_logistic_glm_lpmf.hpp * ordered_logistic_glm() \endlink */ const kernel_cl ordered_logistic_glm("ordered_logistic_glm", {log1p_exp_device_function, log1m_exp_device_function, ordered_logistic_glm_kernel_code}, {{"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/bernoulli_logit_glm_lpmf.hpp0000644000176200001440000001206513766554456027504 0ustar liggesusers #ifndef STAN_MATH_OPENCL_KERNELS_BERNOULLI_LOGIT_GLM_LPMF_HPP #define STAN_MATH_OPENCL_KERNELS_BERNOULLI_LOGIT_GLM_LPMF_HPP #ifdef STAN_OPENCL #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const char* bernoulli_logit_glm_kernel_code = STRINGIFY( // \endcond /** * GPU implementation of Generalized Linear Model (GLM) * with Bernoulli distribution and logit link function. * * Must be run with at least N threads and local size equal to LOCAL_SIZE_. * @param[out] logp_global partially summed log probability (1 value per * work group) * @param[out] theta_derivative_global derivative with respect to x * beta + * alpha * @param[out] theta_derivative_sum partially summed theta_derivative_global * (1 value per work group) * @param[in] y_global binary vector parameter * @param[in] x design matrix * @param[in] alpha intercept (in log odds) * @param[in] beta weight vector * @param N number of cases * @param M number of attributes * @param is_alpha_vector 0 or 1 - whether alpha is a vector (alternatively * it is a scalar) * @param need_theta_derivative interpreted as boolean - whether * theta_derivative needs to be computed * @param need_theta_derivative_sum interpreted as boolean - whether * theta_derivative_sum needs to be computed */ __kernel void bernoulli_logit_glm( __global double* logp_global, __global double* theta_derivative_global, __global double* theta_derivative_sum, const __global int* y_global, const __global double* x, const __global double* alpha, const __global double* beta, const int N, const int M, const int is_alpha_vector, const int need_theta_derivative, const int need_theta_derivative_sum) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wg_id = get_group_id(0); __local double local_storage[LOCAL_SIZE_]; double logp = 0; double theta_derivative = 0; // Most calculations only happen for relevant data within next if. // Exceptions are reductions between threads that need barriers. if (gid < N) { double ytheta = 0; for (int i = 0, j = 0; i < M; i++, j += N) { ytheta += x[j + gid] * beta[i]; } const int y = y_global[gid]; const double sign_ = 2 * y - 1; ytheta += alpha[gid * is_alpha_vector]; ytheta *= sign_; if (y > 1 || y < 0 || !isfinite(ytheta)) { // this signals that an exception must be raised logp = NAN; } const double exp_m_ytheta = exp(-ytheta); const double cutoff = 20.0; if (ytheta > cutoff) { logp -= exp_m_ytheta; theta_derivative = -exp_m_ytheta; } else if (ytheta < -cutoff) { logp += ytheta; theta_derivative = sign_; } else { logp += -log1p(exp_m_ytheta); theta_derivative = sign_ * exp_m_ytheta / (exp_m_ytheta + 1); } if (need_theta_derivative) { theta_derivative_global[gid] = theta_derivative; } } // Sum logp, calculated by different threads. // Since we can't sum between different work groups, we emit one number // per work group. These must be summed on CPU for final result. local_storage[lid] = logp; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { logp_global[wg_id] = local_storage[0]; } if (need_theta_derivative_sum) { // Sum theta_derivative, calculated by different threads. barrier(CLK_LOCAL_MEM_FENCE); local_storage[lid] = theta_derivative; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { theta_derivative_sum[wg_id] = local_storage[0]; } } } // \cond ); // \endcond /** * See the docs for \link kernels/bernoulli_logit_glm_lpmf.hpp * bernoulli_logit_glm() \endlink */ const kernel_cl bernoulli_logit_glm("bernoulli_logit_glm", {bernoulli_logit_glm_kernel_code}, {{"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/copy.hpp0000644000176200001440000000267213766554456023413 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_COPY_HPP #define STAN_MATH_OPENCL_KERNELS_COPY_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string copy_kernel_code = STRINGIFY( // \endcond /** * Copy one matrix to another * @param[in] A The matrix to copy. * @param[out] B The matrix to copy A to. * @param rows The number of rows in A. * @param cols The number of cols in A. * @note Code is a const char* held in * copy_kernel_code. * Kernel used in math/opencl/matrix_cl.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void copy(__global double *A, __global double *B, unsigned int rows, unsigned int cols) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { B(i, j) = A(i, j); } } // \cond ); // \endcond /** * See the docs for \link kernels/copy.hpp copy() \endlink */ const kernel_cl copy("copy", {indexing_helpers, copy_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/diag_inv.hpp0000644000176200001440000000742113766554456024216 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_DIAGONAL_INVERSE_LOWER_TRI_HPP #define STAN_MATH_OPENCL_KERNELS_DIAGONAL_INVERSE_LOWER_TRI_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string diag_inv_kernel_code = STRINGIFY( // \endcond /** * Calculates inplace submatrix inversions along the matrix diagonal. * * For a full guide to the inverse lower triangular kernels see the link * here. * In the special case that the thread block size is larger than the input * matrix A then this kernel will perform the complete lower triangular * of matrix A. More often, TB is smaller than A and A will have lower * triangular inverses calculated on submatrices along the diagonal equal to * the size of the thread block. Running this kernel on a matrix with N = 4 * * thread_block will yield a lower triangular matrix with identity * matrices in blue as shown below. * ![Identity matrices in the blue triangles](https://goo.gl/Fz2tRi) * * This kernel is run with threads organized in a single dimension. * If we want to calculate N blocks of size TB across the diagonal * we spawn N x TB threads with TB used as the thread block size. * * @param[in,out] A The input matrix. * @param[in, out] tmp_inv A matrix with batches of identities matrices * along the diagonal. * @param rows The number of rows for A. * @note Code is a const char* held in * diag_inv_kernel_code. * Used in math/opencl/tri_inverse.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void diag_inv(__global double* A, __global double* tmp_inv, int rows) { int index = get_local_id(0); int group = get_group_id(0); int block_size = get_local_size(0); int A_offset = group * block_size; // offset inside the matrix with batched identities int tmp_offset = group * block_size * block_size + index * block_size; // The following code is the sequential version of forward // substitution with the identity matrix as RHS. Only the innermost loops // are parallelized. The rows are processed sequentially. This loop // process all the rows: for (int k = 0; k < block_size; k++) { double diag_ele = A(A_offset + k, A_offset + k); // Each element under the diagonal of the RHS is divided by diag_ele. // Each thread in a thread block does 1 division. // Threads that are assigned elements above the diagonal // skip this division. if (index <= k) { tmp_inv[tmp_offset + k] /= diag_ele; } barrier(CLK_LOCAL_MEM_FENCE); // Each thread updates one column in the RHS matrix // (ignores values above the diagonal). for (int i = max(k + 1, index); i < block_size; i++) { // NOLINT double factor = A(A_offset + i, A_offset + k); tmp_inv[tmp_offset + i] -= tmp_inv[tmp_offset + k] * factor; } barrier(CLK_LOCAL_MEM_FENCE); } for (int j = 0; j < block_size; j++) { // Each thread copies one column. A(A_offset + j, A_offset + index) = tmp_inv[tmp_offset + j]; } } // \cond ); // \endcond /** * See the docs for \link kernels/diag_inv.hpp add() * \endlink */ const kernel_cl diag_inv( "diag_inv", {indexing_helpers, diag_inv_kernel_code}, {{"THREAD_BLOCK_SIZE", 32}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/device_functions/0000755000176200001440000000000013766554456025250 5ustar liggesusersStanHeaders/inst/include/stan/math/opencl/kernels/device_functions/log1p_exp.hpp0000644000176200001440000000152313766554456027660 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_LOG1P_EXP_HPP #define STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_LOG1P_EXP_HPP #ifdef STAN_OPENCL #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string log1p_exp_device_function = STRINGIFY( // \endcond /** * Calculates the log of 1 plus the exponential of the specified * value without overflow. * *

log1p_exp(x) = log(1+exp(x)) * * @param[in] a Argument. * @return natural logarithm of one plus the exponential of the * argument. */ double log1p_exp(double a) { // prevents underflow return (a > 0 ? a : 0) + log1p(exp(-fabs(a))); } // \cond ); // \endcond } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/device_functions/log1m_exp.hpp0000644000176200001440000000171213766554456027655 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_LOG1M_EXP_HPP #define STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_LOG1M_EXP_HPP #ifdef STAN_OPENCL #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string log1m_exp_device_function = STRINGIFY( // \endcond /** * Calculates the natural logarithm of one minus the exponential * of the specified value without overflow, * *

log1m_exp(x) = log(1-exp(x)) * * This function is only defined for x < 0 * * @param[in] a Argument. * @return natural logarithm of one minus the exponential of the * argument. * */ double log1m_exp(double a) { if (a > -0.693147) return log(-expm1(a)); // 0.693147 ~= log(2) else return log1p(-exp(a)); } // \cond ); // \endcond } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/device_functions/digamma.hpp0000644000176200001440000000726013766554456027365 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_DIGAMMA_HPP #define STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_DIGAMMA_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string digamma_device_function = STRINGIFY( // \endcond /** * Calculates the digamma function - derivative of logarithm of gamma. This * implementation is based on one from boost 1.69.0: * https://www.boost.org/doc/libs/1_69_0/boost/math/special_functions/digamma.hpp. * * @param x point at which to calculate digamma * @return digamma(x) */ double digamma(double x) { double result = 0; if (x <= -1) { x = 1 - x; double remainder = x - floor(x); if (remainder > 0.5) { remainder -= 1; } if (remainder == 0) { return NAN; } result = M_PI / tan(M_PI * remainder); } if (x == 0) { return NAN; } // in boost: x >= digamma_large_lim(t) if (x > 10) { // in boost: result += digamma_imp_large(x, t); const double P[8] = {0.083333333333333333333333333333333333333333333333333, -0.0083333333333333333333333333333333333333333333333333, 0.003968253968253968253968253968253968253968253968254, -0.0041666666666666666666666666666666666666666666666667, 0.0075757575757575757575757575757575757575757575757576, -0.021092796092796092796092796092796092796092796092796, 0.083333333333333333333333333333333333333333333333333, -0.44325980392156862745098039215686274509803921568627}; x -= 1; result += log(x); result += 1 / (2 * x); double z = 1 / (x * x); double tmp = P[7]; for (int i = 6; i >= 0; i--) { tmp = tmp * z + P[i]; } // tmp=boost::tools::evaluate_polynomial(P, z); result -= z * tmp; } else { while (x > 2) { x -= 1; result += 1 / x; } while (x < 1) { result -= 1 / x; x += 1; } // in boost: result += digamma_imp_1_2(x, t); const float Y = 0.99558162689208984F; const double root1 = (double)1569415565 / 1073741824uL; // NOLINT const double root2 = (double)381566830 / 1073741824uL / 1073741824uL; // NOLINT const double root3 = 0.9016312093258695918615325266959189453125e-19; const double P[6] = {0.25479851061131551, -0.32555031186804491, -0.65031853770896507, -0.28919126444774784, -0.045251321448739056, -0.0020713321167745952}; const double Q[7] = {1.0, 2.0767117023730469, 1.4606242909763515, 0.43593529692665969, 0.054151797245674225, 0.0021284987017821144, -0.55789841321675513e-6}; double g = x - root1 - root2 - root3; double tmp = P[5]; for (int i = 4; i >= 0; i--) { tmp = tmp * (x - 1) + P[i]; } double tmp2 = Q[6]; for (int i = 5; i >= 0; i--) { tmp2 = tmp2 * (x - 1) + Q[i]; } // in boost: T r = tools::evaluate_polynomial(P, T(x-1)) / // tools::evaluate_polynomial(Q, T(x-1)); double r = tmp / tmp2; result += g * Y + g * r; } return result; } // \cond ); // \endcond } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/multiply_transpose.hpp0000644000176200001440000001165513766554456026417 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_MULTIPLY_TRANSPOSE_HPP #define STAN_MATH_OPENCL_KERNELS_MULTIPLY_TRANSPOSE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string multiply_transpose_kernel_code = STRINGIFY( // \endcond /** * Matrix multiplication of the form A*A^T on the OpenCL device * * @param[in] A matrix A * @param[out] B the output matrix * @param[in] M Number of rows for matrix A * @param[in] N Number of cols for matrix A and the number of rows for * matrix A^T */ __kernel void multiply_transpose(const __global double* A, __global double* B, const int M, const int N) { // thread index inside the thread block const int thread_block_row = get_local_id(0); const int thread_block_col = get_local_id(1); // global thread index const int i = THREAD_BLOCK_SIZE * get_group_id(0) + thread_block_row; const int j = THREAD_BLOCK_SIZE * get_group_id(1) + thread_block_col; // indexes that determine the last indexes that need to compute // in order to remove the unnecesary multiplications in the special // multiplication of A*A^T const int j_min = THREAD_BLOCK_SIZE * get_group_id(1); const int i_max = THREAD_BLOCK_SIZE * get_group_id(0) + get_local_size(0); // local memory __local double A_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; __local double B_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; double acc[WORK_PER_THREAD]; for (int w = 0; w < WORK_PER_THREAD; w++) { acc[w] = 0.0; } if (j_min <= i_max) { const int num_tiles = (N + THREAD_BLOCK_SIZE - 1) / THREAD_BLOCK_SIZE; // iterate over all tiles for (int tile_ind = 0; tile_ind < num_tiles; tile_ind++) { // in each tile const int tiled_i = THREAD_BLOCK_SIZE * tile_ind + thread_block_row; const int tiled_j = THREAD_BLOCK_SIZE * tile_ind + thread_block_col; // if the data needs to be loaded to local memory // each thread copies WORK_PER_THREAD values to the // local memory for (int w = 0; w < WORK_PER_THREAD; w++) { const A_temp_j = tiled_j + w * THREAD_BLOCK_SIZE_COL; const AT_temp_j = j + w * THREAD_BLOCK_SIZE_COL; if (A_temp_j >= N || i >= M) { A_local[thread_block_col + w * THREAD_BLOCK_SIZE_COL] [thread_block_row] = 0.0; } else { A_local[thread_block_col + w * THREAD_BLOCK_SIZE_COL] [thread_block_row] = A[A_temp_j * M + i]; } if (AT_temp_j >= M || tiled_i >= N) { B_local[thread_block_col + w * THREAD_BLOCK_SIZE_COL] [thread_block_row] = 0.0; } else { B_local[thread_block_col + w * THREAD_BLOCK_SIZE_COL] [thread_block_row] = A[AT_temp_j + tiled_i * M]; } } // wait till all tile values are loaded to the local memory barrier(CLK_LOCAL_MEM_FENCE); // multiply the tile products for (int block_ind = 0; block_ind < THREAD_BLOCK_SIZE; block_ind++) { // each thread multiplies WORK_PER_THREAD values for (int w = 0; w < WORK_PER_THREAD; w++) { if ((j + w * THREAD_BLOCK_SIZE_COL) <= i) { acc[w] += A_local[block_ind][thread_block_row] * B_local[thread_block_col + w * THREAD_BLOCK_SIZE_COL][block_ind]; } } } barrier(CLK_LOCAL_MEM_FENCE); } // each thread saves WORK_PER_THREAD values to C for (int w = 0; w < WORK_PER_THREAD; w++) { // This prevents threads from accessing elements // outside the allocated memory for C. The check // is in the loop because some threads // can be assigned elements in and out of // the allocated memory. if ((j + w * THREAD_BLOCK_SIZE_COL) < M && i < M) { if ((j + w * THREAD_BLOCK_SIZE_COL) <= i) { B[i + (j + w * THREAD_BLOCK_SIZE_COL) * M] = acc[w]; B[(j + w * THREAD_BLOCK_SIZE_COL) + i * M] = acc[w]; } } } } } // \cond ); // \endcond /** * See the docs for \link kernels/multiply_transpose.hpp add() \endlink */ const kernel_cl multiply_transpose( "multiply_transpose", {thread_block_helpers, multiply_transpose_kernel_code}, {{"THREAD_BLOCK_SIZE", 32}, {"WORK_PER_THREAD", 4}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/check_symmetric.hpp0000644000176200001440000000337113766554456025607 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_CHECK_SYMMETRIC_HPP #define STAN_MATH_OPENCL_KERNELS_CHECK_SYMMETRIC_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string is_symmetric_kernel_code = STRINGIFY( // \endcond /** * Check if the matrix_cl is symmetric * * @param[in] A The matrix to check. * @param rows The number of rows in matrix A. * @param cols The number of columns in matrix A. * @param[out] flag the flag to be written to if any diagonal is zero. * @param tolerance The numerical tolerance to check wheter * two values are equal * @note Code is a const char* held in * is_symmetric_kernel_code. * Kernel for stan/math/opencl/err/check_symmetric.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void is_symmetric(__global double *A, __global int *flag, unsigned int rows, unsigned int cols, double tolerance) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < rows && j < cols) { double diff = fabs(A(i, j) - A(j, i)); if (diff > tolerance) { flag[0] = 0; } } } // \cond ); // \endcond /** * See the docs for \link kernels/check_symmetric.hpp check_symmetric() \endlink */ const kernel_cl check_symmetric( "is_symmetric", {indexing_helpers, is_symmetric_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/poisson_log_glm_lpmf.hpp0000644000176200001440000001121213766554456026637 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_POISSON_LOG_GLM_LPMF_HPP #define STAN_MATH_OPENCL_KERNELS_POISSON_LOG_GLM_LPMF_HPP #ifdef STAN_OPENCL #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const char* poisson_log_glm_kernel_code = STRINGIFY( // \endcond /** * GPU implementation of Generalized Linear Model (GLM) * with Poisson distribution and log link function. * * Must be run with at least N threads and local size equal to LOCAL_SIZE_. * @param[out] theta_derivative_global derivative with respect to x * beta + * alpha * @param[out] theta_derivative_sum partially summed theta_derivative_global * (1 value per work group) * @param[out] logp_global partially summed part of log probability (1 value * per work group) * @param[in] y_global positive integer vector parameter * @param[in] x design matrix * @param[in] alpha intercept (in log odds) * @param[in] beta weight vector * @param N number of cases * @param M number of attributes * @param is_alpha_vector 0 or 1 - whether alpha is a vector (alternatively * it is a scalar) * @param need_logp1 interpreted as boolean - whether first part of * logp_global needs to be computed * @param need_logp2 interpreted as boolean - whether second part of * logp_global needs to be computed */ __kernel void poisson_log_glm( __global double* theta_derivative_global, __global double* theta_derivative_sum, __global double* logp_global, const __global int* y_global, const __global double* x, const __global double* alpha, const __global double* beta, const int N, const int M, const int is_alpha_vector, const int need_logp1, const int need_logp2) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wg_id = get_group_id(0); __local double local_storage[LOCAL_SIZE_]; double theta = 0; double theta_derivative = 0; double logp = 0; // Most calculations only happen for relevant data within next if. // Exceptions are reductions between threads that need barriers. if (gid < N) { for (int i = 0, j = 0; i < M; i++, j += N) { theta += x[j + gid] * beta[i]; } theta += alpha[gid * is_alpha_vector]; const double y = y_global[gid]; const double exp_theta = exp(theta); theta_derivative = y - exp_theta; if (y < 0 || !isfinite(theta)) { // this signals that an exception must be raised theta_derivative = NAN; } if (need_logp1) { logp = -lgamma(y + 1); } if (need_logp2) { logp += y * theta - exp_theta; } theta_derivative_global[gid] = theta_derivative; } // Sum theta_derivative, calculated by different threads. // Since we can't sum between different work groups, we emit one number // per work group. These must be summed on CPU for final result. local_storage[lid] = theta_derivative; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { theta_derivative_sum[wg_id] = local_storage[0]; } if (need_logp1 || need_logp2) { // Sum logp, calculated by different threads. barrier(CLK_LOCAL_MEM_FENCE); local_storage[lid] = logp; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { logp_global[wg_id] = local_storage[0]; } } } // \cond ); // \endcond /** * See the docs for \link kernels/subtract.hpp subtract() \endlink */ const kernel_cl poisson_log_glm("poisson_log_glm", {poisson_log_glm_kernel_code}, {{"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/divide_columns.hpp0000644000176200001440000000403513766554456025440 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_DIVIDE_COLUMNS_HPP #define STAN_MATH_OPENCL_KERNELS_DIVIDE_COLUMNS_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string divide_columns_kernel_code = STRINGIFY( // \endcond /** * Takes vector A and divides columns vector in A element-wise by the values * in vec * @param[out] A Matrix to be divided elementwise * @param[in] vec Vector to divide A by * @param vec_size Size of elementwise divisor. * @note Code is a const char* held in * divide_columns_vec_kernel_code. */ __kernel void divide_columns_vec(__global double *A, __global double *vec, int vec_size) { const int i = get_global_id(0); A[i] /= vec[i % vec_size]; } // \cond ); // \endcond /** * See the docs for \link kernels/divide_columns.hpp divide_columns_vec() * \endlink */ const kernel_cl divide_columns_vec( "divide_columns_vec", {indexing_helpers, divide_columns_kernel_code}); // \cond static const std::string divide_column_scalar_kernel_code = STRINGIFY( // \endcond /** * Performs element-wise division on \c A * @param[out] A Matrix to be divided elementwise * @param divisor element to divide A by elementwise * @note Code is a const char* held in * divide_column_scalar_kernel_code. */ __kernel void divide_columns_scalar(__global double *A, double divisor) { const int i = get_global_id(0); A[i] /= divisor; } // \cond ); // \endcond /** * See the docs for \link kernels/add.hpp add() \endlink */ const kernel_cl divide_columns_scalar( "divide_columns_scalar", {indexing_helpers, divide_column_scalar_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/normal_id_glm_lpdf.hpp0000644000176200001440000001432013766554456026242 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_NORMAL_ID_GLM_LPDF_HPP #define STAN_MATH_OPENCL_KERNELS_NORMAL_ID_GLM_LPDF_HPP #ifdef STAN_OPENCL #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const char* normal_id_glm_kernel_code = STRINGIFY( // \endcond /** * GPU implementation of Generalized Linear Model (GLM) * with Normal distribution and identity link function. * * Must be run with at least N threads and local size equal to LOCAL_SIZE_. * @param[in] y vector parameter * @param[in] x design matrix * @param[in] alpha intercept (in log odds) * @param[in] beta weight vector * @param[in] sigma_global (Sequence of) scale parameters for the normal * @param[out] mu_derivative_global intermediate variable used in the model * @param[out] mu_derivative_sum partially summed mu_derivative_global (1 * value per work group) * @param[out] y_scaled_sq_sum y, scaled by expected mean and given * variance, squared and partially summed (1 value per work group). * @param[out] sigma_derivative derivative with respect to sigma * @param[out] log_sigma_sum partially summed logarithm of sigma (1 value * per work group) * @param N number of cases * @param M number of attributes * @param is_alpha_vector 0 or 1 - whether alpha is a vector (alternatively * it is a scalar) * @param is_sigma_vector 0 or 1 - whether sigma is a vector (alternatively * it is a scalar) * @param need_mu_derivative interpreted as boolean - whether mu_derivative * needs to be computed * @param need_mu_derivative_sum interpreted as boolean - whether * mu_derivative_sum needs to be computed * @param need_sigma_derivative interpreted as boolean - whether * sigma_derivative needs to be computed * @param need_log_sigma_sum interpreted as boolean - whether log_sigma_sum * needs to be computed */ __kernel void normal_id_glm( __global double* mu_derivative_global, __global double* mu_derivative_sum, __global double* y_scaled_sq_sum, __global double* sigma_derivative, __global double* log_sigma_sum, const __global double* y, const __global double* x, const __global double* alpha, const __global double* beta, const __global double* sigma_global, const int N, const int M, const int is_alpha_vector, const int is_sigma_vector, const int need_mu_derivative, const int need_mu_derivative_sum, const int need_sigma_derivative, const int need_log_sigma_sum) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wg_id = get_group_id(0); __local double local_storage[LOCAL_SIZE_]; double y_scaled_sq = 0; double log_sigma = 0; double mu_derivative = 0; // Most calculations only happen for relevant data within next if. // Exceptions are reductions between threads that need barriers. if (gid < N) { double y_scaled = 0; for (int i = 0, j = 0; i < M; i++, j += N) { y_scaled += x[j + gid] * beta[i]; } double sigma = sigma_global[gid * is_sigma_vector]; double inv_sigma = 1 / sigma; y_scaled = (y[gid] - y_scaled - alpha[gid * is_alpha_vector]) * inv_sigma; mu_derivative = inv_sigma * y_scaled; if (need_mu_derivative) { mu_derivative_global[gid] = mu_derivative; } y_scaled_sq = y_scaled * y_scaled; if (need_sigma_derivative) { sigma_derivative[gid] = (y_scaled_sq - 1) * inv_sigma; } if (need_log_sigma_sum) { log_sigma = log(sigma); } } // Sum y_scaled_sq, calculated by different threads. // Since we can't sum between different work groups, we emit one number // per work group. These must be summed on CPU for final result. local_storage[lid] = y_scaled_sq; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { y_scaled_sq_sum[wg_id] = local_storage[0]; } if (need_mu_derivative_sum) { // Sum mu_derivative, calculated by different threads. barrier(CLK_LOCAL_MEM_FENCE); local_storage[lid] = mu_derivative; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { mu_derivative_sum[wg_id] = local_storage[0]; } } if (need_log_sigma_sum) { // Sum log_sigma, calculated by different threads. barrier(CLK_LOCAL_MEM_FENCE); local_storage[lid] = log_sigma; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { log_sigma_sum[wg_id] = local_storage[0]; } } } // \cond ); // \endcond /** * See the docs for \link kernels/normal_id_glm_lpdf.hpp * normal_id_glm() \endlink */ const kernel_cl normal_id_glm("normal_id_glm", {normal_id_glm_kernel_code}, {{"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/sub_block.hpp0000644000176200001440000000625013766554456024400 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_SUB_BLOCK_HPP #define STAN_MATH_OPENCL_KERNELS_SUB_BLOCK_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string sub_block_kernel_code = STRINGIFY( // \endcond /** * Copies a submatrix of the source matrix to * the destination matrix. The submatrix to copy * starts at (0, 0) * and is of size size_rows x size_cols. * The submatrix is copied to the * destination matrix starting at * (dst_offset_rows, dst_offset_cols) * * @param[in] src The source matrix. * @param[out] dst The destination submatrix. * @param src_offset_i The offset row in src. * @param src_offset_j The offset column in src. * @param dst_offset_i The offset row in dst. * @param dst_offset_j The offset column in dst. * @param size_i The number of rows in the submatrix. * @param size_j The number of columns in the submatrix. * @param src_rows The number of rows in the source matrix. * @param src_cols The number of cols in the source matrix. * @param src_rows The number of rows in the destination matrix. * @param dst_cols The number of cols in the destination matrix. * @param dst_rows The number of rows in the destination matrix. * @param view the triangularity of src (lower, upper or none) * @note Code is a const char* held in * sub_block_kernel_code. * Used in math/opencl/copy_submatrix_opencl.hpp. * This kernel uses the helper macros available in helpers.cl. * */ __kernel void sub_block( __global double *src, __global double *dst, unsigned int src_offset_i, unsigned int src_offset_j, unsigned int dst_offset_i, unsigned int dst_offset_j, unsigned int size_i, unsigned int size_j, unsigned int src_rows, unsigned int src_cols, unsigned int dst_rows, unsigned int dst_cols, unsigned int view) { const int i = get_global_id(0); const int j = get_global_id(1); const int src_idx_i = i + src_offset_i; const int src_idx_j = j + src_offset_j; const int dst_idx_i = i + dst_offset_i; const int dst_idx_j = j + dst_offset_j; if (src_idx_i < src_rows && src_idx_j < src_cols && dst_idx_i < dst_rows && dst_idx_j < dst_cols) { if ((contains_nonzero(view, LOWER) && src_idx_i >= src_idx_j) || (contains_nonzero(view, UPPER) && src_idx_i <= src_idx_j)) { dst(dst_idx_i, dst_idx_j) = src(src_idx_i, src_idx_j); } else { dst(dst_idx_i, dst_idx_j) = 0; } } } // \cond ); // \endcond /** * See the docs for \link kernels/sub_block.hpp sub_block() \endlink */ const kernel_cl sub_block("sub_block", {indexing_helpers, view_kernel_helpers, sub_block_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/matrix_multiply.hpp0000644000176200001440000004317613766554456025710 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_MATRIX_MULTIPLY_HPP #define STAN_MATH_OPENCL_KERNELS_MATRIX_MULTIPLY_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string matrix_multiply_kernel_code = STRINGIFY( // \endcond /** * Matrix multiplication on the OpenCL device * * @param[in] A the left matrix in matrix multiplication * @param[in] B the right matrix in matrix multiplication * @param[out] C the output matrix * @param[in] M Number of rows for matrix A * @param[in] N Number of cols for matrix B * @param[in] K Number of cols for matrix A and number of rows for matrix B * @param[in] view_A the triangularity of A (lower, upper or none) * @param[in] view_B the triangularity of B (lower, upper or none) */ __kernel void matrix_multiply(const __global double* A, const __global double* B, __global double* C, const int M, const int N, const int K, unsigned int view_A, unsigned int view_B) { // thread index inside the thread_block const int row_in_block = get_local_id(0); const int col_in_block = get_local_id(1); const int group_id_row = get_group_id(0); const int group_id_col = get_group_id(1); // global thread index const int i = THREAD_BLOCK_SIZE * group_id_row + row_in_block; const int j = THREAD_BLOCK_SIZE * group_id_col + col_in_block; // identify if the matrix multiply is split const int split_id = get_global_id(2); const int split_size = get_global_size(2); // local memory __local double A_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; __local double B_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; double acc[WORK_PER_THREAD]; for (int w = 0; w < WORK_PER_THREAD; w++) { acc[w] = 0.0; } // the number of tiles for each scalar product in the matrix mulitply const int num_tiles = (K + THREAD_BLOCK_SIZE - 1) / THREAD_BLOCK_SIZE; // in case of splitting the matrix multiply we need // use split_offset_tiles the threads assigned part // of the scalar products, while the split_tiles // determines the number of tiles a thread multiplies // if split_size = 1, each thread calculates the // the entire scalar product for all assigned // elements of the resulting matrix, meaning that // split_offset_tiles is 0 and split_tiles = num_tiles int split_tiles = num_tiles / split_size; const int split_remainder = num_tiles % split_size; int split_offset_tiles = split_id * split_tiles; if (split_id < split_remainder) { split_offset_tiles = split_offset_tiles + split_id; split_tiles++; } else { split_offset_tiles = split_offset_tiles + split_remainder; } // This kernel is based on the well known // general matrix multiplication kernels that // use tiling for shared memory // In cases where a matrix is lower triangular // its not necessary to multiply the elements // over the diagonal, therefore those tiles // in the matrix multiply can be skipped. // With upper triangular matrices we dont need // to multiply the elements under the diagonal, // so those tiles can be skipped. // The following code determines the start and // end tile based on triangularity of the input matrices // If no matrices are triangular the starting tile // is 0 and the end tile is num_tiles-1 which // is then a general matrix multiply const int end_tile_A = contains_nonzero(view_A, UPPER) ? (num_tiles - 1) : (i / THREAD_BLOCK_SIZE); const int end_tile_B = contains_nonzero(view_B, LOWER) ? (num_tiles - 1) : (j / THREAD_BLOCK_SIZE); const int start_tile_A = contains_nonzero(view_A, LOWER) ? 0 : (i / THREAD_BLOCK_SIZE); const int start_tile_B = contains_nonzero(view_B, UPPER) ? 0 : (j / THREAD_BLOCK_SIZE); // the starting and end tiles for a thread are determined by // split_offset_tiles and split_tiles. If the input matrix is // triangular some tiles can be skipped in which case we // either start the scalar product at larger cols/rows // or end them at smaller cols/rows. int start_tile = max(start_tile_A, start_tile_B); start_tile = max(start_tile, split_offset_tiles); int end_tile = min(end_tile_A, end_tile_B); // NOLINT end_tile = min(end_tile, split_offset_tiles + split_tiles - 1); // NOLINT const int total_work_n = min( // NOLINT THREAD_BLOCK_SIZE, N - THREAD_BLOCK_SIZE * group_id_col); const int total_work_m = min( // NOLINT THREAD_BLOCK_SIZE, M - THREAD_BLOCK_SIZE * group_id_row); const int total_work_nm = total_work_n * total_work_m; const int threads_in_block = THREAD_BLOCK_SIZE_COL * THREAD_BLOCK_SIZE; const int linear_index = get_local_id(0) + get_local_id(1) * THREAD_BLOCK_SIZE; if (start_tile <= end_tile && (view_A == UPPER || view_B == LOWER)) { // special handling of first block const int tiled_i = THREAD_BLOCK_SIZE * start_tile + row_in_block; const int tiled_j = THREAD_BLOCK_SIZE * start_tile + col_in_block; for (int w = 0; w < WORK_PER_THREAD; w++) { // For the tiles on the diagonal we can ignore the values over // the diagonal if the matrix is lower triangular or under // the diagonal if the matrix is upper triangular const int A_curr_j = tiled_j + w * THREAD_BLOCK_SIZE_COL; const int B_curr_j = j + w * THREAD_BLOCK_SIZE_COL; const int curr_k = col_in_block + w * THREAD_BLOCK_SIZE_COL; // check if the indexes are outside the matrix // or under/above the diagonal with upper/lower // triangular matrices if (A_curr_j >= K || i >= M || (view_A == LOWER && A_curr_j > i) || (view_A == UPPER && A_curr_j < i)) { A_local[curr_k][row_in_block] = 0.0; } else { A_local[curr_k][row_in_block] = A[A_curr_j * M + i]; } if (B_curr_j >= N || tiled_i >= K || (view_B == LOWER && B_curr_j > tiled_i) || (view_B == UPPER && B_curr_j < tiled_i)) { B_local[curr_k][row_in_block] = 0.0; } else { B_local[curr_k][row_in_block] = B[B_curr_j * K + tiled_i]; } } barrier(CLK_LOCAL_MEM_FENCE); const int total_work_k = min( THREAD_BLOCK_SIZE, K - THREAD_BLOCK_SIZE * start_tile); // NOLINT for (int idx = linear_index, w = 0; idx < total_work_nm; idx += threads_in_block, w++) { const int row_B_local = idx / total_work_m; const int col_A_local = idx % total_work_m; for (int idx_in_block = 0; idx_in_block < total_work_k; idx_in_block++) { acc[w] += A_local[idx_in_block][col_A_local] * B_local[row_B_local][idx_in_block]; } } barrier(CLK_LOCAL_MEM_FENCE); start_tile++; } if (start_tile <= end_tile && (view_A == LOWER || view_B == UPPER || K % THREAD_BLOCK_SIZE != 0)) { // special handling of last block const int tiled_i = THREAD_BLOCK_SIZE * end_tile + row_in_block; const int tiled_j = THREAD_BLOCK_SIZE * end_tile + col_in_block; for (int w = 0; w < WORK_PER_THREAD; w++) { // For the tiles on the diagonal we can ignore the values over // the diagonal if the matrix is lower triangular or under // the diagonal if the matrix is upper triangular const int A_curr_j = tiled_j + w * THREAD_BLOCK_SIZE_COL; const int B_curr_j = j + w * THREAD_BLOCK_SIZE_COL; const int curr_k = col_in_block + w * THREAD_BLOCK_SIZE_COL; // check if the indexes are outside the matrix // or under/above the diagonal with upper/lower // triangular matrices if (A_curr_j >= K || i >= M || (!contains_nonzero(view_A, UPPER) && A_curr_j > i) || (!contains_nonzero(view_A, LOWER) && A_curr_j < i)) { A_local[curr_k][row_in_block] = 0.0; } else { A_local[curr_k][row_in_block] = A[A_curr_j * M + i]; } if (B_curr_j >= N || tiled_i >= K || (!contains_nonzero(view_B, UPPER) && B_curr_j > tiled_i) || (!contains_nonzero(view_B, LOWER) && B_curr_j < tiled_i)) { B_local[curr_k][row_in_block] = 0.0; } else { B_local[curr_k][row_in_block] = B[B_curr_j * K + tiled_i]; } } barrier(CLK_LOCAL_MEM_FENCE); const int total_work_k = min( THREAD_BLOCK_SIZE, K - THREAD_BLOCK_SIZE * end_tile); // NOLINT for (int idx = linear_index, w = 0; idx < total_work_nm; idx += threads_in_block, w++) { const int row_B_local = idx / total_work_m; const int col_A_local = idx % total_work_m; for (int idx_in_block = 0; idx_in_block < total_work_k; idx_in_block++) { acc[w] += A_local[idx_in_block][col_A_local] * B_local[row_B_local][idx_in_block]; } } barrier(CLK_LOCAL_MEM_FENCE); end_tile--; } if (total_work_n < THREAD_BLOCK_SIZE || total_work_m < THREAD_BLOCK_SIZE) { // special handling of edge blocks for (int tile_idx = start_tile; tile_idx <= end_tile; tile_idx++) { const int tiled_i = THREAD_BLOCK_SIZE * tile_idx + row_in_block; const int tiled_j = THREAD_BLOCK_SIZE * tile_idx + col_in_block; // each thread copies WORK_PER_THREAD values to the local // memory for (int w = 0; w < WORK_PER_THREAD; w++) { const int A_curr_j = tiled_j + w * THREAD_BLOCK_SIZE_COL; const int B_curr_j = j + w * THREAD_BLOCK_SIZE_COL; const int curr_k = col_in_block + w * THREAD_BLOCK_SIZE_COL; // check if the indexes are outside the matrix if (i < M) { A_local[curr_k][row_in_block] = A[A_curr_j * M + i]; } if (B_curr_j < N) { B_local[curr_k][row_in_block] = B[B_curr_j * K + tiled_i]; } } barrier(CLK_LOCAL_MEM_FENCE); int total_work_k = min(THREAD_BLOCK_SIZE, // NOLINT K - THREAD_BLOCK_SIZE * tile_idx); for (int idx = linear_index, w = 0; idx < total_work_nm; idx += threads_in_block, w++) { const int row_B_local = idx / total_work_m; const int col_A_local = idx % total_work_m; for (int idx_in_block = 0; idx_in_block < total_work_k; idx_in_block++) { acc[w] += A_local[idx_in_block][col_A_local] * B_local[row_B_local][idx_in_block]; } } barrier(CLK_LOCAL_MEM_FENCE); } for (int idx = linear_index, w = 0; idx < total_work_nm; idx += threads_in_block, w++) { const int curr_i = THREAD_BLOCK_SIZE * get_group_id(0) + idx % total_work_m; const int B_curr_j = THREAD_BLOCK_SIZE * get_group_id(1) + idx / total_work_m; C[split_id * M * N + B_curr_j * M + curr_i] = acc[w]; } } else { // general case that is not on the edge - all threads have work for (int tile_idx = start_tile; tile_idx <= end_tile; tile_idx++) { const int tiled_i = THREAD_BLOCK_SIZE * tile_idx + row_in_block; const int tiled_j = THREAD_BLOCK_SIZE * tile_idx + col_in_block; // each thread copies WORK_PER_THREAD values to the local // memory for (int w = 0; w < WORK_PER_THREAD; w++) { const int A_curr_j = tiled_j + w * THREAD_BLOCK_SIZE_COL; const int B_curr_j = j + w * THREAD_BLOCK_SIZE_COL; const int curr_k = col_in_block + w * THREAD_BLOCK_SIZE_COL; A_local[curr_k][row_in_block] = A[A_curr_j * M + i]; B_local[curr_k][row_in_block] = B[B_curr_j * K + tiled_i]; } barrier(CLK_LOCAL_MEM_FENCE); for (int w = 0; w < WORK_PER_THREAD; w++) { for (int idx_in_block = 0; idx_in_block < THREAD_BLOCK_SIZE; idx_in_block++) { acc[w] += A_local[idx_in_block][row_in_block] * B_local[w * THREAD_BLOCK_SIZE_COL + col_in_block] [idx_in_block]; } } barrier(CLK_LOCAL_MEM_FENCE); } // each thread saves WORK_PER_THREAD values for (int w = 0; w < WORK_PER_THREAD; w++) { const int curr_j = j + w * THREAD_BLOCK_SIZE_COL; C[split_id * M * N + curr_j * M + i] = acc[w]; } } } // \cond ); // \endcond /** * See the docs for \link kernels/matrix_multiply.hpp matrix_multiply() \endlink */ const kernel_cl matrix_multiply("matrix_multiply", {thread_block_helpers, view_kernel_helpers, matrix_multiply_kernel_code}, {{"THREAD_BLOCK_SIZE", 32}, {"WORK_PER_THREAD", 8}}); // \cond static const std::string matrix_vector_multiply_kernel_code = STRINGIFY( // \endcond /** * Matrix-vector multiplication R=A*B on the OpenCL device * * @param[in] A matrix in matrix-vector multiplication * @param[in] B vector in matrix-vector multiplication * @param[out] R the output vector * @param[in] M Number of rows for matrix A * @param[in] N Number of cols for matrix A and number of rows for vector B * @param[in] view_A the triangularity of A (lower, upper or none) * @param[in] view_B the triangularity of B (lower, upper or none) */ __kernel void matrix_vector_multiply( const __global double* A, const __global double* B, __global double* R, const int M, const int N, unsigned int view_A, unsigned int view_B) { const int gid = get_global_id(0); const int start = contains_nonzero(view_A, LOWER) ? 0 : gid; const int stop = contains_nonzero(view_B, LOWER) ? (contains_nonzero(view_A, UPPER) ? N : gid + 1) : 1; double acc = 0; for (int i = start, j = M * start; i < stop; i++, j += M) { acc += A[j + gid] * B[i]; } R[gid] = acc; } // \cond ); // \endcond /** * See the docs for \link kernels/matrix_multiply.hpp matrix_vector_multiply() * \endlink */ const kernel_cl matrix_vector_multiply("matrix_vector_multiply", {view_kernel_helpers, matrix_vector_multiply_kernel_code}); // \cond static const std::string row_vector_matrix_multiply_kernel_code = STRINGIFY( // \endcond /** * Row vector-matrix multiplication R=A*B on the OpenCL device * * @param[in] A row vector in row vector-matrix multiplication * @param[in] B matrix in row vector-matrix multiplication * @param[out] R the output vector * @param[in] N Number of cols for row vector A and number of rows for * matrix B * @param[in] K Number of cols for matrix B * @param[in] view_A the triangularity of A (lower, upper or none) * @param[in] view_B the triangularity of B (lower, upper or none) */ __kernel void row_vector_matrix_multiply( const __global double* A, const __global double* B, __global double* R, const int N, const int K, unsigned int view_A, unsigned int view_B) { const int lid = get_local_id(0); const int gid = get_global_id(0); const int wgid = get_group_id(0); const int start = contains_nonzero(view_B, UPPER) ? 0 : wgid; const int stop = contains_nonzero(view_A, UPPER) ? contains_nonzero(view_B, LOWER) ? N : wgid + 1 : 1; double acc = 0; for (int i = lid + start; i < stop; i += LOCAL_SIZE_) { acc += A[i] * B[i + wgid * N]; } __local double res_loc[LOCAL_SIZE_]; res_loc[lid] = acc; barrier(CLK_LOCAL_MEM_FENCE); for (int step = LOCAL_SIZE_ / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { res_loc[lid] += res_loc[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { R[wgid] = res_loc[0]; } } // \cond ); // \endcond /** * See the docs for \link kernels/matrix_multiply.hpp * row_vector_matrix_multiply() \endlink */ const kernel_cl row_vector_matrix_multiply("row_vector_matrix_multiply", {view_kernel_helpers, row_vector_matrix_multiply_kernel_code}, {{"LOCAL_SIZE_", 64}, {"REDUCTION_STEP_SIZE", 4}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/cholesky_decompose.hpp0000644000176200001440000000467313766554456026323 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_CHOLESKY_DECOMPOSE_HPP #define STAN_MATH_OPENCL_KERNELS_CHOLESKY_DECOMPOSE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string cholesky_decompose_kernel_code = STRINGIFY( // \endcond /** * Calculates the Cholesky Decomposition of a matrix on an OpenCL * * This kernel is run with threads organized in one dimension and * in a single thread block. The kernel is best suited for * small input matrices as it only utilizes a single streaming * multiprocessor. The kernels is used as a part of a blocked * cholesky decompose. * * @param[in, out] A The input matrix and the result of the cholesky * decomposition * @param rows The number of rows for A and B. * @note Code is a const char* held in * cholesky_decompose_kernel_code. * Used in math/opencl/cholesky_decompose.hpp. * This kernel uses the helper macros available in helpers.cl. * */ __kernel void cholesky_decompose(__global double *A, int rows) { const int local_index = get_local_id(0); // The following code is the sequential version of the inplace // cholesky decomposition. Only the innermost loops are parallelized. The // rows are processed sequentially. This loop process all the rows: for (int j = 0; j < rows; j++) { if (local_index == 0) { double sum = 0.0; for (int k = 0; k < j; k++) { sum = sum + A(j, k) * A(j, k); } A(j, j) = sqrt(A(j, j) - sum); } barrier(CLK_LOCAL_MEM_FENCE); if (local_index < j) { A(local_index, j) = 0.0; } else if (local_index > j) { double sum = 0.0; for (int k = 0; k < j; k++) sum = sum + A(local_index, k) * A(j, k); A(local_index, j) = (A(local_index, j) - sum) / A(j, j); } barrier(CLK_LOCAL_MEM_FENCE); } } // \cond ); // \endcond /** * See the docs for \link kernels/cholesky_decompose.hpp cholesky_decompose() * \endlink */ const kernel_cl cholesky_decompose( "cholesky_decompose", {indexing_helpers, cholesky_decompose_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/copy_triangular.hpp0000644000176200001440000000425113766554456025636 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_COPY_TRIANGULAR_HPP #define STAN_MATH_OPENCL_KERNELS_COPY_TRIANGULAR_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string copy_triangular_kernel_code = STRINGIFY( // \endcond /** * Copies the lower or upper * triangular of the source matrix to * the destination matrix. * Both matrices are stored on the OpenCL device. * * @param[out] A Output matrix to copy triangular to. * @param[in] B The matrix to copy the triangular from. * @param rows The number of rows of B. * @param cols The number of cols of B. * @param view determines * which part of the matrix to copy: * ENTIRE: copies entire matrix * LOWER: copies the lower triangular * UPPER: copies the upper triangular * DIAGONAL: copies the diagonal * @note Code is a const char* held in * copy_triangular_kernel_code. * Used in math/opencl/copy_triangular_opencl.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void copy_triangular(__global double *A, __global double *B, unsigned int rows, unsigned int cols, unsigned int view) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { if ((contains_nonzero(view, LOWER) && j <= i) || (contains_nonzero(view, UPPER) && j >= i) || j == i) { A(i, j) = B(i, j); } else { A(i, j) = 0; } } } // \cond ); // \endcond /** * See the docs for \link kernels/copy_triangular.hpp copy_triangular() \endlink */ const kernel_cl copy_triangular("copy_triangular", {indexing_helpers, view_kernel_helpers, copy_triangular_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/unpack.hpp0000644000176200001440000000407613766554456023722 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_UNPACK_HPP #define STAN_MATH_OPENCL_KERNELS_UNPACK_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string unpack_kernel_code = STRINGIFY( // \endcond /** * Unpacks a packed triangular matrix to a flat * matrix * * @param[out] B flat matrix * @param[in] A packed buffer * @param rows number of columns for matrix B * @param cols number of columns for matrix B * @param view parameter that defines the triangularity of the * input matrix * LOWER - lower triangular * UPPER - upper triangular * if the view parameter is not specified * @note Code is a const char* held in * unpack_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void unpack(__global double* B, __global double* A, unsigned int rows, unsigned int cols, unsigned int view) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { // the packed matrices are stored in row major if (view == LOWER) { const int column_offset = j * rows - (j * (j - 1)) / 2; const int row_offset = (i - j); if (j <= i) { B(i, j) = A[column_offset + row_offset]; } else { B(i, j) = 0.0; } } else { const int column_offset = j * (j + 1) / 2; if (j >= i) { B(i, j) = A[column_offset + i]; } else { B(i, j) = 0.0; } } } } // \cond ); // \endcond /** * See the docs for \link kernels/unpack.hpp unpack() \endlink */ const kernel_cl unpack( "unpack", {indexing_helpers, unpack_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/neg_binomial_2_log_glm_lpmf.hpp0000644000176200001440000001736213766554456030025 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_NEG_BINOMIAL_2_LOG_GLM_LPMF_HPP #define STAN_MATH_OPENCL_KERNELS_NEG_BINOMIAL_2_LOG_GLM_LPMF_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const char* neg_binomial_2_log_glm_kernel_code = STRINGIFY( // \endcond /** * GPU implementation of Generalized Linear Model (GLM) * with Negative-Binomial-2 distribution and log link function. * * Must be run with at least N threads and local size equal to LOCAL_SIZE_. * @param[out] logp_global partially summed log probabilty (1 value per work * group) * @param[out] theta_derivative_global intermediate variable used in the * model * @param[out] theta_derivative_sum partially summed theta_derivative_global * (1 value per work group) * @param[out] phi_derivative_global derivative with respect to phi * @param[in] y_global failures count vector parameter * @param[in] x design matrix * @param[in] alpha intercept (in log odds) * @param[in] beta weight vector * @param[in] phi_global (vector of) precision parameter(s) * @param N number of cases * @param M number of attributes * @param is_alpha_vector 0 or 1 - whether alpha is a vector (alternatively * it is a scalar) * @param is_phi_vector 0 or 1 - whether phi is a vector (alternatively it * is a scalar) * @param need_theta_derivative whether theta_derivative needs to be * computed * @param need_theta_derivative_sum whether theta_derivative_sum needs to be * computed * @param need_phi_derivative whether phi_derivative needs to be computed * @param need_phi_derivative_sum whether phi_derivative_sum needs to be * computed * @param need_logp1 interpreted as boolean - whether first part logp_global * needs to be computed * @param need_logp2 interpreted as boolean - whether second part * logp_global needs to be computed * @param need_logp3 interpreted as boolean - whether third part logp_global * needs to be computed * @param need_logp4 interpreted as boolean - whether fourth part * logp_global needs to be computed * @param need_logp5 interpreted as boolean - whether fifth part logp_global * needs to be computed */ __kernel void neg_binomial_2_log_glm( __global double* logp_global, __global double* theta_derivative_global, __global double* theta_derivative_sum, __global double* phi_derivative_global, const __global int* y_global, const __global double* x, const __global double* alpha, const __global double* beta, const __global double* phi_global, const int N, const int M, const int is_alpha_vector, const int is_phi_vector, const int need_theta_derivative, const int need_theta_derivative_sum, const int need_phi_derivative, const int need_phi_derivative_sum, const int need_logp1, const int need_logp2, const int need_logp3, const int need_logp4, const int need_logp5) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wgid = get_group_id(0); __local double res_loc[LOCAL_SIZE_]; double logp = 0; double phi_derivative = 0; double theta_derivative = 0; // Most calculations only happen for relevant data within next if. // Exceptions are reductions between threads that need barriers. if (gid < N) { double theta = 0; for (int i = 0, j = 0; i < M; i++, j += N) { theta += x[j + gid] * beta[i]; } double phi = phi_global[gid * is_phi_vector]; double y = y_global[gid]; if (!isfinite(theta) || y < 0 || !isfinite(phi)) { logp = NAN; } theta += alpha[gid * is_alpha_vector]; double log_phi = log(phi); double logsumexp_theta_logphi; if (theta > log_phi) { logsumexp_theta_logphi = theta + log1p(exp(log_phi - theta)); } else { logsumexp_theta_logphi = log_phi + log1p(exp(theta - log_phi)); } double y_plus_phi = y + phi; if (need_logp1) { logp -= lgamma(y + 1); } if (need_logp2) { logp -= lgamma(phi); if (phi != 0) { logp += phi * log(phi); } } if (need_logp3) { logp -= y_plus_phi * logsumexp_theta_logphi; } if (need_logp4) { logp += y * theta; } if (need_logp5) { logp += lgamma(y_plus_phi); } double theta_exp = exp(theta); theta_derivative = y - theta_exp * y_plus_phi / (theta_exp + phi); if (need_theta_derivative) { theta_derivative_global[gid] = theta_derivative; } if (need_phi_derivative) { phi_derivative = 1 - y_plus_phi / (theta_exp + phi) + log_phi - logsumexp_theta_logphi + digamma(y_plus_phi) - digamma(phi); if (!need_phi_derivative_sum) { phi_derivative_global[gid] = phi_derivative; } } } // Sum logp, calculated by different threads. // Since we can't sum between different work groups, we emit one number // per work group. These must be summed on CPU for final result. res_loc[lid] = logp; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { res_loc[lid] += res_loc[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { logp_global[wgid] = res_loc[0]; } if (need_theta_derivative_sum) { // Sum theta_derivative, calculated by different threads. barrier(CLK_LOCAL_MEM_FENCE); res_loc[lid] = theta_derivative; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { res_loc[lid] += res_loc[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { theta_derivative_sum[wgid] = res_loc[0]; } } if (need_phi_derivative_sum) { // Sum phi_derivative, calculated by different threads. barrier(CLK_LOCAL_MEM_FENCE); res_loc[lid] = phi_derivative; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { res_loc[lid] += res_loc[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { phi_derivative_global[wgid] = res_loc[0]; } } } // \cond ); // \endcond /** * See the docs for \link kernels/subtract.hpp subtract() \endlink */ const kernel_cl neg_binomial_2_log_glm("neg_binomial_2_log_glm", {digamma_device_function, neg_binomial_2_log_glm_kernel_code}, {{"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/identity.hpp0000644000176200001440000000732613766554456024273 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_IDENTITY_HPP #define STAN_MATH_OPENCL_KERNELS_IDENTITY_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string identity_kernel_code = STRINGIFY( // \endcond /** * Makes an identity matrix on the OpenCL device * * @param[in,out] A The identity matrix output. * @param rows The number of rows for A. * @param cols The number of cols for A. * @note Code is a const char* held in * identity_kernel_code. * Used in math/opencl/identity_opencl.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void identity(__global double* A, unsigned int rows, unsigned int cols) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { if (i == j) { A(i, j) = 1.0; } else { A(i, j) = 0.0; } } } // \cond ); // \endcond // \cond static const std::string batch_identity_kernel_code = STRINGIFY( // \endcond /** * Makes a batch of smaller identity matrices inside the input matrix * * This kernel operates inplace on the matrix A, filling it with smaller * identity matrices with a size of batch_rows x batch_rows. * This kernel expects a 3D organization of threads: * 1st dim: the number of matrices in the batch. * 2nd dim: the number of cols/rows in batch matrices. * 3rd dim: the number of cols/rows in batch matrices. * Each thread in the organization assigns a single value in the batch. * In order to create a batch of 3 matrices the size of NxN you need * to run the kernel batch_identity(A, N, 3*N*N) with (3, N, N) threads. * The special case of batch_identity(A, N, N*N) executed on * (1, N, N) threads creates a single identity matrix the size of NxN and * is therefore equal to the basic identity kernel. * * @param[in,out] A The batched identity matrix output. * @param batch_rows The number of rows/cols for the smaller matrices in the * batch * @param size The size of A. * @note Code is a const char* held in * identity_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void batch_identity(__global double* A, unsigned int batch_rows, unsigned int size) { // The ID of the matrix in the batch the thread is assigned to int batch_id = get_global_id(0); // The row and column of the matrix in the batch int batch_row = get_global_id(1); int batch_col = get_global_id(2); int index = batch_id * batch_rows * batch_rows + batch_col * batch_rows + batch_row; // Check for potential overflows of A. if (index < size) { if (batch_row == batch_col) { A[index] = 1.0; } else { A[index] = 0.0; } } } // \cond ); // \endcond /** * See the docs for \link kernels/identity.hpp identity() \endlink */ const kernel_cl identity("identity", {indexing_helpers, identity_kernel_code}); /** * See the docs for \link kernels/identity.hpp batch_identity() \endlink */ const kernel_cl batch_identity( "batch_identity", {indexing_helpers, batch_identity_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/gp_exp_quad_cov.hpp0000644000176200001440000000703113766554456025576 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_GP_EXP_QUAD_COV_HPP #define STAN_MATH_OPENCL_KERNELS_GP_EXP_QUAD_COV_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string gp_exp_quad_cov_kernel_code = STRINGIFY( // \endcond /** * GPU part of calculation of squared exponential kernel. * * @param[in] x input vector or matrix * @param[out] res squared distances between elements of x * @param sigma_sq squared standard deviation * @param neg_half_inv_l_sq -0.5 / square(length scale) * @param size number of elements in x * @param element_size the number of doubles that make one element of x */ __kernel void gp_exp_quad_cov(const __global double* x, __global double* res, const double sigma_sq, const double neg_half_inv_l_sq, const int size, const int element_size) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < size && j < (size - 1) && i > j) { double sum = 0; for (int k = 0; k < element_size; k++) { double d = x[i * element_size + k] - x[j * element_size + k]; sum += d * d; } double a = sigma_sq * exp(neg_half_inv_l_sq * sum); res[j * size + i] = a; res[i * size + j] = a; } else if (i == j) { res[j * size + i] = sigma_sq; } } // \cond ); // \endcond /** * See the docs for \link kernels/gp_exp_quad_cov.hpp gp_exp_quad_cov() \endlink */ const kernel_cl gp_exp_quad_cov("gp_exp_quad_cov", {gp_exp_quad_cov_kernel_code}); // \cond static const std::string gp_exp_quad_cov_cross_kernel_code = STRINGIFY( // \endcond /** * GPU part of calculation of squared exponential kernel. * * This function is for the cross covariance * matrix needed to compute the posterior predictive density. * * @param[in] x1 first input vector or matrix * @param[in] x2 second input vector or matrix * @param[out] res squared distances between elements of x * @param sigma_sq squared standard deviation * @param neg_half_inv_l_sq -0.5 / square(length scale) * @param size1 number of elements in x1 * @param size2 number of elements in x2 * @param element_size the number of doubles that make one element of x and * y */ __kernel void gp_exp_quad_cov_cross( const __global double* x1, const __global double* x2, __global double* res, const double sigma_sq, const double neg_half_inv_l_sq, const int size1, const int size2, const int element_size) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < size1 && j < size2) { double sum = 0; for (int k = 0; k < element_size; k++) { double d = x1[i * element_size + k] - x2[j * element_size + k]; sum += d * d; } res[j * size1 + i] = sigma_sq * exp(neg_half_inv_l_sq * sum); } } // \cond ); // \endcond /** * See the docs for \link kernels/gp_exp_quad_cov.hpp gp_exp_quad_cov_cross() * \endlink */ const kernel_cl gp_exp_quad_cov_cross("gp_exp_quad_cov_cross", {gp_exp_quad_cov_cross_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/fill.hpp0000644000176200001440000000623713766554456023370 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_FILL_HPP #define STAN_MATH_OPENCL_KERNELS_FILL_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string fill_kernel_code = STRINGIFY( // \endcond /** * Stores constant in the matrix on the OpenCL device. * Supports writing constants to the lower and upper triangular or * the whole matrix. * * @param[out] A matrix * @param val value to replicate in the matrix * @param rows Number of rows for matrix A * @param cols Number of columns for matrix A * @param view_A triangular part of matrix A to use * * @note Code is a const char* held in * fill_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void fill(__global double* A, double val, unsigned int rows, unsigned int cols, unsigned int view_A) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < rows && j < cols) { if ((contains_nonzero(view_A, LOWER) && j <= i) || (contains_nonzero(view_A, UPPER) && j >= i) || i == j) { A(i, j) = val; } } } // \cond ); // \endcond /** * See the docs for \link kernels/fill.hpp fill() \endlink */ const kernel_cl fill( "fill", {indexing_helpers, view_kernel_helpers, fill_kernel_code}); // \cond static const std::string fill_strict_tri_kernel_code = STRINGIFY( // \endcond /** * Stores constant in the triangular part of a matrix * on the OpenCL device. Supports writing constants * to the lower and upper triangular. The input * matrix is unchanged if used with any other view. * * @param[out] A matrix * @param val value to replicate in the matrix * @param rows Number of rows for matrix A * @param cols Number of columns for matrix A * @param view_A triangular part of matrix A to use * * @note Code is a const char* held in * fill_strict_tri_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void fill_strict_tri(__global double* A, double val, unsigned int rows, unsigned int cols, unsigned int view_A) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < rows && j < cols) { if ((view_A == LOWER && j < i) || (view_A == UPPER && j > i) || view_A == ENTIRE) { A(i, j) = val; } } } // \cond ); // \endcond /** * See the docs for \link kernels/fill.hpp fill_strict_tri_kernel_code() * \endlink */ const kernel_cl fill_strict_tri( "fill_strict_tri", {indexing_helpers, view_kernel_helpers, fill_strict_tri_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/subtract.hpp0000644000176200001440000000437513766554456024272 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_SUBTRACT_HPP #define STAN_MATH_OPENCL_KERNELS_SUBTRACT_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string subtract_kernel_code = STRINGIFY( // \endcond /** * Matrix subtraction on the OpenCL device * Subtracts the second matrix from the * first matrix and stores the result * in the third matrix (C=A-B). * * @param[out] C The output matrix. * @param[in] B RHS input matrix. * @param[in] A LHS input matrix. * @param rows The number of rows for matrix A. * @param cols The number of columns for matrix A. * @param view_A triangular part of matrix A to use * @param view_B triangular part of matrix B to use * @note Code is a const char* held in * subtract_kernel_code. * Used in math/opencl/subtract_opencl.hpp * This kernel uses the helper macros available in helpers.cl. */ __kernel void subtract(__global double *C, __global double *A, __global double *B, unsigned int rows, unsigned int cols, int view_A, int view_B) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { double a; if ((!contains_nonzero(view_A, LOWER) && j < i) || (!contains_nonzero(view_A, UPPER) && j > i)) { a = 0; } else { a = A(i, j); } double b; if ((!contains_nonzero(view_B, LOWER) && j < i) || (!contains_nonzero(view_B, UPPER) && j > i)) { b = 0; } else { b = B(i, j); } C(i, j) = a - b; } } // \cond ); // \endcond /** * See the docs for \link kernels/subtract.hpp subtract() \endlink */ const kernel_cl subtract("subtract", {indexing_helpers, view_kernel_helpers, subtract_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/rep_matrix.hpp0000644000176200001440000000427413766554456024613 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_REP_MATRIX_HPP #define STAN_MATH_OPENCL_KERNELS_REP_MATRIX_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string rep_matrix_kernel_code = STRINGIFY( // \endcond /** * Creates a matrix from a matrix_cl of size 1x1 by * replicating the single value or by replicating the * vector or row_vector input. * * @param[out] A result matrix * @param[in] B input matrix (1x1, vector or row_vector) * @param A_rows Number of rows for matrix A * @param A_cols Number of columns for matrix A * @param B_rows Number of rows for matrix B * @param B_cols Number of columns for matrix B * @param view_A triangular part of matrix A to use * * @note Code is a string held in rep_matrix_kernel_code. * This kernel uses the helper macros available in helpers.cl. */ __kernel void rep_matrix(__global double* A, __global double* B, unsigned int A_rows, unsigned int A_cols, unsigned int B_rows, unsigned int B_cols, unsigned int view_A) { const int i = get_global_id(0); const int j = get_global_id(1); if (i < A_rows && j < A_cols) { double val = 0; if (B_cols == 1 && B_rows == 1) { val = B[0]; } else if (B_cols == 1) { val = B[i]; } else if (B_rows == 1) { val = B[j]; } if ((contains_nonzero(view_A, LOWER) && j <= i) || (contains_nonzero(view_A, UPPER) && j >= i)) { A[j * A_rows + i] = val; } } } // \cond ); // \endcond /** * See the docs for \link kernels/rep_matrix.hpp rep_matrix() \endlink */ const kernel_cl rep_matrix("rep_matrix", {indexing_helpers, view_kernel_helpers, rep_matrix_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/inv_lower_tri_multiply.hpp0000644000176200001440000001377213766554456027265 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_INVERSE_LOWER_TRI_MULTIPLY_HPP #define STAN_MATH_OPENCL_KERNELS_INVERSE_LOWER_TRI_MULTIPLY_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string inv_lower_tri_multiply_kernel_code = STRINGIFY( // \endcond /** * Calculates B = C * A. C is an inverse matrix and A is lower triangular. * * This kernel is used in the final iteration of the batched lower * triangular inversion. * For a full guide to the inverse lower triangular kernels see the link * here. * The full inverse requires calculation of the lower left rectangular * matrix within the lower left triangular C3 = -C2*A3*C1. where C2 is the * inverse of the bottom right lower triangular, C1 is the inverse of the * upper left lower and A3 is the original lower triangulars lower left * rectangular. This kernel takes the output from * neg_rect_lower_tri_multiply and applies * the submatrix multiplcation to get the final output for C3. * ![Inverse Calculation](https://goo.gl/6jBjEG) * * Graphically, this kernel calculates the C2 * A3. * The kernel is executed using (N, N, m) threads, where N is the size of * the input matrices. * * @param[in] A input matrix that is being inverted. * @param[out] temp output matrix with results of the batched matrix * multiplications * @param A_rows The number of rows for A. * @param rows The number of rows in a single matrix of the batch * @note Code is a const char* held in * inv_lower_tri_multiply_kernel_code. * Used in math/opencl/tri_inverse.hpp. * This kernel uses the helper macros available in helpers.cl. */ __kernel void inv_lower_tri_multiply(__global double* A, __global double* temp, const int A_rows, const int rows) { int result_matrix_id = get_global_id(2); int offset = result_matrix_id * rows * 2; const int thread_block_row = get_local_id(0); const int thread_block_col = get_local_id(1); const int global_thread_row = THREAD_BLOCK_SIZE * get_group_id(0) + thread_block_row; const int global_thread_col = THREAD_BLOCK_SIZE * get_group_id(1) + thread_block_col; __local double C2_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; __local double A3_local[THREAD_BLOCK_SIZE][THREAD_BLOCK_SIZE]; double acc[WORK_PER_THREAD] = {0}; const int num_tiles = (rows + THREAD_BLOCK_SIZE - 1) / THREAD_BLOCK_SIZE; for (int tile_ind = 0; tile_ind < num_tiles; tile_ind++) { // Each thread copies WORK_PER_THREAD values to the local // memory for (int w = 0; w < WORK_PER_THREAD; w++) { const int tiled_i = THREAD_BLOCK_SIZE * tile_ind + thread_block_row; const int tiled_j = THREAD_BLOCK_SIZE * tile_ind + thread_block_col; // {C2}{A2}_global_{col}{row} specifies which global element for each // matrix the thread is in charge of moving to local memory. const int C2_global_col = offset + rows + tiled_j + w * THREAD_BLOCK_SIZE_COL; const int C2_global_row = offset + global_thread_row + rows; const int A3_global_col = offset + global_thread_col + w * THREAD_BLOCK_SIZE_COL; const int A3_global_row = tiled_i + rows + offset; // Which {col}{row} location in the local memory the thread is in // charge of. const int local_col = thread_block_col + w * THREAD_BLOCK_SIZE_COL; const int local_row = thread_block_row; // Element above the diagonal will not be transferred. if (C2_global_col <= C2_global_row && C2_global_col < A_rows && C2_global_row < A_rows) { C2_local[local_col][local_row] = A[C2_global_col * A_rows + C2_global_row]; } else { C2_local[local_col][local_row] = 0; } if (A3_global_col < A_rows && A3_global_row < A_rows) { A3_local[local_col][local_row] = A[A3_global_col * A_rows + A3_global_row]; } else { A3_local[local_col][local_row] = 0.0; } } // Wait until all tile values are loaded to the local memory barrier(CLK_LOCAL_MEM_FENCE); for (int block_ind = 0; block_ind < THREAD_BLOCK_SIZE; block_ind++) { for (int w = 0; w < WORK_PER_THREAD; w++) { const int local_col = thread_block_col + w * THREAD_BLOCK_SIZE_COL; const int local_row = thread_block_row; acc[w] += C2_local[block_ind][local_row] * A3_local[local_col][block_ind]; } } barrier(CLK_LOCAL_MEM_FENCE); } // Global offset for each resulting submatrix const int batch_offset = result_matrix_id * rows * rows; // temp_global_{row}{col} tells the thread which local memory it needs // to move to the final output const int temp_global_row = global_thread_row; // save the values for (int w = 0; w < WORK_PER_THREAD; w++) { // each thread saves WORK_PER_THREAD values const int temp_global_col = global_thread_col + w * THREAD_BLOCK_SIZE_COL; temp[batch_offset + temp_global_col * rows + temp_global_row] = acc[w]; } } // \cond ); // \endcond /** * See the docs for \link kernels/inv_lower_tri_multiply.hpp add() \endlink */ const kernel_cl inv_lower_tri_multiply( "inv_lower_tri_multiply", {thread_block_helpers, inv_lower_tri_multiply_kernel_code}, {{"THREAD_BLOCK_SIZE", 32}, {"WORK_PER_THREAD", 8}}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/scalar_mul.hpp0000644000176200001440000000323113766554456024553 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_SCALAR_MUL_HPP #define STAN_MATH_OPENCL_KERNELS_SCALAR_MUL_HPP #ifdef STAN_OPENCL #include #include #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string scalar_mul_kernel_code = STRINGIFY( // \endcond /** * Multiplication of the matrix A with a scalar * * @param[out] A output matrix * @param[in] B input matrix * @param[in] scalar the value with which to multiply A * @param[in] rows the number of rows in A * @param[in] cols the number of columns in A * @param[in] view triangular view of the input matrix to use */ __kernel void scalar_mul(__global double *A, const __global double *B, const double scalar, const unsigned int rows, const unsigned int cols, int view) { int i = get_global_id(0); int j = get_global_id(1); if (i < rows && j < cols) { if (!((!contains_nonzero(view, LOWER) && j < i) || (!contains_nonzero(view, UPPER) && j > i))) { A(i, j) = B(i, j) * scalar; } else { A(i, j) = 0; } } } // \cond ); // \endcond /** * See the docs for \link kernels/scalar_mul.hpp add() \endlink */ const kernel_cl scalar_mul("scalar_mul", {indexing_helpers, view_kernel_helpers, scalar_mul_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/kernels/categorical_logit_glm_lpmf.hpp0000644000176200001440000002057013766554456027766 0ustar liggesusers#ifndef STAN_MATH_OPENCL_KERNELS_CATEGORICAL_LOGIT_GLM_LPMF_HPP #define STAN_MATH_OPENCL_KERNELS_CATEGORICAL_LOGIT_GLM_LPMF_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { namespace opencl_kernels { // \cond static const std::string categorical_logit_glm_kernel_code = STRINGIFY( // \endcond /** * GPU implementation of Generalized Linear Model (GLM) * with categorical distribution and logit (softmax) link function. * * Must be run with at least N threads and local size equal to LOCAL_SIZE_. * @param[out] logp_global partially summed log probabiltiy (1 value per * work group) * @param[out] exp_lin_global exponentiation of sum of alpha and matrix * product of x and beta * @param[out] inv_sum_exp_lin_global inverse of rowwise sum of \c * exp_lin_global * @param[out] neg_softmax_lin_global negated softmax of sum of alpha and * matrix product of x and beta * @param[out] alpha_derivative derivative wrt alpha * @param[in] y_global a scalar or vector of classes. * @param[in] x_beta_global product of design matrix and weight matrix * @param[in] alpha_global intercept (in log odds) * @param N_instances number of instances * @param N_attributes number of attributes * @param N_classes number of classes * @param is_y_vector 0 or 1 - whether y is a vector (alternatively it is a * scalar) * @param need_alpha_derivative interpreted as boolean - whether * alpha_derivative needs to be computed * @param need_neg_softmax_lin_global interpreted as boolean - whether * neg_softmax_lin_global needs to be computed */ __kernel void categorical_logit_glm( __global double* logp_global, __global double* exp_lin_global, __global double* inv_sum_exp_lin_global, __global double* neg_softmax_lin_global, __global double* alpha_derivative, const __global int* y_global, const __global double* x_beta_global, const __global double* alpha_global, const int N_instances, const int N_attributes, const int N_classes, const int is_y_vector, const int need_alpha_derivative, const int need_neg_softmax_lin_global) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wg_id = get_group_id(0); const int ngroups = get_num_groups(0); __local double local_storage[LOCAL_SIZE_]; double logp = 0; double inv_sum_exp_lin; int class_idx = -1; // Most calculations only happen for relevant data within next if. // Exceptions are reductions between threads that need barriers. if (gid < N_instances) { double lin_max = -INFINITY; for (int i = 0; i < N_classes; i++) { double lin = x_beta_global[i * N_instances + gid] + alpha_global[i]; if (lin > lin_max) { lin_max = lin; } } double alpha = alpha_global[gid]; double sum_exp_lin = 0; for (int i = 0; i < N_classes; i++) { double lin = x_beta_global[i * N_instances + gid] + alpha_global[i]; double exp_lin = exp(lin - lin_max); sum_exp_lin += exp_lin; exp_lin_global[i * N_instances + gid] = exp_lin; } inv_sum_exp_lin = 1 / sum_exp_lin; inv_sum_exp_lin_global[gid] = inv_sum_exp_lin; class_idx = y_global[gid * is_y_vector] - 1; if (class_idx < 0 || class_idx > N_classes) { logp = NAN; } else { logp = log(inv_sum_exp_lin) - lin_max + x_beta_global[class_idx * N_instances + gid] + alpha_global[class_idx]; } } barrier(CLK_GLOBAL_MEM_FENCE); double neg_softmax_lin_sum = 0; if (need_alpha_derivative || need_neg_softmax_lin_global) { for (int i = 0; i < N_classes; i++) { double neg_softmax_lin = 0; if (gid < N_instances) { int idx = i * N_instances + gid; neg_softmax_lin = -exp_lin_global[idx] * inv_sum_exp_lin; if (need_neg_softmax_lin_global) { neg_softmax_lin_global[idx] = neg_softmax_lin; } } if (need_alpha_derivative) { local_storage[lid] = neg_softmax_lin + (class_idx == i); barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { alpha_derivative[i * ngroups + wg_id] = local_storage[0]; } barrier(CLK_LOCAL_MEM_FENCE); } } } // Sum logp, calculated by different threads. // Since we can't sum between different work groups, we emit one number // per work group. These must be summed on CPU for final result. local_storage[lid] = logp; barrier(CLK_LOCAL_MEM_FENCE); for (int step = lsize / REDUCTION_STEP_SIZE; step > 0; step /= REDUCTION_STEP_SIZE) { if (lid < step) { for (int i = 1; i < REDUCTION_STEP_SIZE; i++) { local_storage[lid] += local_storage[lid + step * i]; } } barrier(CLK_LOCAL_MEM_FENCE); } if (lid == 0) { logp_global[wg_id] = local_storage[0]; } } // \cond ); // \endcond /** * See the docs for \link kernels/categorical_logit_glm_lpmf.hpp * categorical_logit_glm() \endlink */ const kernel_cl categorical_logit_glm("categorical_logit_glm", {categorical_logit_glm_kernel_code}, {{"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}); // \cond static const std::string categorical_logit_glm_beta_derivative_kernel_code = STRINGIFY( // \endcond /** * Calculates derivative wrt beta. * * Must be run with global size of local_size*N_attributes. * @param[in,out] beta_derivative derivative wrt beta * @param temp temporary workspace of size global_size*N_classes * @param[in] y a scalar or vector of classes * @param[in] x design matrix * @param N_instances number of instances * @param N_attributes number of attributes * @param N_classes number of classes * @param is_y_vector 0 or 1 - whether y is a vector (alternatively it * is a scalar) */ __kernel void categorical_logit_glm_beta_derivative( __global double* beta_derivative, __global double* temp, const __global int* y, const __global double* x, const int N_instances, const int N_attributes, const int N_classes, const int is_y_vector) { const int gid = get_global_id(0); const int lid = get_local_id(0); const int lsize = get_local_size(0); const int wg_id = get_group_id(0); for (int i = 0; i < N_classes; i++) { temp[gid * N_classes + i] = 0; } for (int i = lid; i < N_instances; i += lsize) { int pos = y[i * is_y_vector] - 1; temp[gid * N_classes + pos] += x[wg_id * N_instances + i]; } barrier(CLK_GLOBAL_MEM_FENCE); for (int i = lid; i < N_classes; i += lsize) { double res = 0; for (int j = 0; j < lsize; j++) { res += temp[(wg_id * lsize + j) * N_classes + i]; } beta_derivative[i * N_attributes + wg_id] += res; } } // \cond ); // NOLINT // \endcond /** * See the docs for \link kernels/categorical_logit_glm_lpmf.hpp * categorical_logit_glm_beta_derivative() \endlink */ const kernel_cl categorical_logit_glm_beta_derivative( "categorical_logit_glm_beta_derivative", {categorical_logit_glm_beta_derivative_kernel_code}); } // namespace opencl_kernels } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/opencl_context.hpp0000644000176200001440000003463713766554456024030 0ustar liggesusers#ifndef STAN_MATH_OPENCL_OPENCL_CONTEXT_HPP #define STAN_MATH_OPENCL_OPENCL_CONTEXT_HPP #ifdef STAN_OPENCL #define DEVICE_FILTER CL_DEVICE_TYPE_ALL #ifndef OPENCL_DEVICE_ID #error OPENCL_DEVICE_ID_NOT_SET #endif #ifndef OPENCL_PLATFORM_ID #error OPENCL_PLATFORM_ID_NOT_SET #endif #include #include #include #include #include #include #include #include #include #include #include /** * @file stan/math/opencl/opencl_context.hpp * @brief Initialization for OpenCL: * 1. create context * 2. Find OpenCL platforms and devices available * 3. set up command queue * 4. set architecture dependent kernel parameters */ namespace stan { namespace math { /** * The opencl_context_base class represents an OpenCL context * in the standard Meyers singleton design pattern. * * See the OpenCL specification glossary for a list of terms: * https://www.khronos.org/registry/OpenCL/specs/opencl-1.2.pdf. * The context includes the set of devices available on the host, command * queues, manages kernels. * * This is designed so there's only one instance running on the host. * * Some design decisions that may need to be addressed later: * - we are assuming a single OpenCL platform. We may want to run on multiple * platforms simulatenously * - we are assuming a single OpenCL device. We may want to run on multiple * devices simulatenously */ class opencl_context_base { friend class opencl_context; private: /** * Construct the opencl_context by initializing the * OpenCL context, devices, command queues, and kernel * groups. * * This constructor does the following: * 1. Gets the available platforms and selects the platform * with id OPENCL_PLATFORM_ID. * 2. Gets the available devices and selects the device with id * OPENCL_DEVICE_ID. * 3. Creates the OpenCL context with the device. * 4. Creates the OpenCL command queue for the selected device. * 5. Sets OpenCL device dependent kernel parameters * @throw std::system_error if an OpenCL error occurs. */ opencl_context_base() { try { // platform cl::Platform::get(&platforms_); if (OPENCL_PLATFORM_ID >= platforms_.size()) { system_error("OpenCL Initialization", "[Platform]", -1, "CL_INVALID_PLATFORM"); } platform_ = platforms_[OPENCL_PLATFORM_ID]; platform_name_ = platform_.getInfo(); platform_.getDevices(DEVICE_FILTER, &devices_); if (devices_.size() == 0) { system_error("OpenCL Initialization", "[Device]", -1, "CL_DEVICE_NOT_FOUND"); } if (OPENCL_DEVICE_ID >= devices_.size()) { system_error("OpenCL Initialization", "[Device]", -1, "CL_INVALID_DEVICE"); } device_ = devices_[OPENCL_DEVICE_ID]; // context and queue cl_command_queue_properties device_properties; device_.getInfo(CL_DEVICE_QUEUE_PROPERTIES, &device_properties); device_.getInfo(CL_DEVICE_MAX_WORK_GROUP_SIZE, &max_thread_block_size_); context_ = cl::Context(device_); if (device_properties & CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE) { command_queue_ = cl::CommandQueue( context_, device_, CL_QUEUE_OUT_OF_ORDER_EXEC_MODE_ENABLE, nullptr); in_order_ = CL_FALSE; } else { command_queue_ = cl::CommandQueue(context_, device_, 0, nullptr); in_order_ = CL_TRUE; } int thread_block_size_sqrt = static_cast(sqrt(static_cast(max_thread_block_size_))); // Does a compile time check of the maximum allowed // dimension of a square thread block size // WG size of (32,32) works on all recent GPUs but would fail on some // older integrated GPUs or CPUs if (thread_block_size_sqrt < base_opts_["THREAD_BLOCK_SIZE"]) { base_opts_["THREAD_BLOCK_SIZE"] = thread_block_size_sqrt; base_opts_["WORK_PER_THREAD"] = 1; } if (max_thread_block_size_ < base_opts_["LOCAL_SIZE_"]) { // must be a power of base_opts_["REDUCTION_STEP_SIZE"] const int p = std::log(max_thread_block_size_) / std::log(base_opts_["REDUCTION_STEP_SIZE"]); base_opts_["LOCAL_SIZE_"] = std::pow(base_opts_["REDUCTION_STEP_SIZE"], p); } // Thread block size for the Cholesky // TODO(Steve): This should be tuned in a higher part of the stan language if (max_thread_block_size_ >= 256) { tuning_opts_.cholesky_min_L11_size = 256; } else { tuning_opts_.cholesky_min_L11_size = max_thread_block_size_; } } catch (const cl::Error& e) { check_opencl_error("opencl_context", e); } } protected: cl::Context context_; // Manages the the device, queue, platform, memory,etc. cl::CommandQueue command_queue_; // job queue for device, one per device std::vector platforms_; // Vector of available platforms cl::Platform platform_; // The platform for compiling kernels std::string platform_name_; // The platform such as NVIDIA OpenCL or AMD SDK std::vector devices_; // All available OpenCL devices cl::Device device_; // The selected OpenCL device std::string device_name_; // The name of OpenCL device size_t max_thread_block_size_; // The maximum size of a block of workers on // the device bool in_order_; // Whether to use out of order execution. // Holds Default parameter values for each Kernel. using map_base_opts = std::map; map_base_opts base_opts_ = {{"LOWER", static_cast(matrix_cl_view::Lower)}, {"UPPER", static_cast(matrix_cl_view::Upper)}, {"ENTIRE", static_cast(matrix_cl_view::Entire)}, {"DIAGONAL", static_cast(matrix_cl_view::Diagonal)}, {"UPPER_TO_LOWER", static_cast(TriangularMapCL::UpperToLower)}, {"LOWER_TO_UPPER", static_cast(TriangularMapCL::LowerToUpper)}, {"THREAD_BLOCK_SIZE", 32}, {"WORK_PER_THREAD", 8}, {"REDUCTION_STEP_SIZE", 4}, {"LOCAL_SIZE_", 64}}; // TODO(Steve): Make these tunable during warmup struct tuning_struct { // Used in math/opencl/cholesky_decompose int cholesky_min_L11_size = 256; int cholesky_partition = 4; int cholesky_size_worth_transfer = 1250; // Used in math/rev/mat/fun/cholesky_decompose int cholesky_rev_min_block_size = 512; int cholesky_rev_block_partition = 8; // used in math/opencl/multiply int multiply_wgs_per_compute_unit = 5; // used in math/prim/mat/fun/gp_exp_quad_cov double gp_exp_quad_cov_complex = 1'000'000; double gp_exp_quad_cov_simple = 1'250; // used in math/prim/mat/fun/multiply // and math/rev/mat/fun/multiply int multiply_dim_prod_worth_transfer = 2000000; // used in math/prim/mat/fun/mdivide_left_tri // and math/rev/mat/fun/mdivide_left_tri int tri_inverse_size_worth_transfer = 100; } tuning_opts_; static opencl_context_base& getInstance() { static opencl_context_base instance_; return instance_; } opencl_context_base(opencl_context_base const&) = delete; void operator=(opencl_context_base const&) = delete; }; /** * The API to access the methods and values in opencl_context_base */ class opencl_context { public: opencl_context() = default; /** * Returns the description of the OpenCL platform and device that is used. * Devices will be an OpenCL and Platforms are a specific OpenCL implimenation * such as AMD SDK's or Nvidia's OpenCL implimentation. */ inline std::string description() const { std::ostringstream msg; msg << "Platform ID: " << OPENCL_DEVICE_ID << "\n"; msg << "Platform Name: " << opencl_context_base::getInstance() .platform_.getInfo() << "\n"; msg << "Platform Vendor: " << opencl_context_base::getInstance() .platform_.getInfo() << "\n"; msg << "\tDevice " << OPENCL_DEVICE_ID << ": " << "\n"; msg << "\t\tDevice Name: " << opencl_context_base::getInstance().device_.getInfo() << "\n"; msg << "\t\tDevice Type: " << opencl_context_base::getInstance().device_.getInfo() << "\n"; msg << "\t\tDevice Vendor: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; msg << "\t\tDevice Max Compute Units: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; msg << "\t\tDevice Global Memory: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; msg << "\t\tDevice Max Clock Frequency: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; msg << "\t\tDevice Max Allocateable Memory: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; msg << "\t\tDevice Local Memory: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; msg << "\t\tDevice Available: " << opencl_context_base::getInstance() .device_.getInfo() << "\n"; return msg.str(); } /** * Returns the description of the OpenCL platforms and devices that * are available. Devices will be an OpenCL and Platforms are a specific * OpenCL implimenation such as AMD SDK's or Nvidia's OpenCL implimentation. */ inline std::string capabilities() const { std::vector all_platforms; cl::Platform::get(&all_platforms); std::ostringstream msg; int platform_id = 0; int device_id = 0; msg << "Number of Platforms: " << all_platforms.size() << "\n"; for (auto plat_iter : all_platforms) { cl::Platform platform(plat_iter); msg << "Platform ID: " << platform_id++ << "\n"; msg << "Platform Name: " << platform.getInfo() << "\n"; msg << "Platform Vendor: " << platform.getInfo() << "\n"; try { std::vector all_devices; platform.getDevices(CL_DEVICE_TYPE_ALL, &all_devices); for (auto device_iter : all_devices) { cl::Device device(device_iter); msg << "\tDevice " << device_id++ << ": " << "\n"; msg << "\t\tDevice Name: " << device.getInfo() << "\n"; msg << "\t\tDevice Type: " << device.getInfo() << "\n"; msg << "\t\tDevice Vendor: " << device.getInfo() << "\n"; msg << "\t\tDevice Max Compute Units: " << device.getInfo() << "\n"; msg << "\t\tDevice Global Memory: " << device.getInfo() << "\n"; msg << "\t\tDevice Max Clock Frequency: " << device.getInfo() << "\n"; msg << "\t\tDevice Max Allocateable Memory: " << device.getInfo() << "\n"; msg << "\t\tDevice Local Memory: " << device.getInfo() << "\n"; msg << "\t\tDevice Available: " << device.getInfo() << "\n"; } } catch (const cl::Error& e) { // if one of the platforms have no devices that match the device type // it will throw the error == -1 (DEVICE_NOT_FOUND) // other errors will throw a system error if (e.err() == -1) { msg << "\tno (OpenCL) devices in the platform with ID " << platform_id << "\n"; } else { check_opencl_error("capabilities", e); } } } return msg.str(); } /** * Returns the reference to the OpenCL context. The OpenCL context manages * objects such as the device, memory, command queue, program, and kernel * objects. For stan, there should only be one context, queue, device, and * program with multiple kernels. */ inline cl::Context& context() { return opencl_context_base::getInstance().context_; } /** * Returns the reference to the active OpenCL command queue for the device. * One command queue will exist per device where * kernels are placed on the command queue and by default executed in order. */ inline cl::CommandQueue& queue() { return opencl_context_base::getInstance().command_queue_; } /** * Returns a copy of the map of kernel defines */ inline opencl_context_base::map_base_opts base_opts() { return opencl_context_base::getInstance().base_opts_; } /** * Returns the maximum thread block size defined by * CL_DEVICE_MAX_WORK_GROUP_SIZE for the device in the context. This is the * maximum product of thread block dimensions for a particular device. IE a * max workgoup of 256 would allow thread blocks of sizes (16,16), (128,2), * (8, 32), etc. */ inline int max_thread_block_size() { return opencl_context_base::getInstance().max_thread_block_size_; } /** * Returns the thread block size for the Cholesky Decompositions L_11. */ inline opencl_context_base::tuning_struct& tuning_opts() { return opencl_context_base::getInstance().tuning_opts_; } /** * Returns a vector containing the OpenCL device used to create the context */ inline std::vector device() { return {opencl_context_base::getInstance().device_}; } /** * Returns a vector containing the OpenCL platform used to create the context */ inline std::vector platform() { return {opencl_context_base::getInstance().platform_}; } /** * Return a bool representing whether the write to the OpenCL device are * blocking */ inline bool in_order() { return opencl_context_base::getInstance().in_order_; } }; static opencl_context opencl_context; } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/matrix_cl.hpp0000644000176200001440000003765213766554456022766 0ustar liggesusers#ifndef STAN_MATH_OPENCL_MATRIX_CL_HPP #define STAN_MATH_OPENCL_MATRIX_CL_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include /** * @file stan/math/opencl/matrix_cl.hpp * @brief The matrix_cl class - allocates memory space on the OpenCL device, * functions for transfering matrices to and from OpenCL devices */ namespace stan { namespace math { /** * Represents a matrix on the OpenCL device. * @tparam T an arithmetic type for the type stored in the OpenCL buffer. */ template class matrix_cl> { private: cl::Buffer buffer_cl_; // Holds the allocated memory on the device int rows_{0}; int cols_{0}; // Holds info on if matrix is a special type matrix_cl_view view_{matrix_cl_view::Entire}; mutable std::vector write_events_; // Tracks write jobs mutable std::vector read_events_; // Tracks reads public: using Scalar = T; using type = T; // Forward declare the methods that work in place on the matrix template void zeros(); template void zeros_strict_tri(); template void triangular_transpose(); void sub_block(const matrix_cl>& A, size_t A_i, size_t A_j, size_t this_i, size_t this_j, size_t nrows, size_t ncols); int rows() const { return rows_; } int cols() const { return cols_; } int size() const { return rows_ * cols_; } const matrix_cl_view& view() const { return view_; } void view(const matrix_cl_view& view) { view_ = view; } /** * Clear the write events from the event stacks. */ inline void clear_write_events() const { write_events_.clear(); return; } /** * Clear the read events from the event stacks. */ inline void clear_read_events() const { read_events_.clear(); return; } /** * Clear the write events from the event stacks. */ inline void clear_read_write_events() const { read_events_.clear(); write_events_.clear(); return; } /** * Get the events from the event stacks. * @return The write event stack. */ inline const std::vector& write_events() const { return write_events_; } /** * Get the events from the event stacks. * @return The read/write event stack. */ inline const std::vector& read_events() const { return read_events_; } /** * Get the events from the event stacks. * @return The read/write event stack. */ inline const std::vector read_write_events() const { return vec_concat(this->read_events(), this->write_events()); } /** * Add an event to the read event stack. * @param new_event The event to be pushed on the event stack. */ inline void add_read_event(cl::Event new_event) const { this->read_events_.push_back(new_event); } /** * Add an event to the write event stack. * @param new_event The event to be pushed on the event stack. */ inline void add_write_event(cl::Event new_event) const { this->write_events_.push_back(new_event); } /** * Add an event to the read/write event stack. * @param new_event The event to be pushed on the event stack. */ inline void add_read_write_event(cl::Event new_event) const { this->read_events_.push_back(new_event); this->write_events_.push_back(new_event); } /** * Waits for the write events and clears the read event stack. */ inline void wait_for_write_events() const { cl::CommandQueue queue = opencl_context.queue(); cl::Event copy_event; queue.enqueueBarrierWithWaitList(&this->write_events(), ©_event); copy_event.wait(); write_events_.clear(); return; } /** * Waits for the read events and clears the read event stack. */ inline void wait_for_read_events() const { cl::CommandQueue queue = opencl_context.queue(); cl::Event copy_event; queue.enqueueBarrierWithWaitList(&this->read_events(), ©_event); copy_event.wait(); read_events_.clear(); return; } /** * Waits for read and write events to finish and clears the read, write, and * read/write event stacks. */ inline void wait_for_read_write_events() const { cl::CommandQueue queue = opencl_context.queue(); cl::Event copy_event; const std::vector mat_events = this->read_write_events(); queue.enqueueBarrierWithWaitList(&mat_events, ©_event); copy_event.wait(); read_events_.clear(); write_events_.clear(); return; } const cl::Buffer& buffer() const { return buffer_cl_; } cl::Buffer& buffer() { return buffer_cl_; } matrix_cl() {} /** * Construct a matrix_cl from an existing cl::Buffer object. The matrix * directly uses given buffer - no copying is done. * * @param A the cl::Buffer object to construct the matrix from * @param R number of rows * @param C number of columns * @param partial_view view of the matrix */ matrix_cl(cl::Buffer& A, const int R, const int C, matrix_cl_view partial_view = matrix_cl_view::Entire) : buffer_cl_(A), rows_(R), cols_(C), view_(partial_view) {} matrix_cl(const matrix_cl& A) : rows_(A.rows()), cols_(A.cols()), view_(A.view()) { if (A.size() == 0) { return; } this->wait_for_read_write_events(); cl::Context& ctx = opencl_context.context(); cl::CommandQueue queue = opencl_context.queue(); try { buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * this->size()); cl::Event cstr_event; queue.enqueueCopyBuffer(A.buffer(), this->buffer(), 0, 0, A.size() * sizeof(T), &A.write_events(), &cstr_event); this->add_write_event(cstr_event); A.add_read_event(cstr_event); } catch (const cl::Error& e) { check_opencl_error("copy (OpenCL)->(OpenCL)", e); } } explicit matrix_cl(matrix_cl&& A) : buffer_cl_(std::move(A.buffer_cl_)), rows_(A.rows_), cols_(A.cols_), view_(A.view_), write_events_(std::move(A.write_events_)), read_events_(std::move(A.read_events_)) {} /** * Constructor for the matrix_cl that * creates a copy of the Eigen matrix on the OpenCL device. * * @param A the Eigen matrix * * @throw std::invalid_argument if the * matrices do not have matching dimensions */ template ..., require_same_st...> explicit matrix_cl(Vec&& A) try : rows_(A.empty() ? 0 : A[0].size()), cols_(A.size()) { if (this->size() == 0) { return; } cl::Context& ctx = opencl_context.context(); cl::CommandQueue& queue = opencl_context.queue(); // creates the OpenCL buffer to copy the Eigen // matrix to the OpenCL device buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * size()); for (int i = 0, offset_size = 0; i < cols_; i++, offset_size += rows_) { check_size_match("matrix constructor", "input rows", A[i].size(), "matrix_cl rows", rows_); /** * Writes the contents of A[i] to the OpenCL buffer * starting at the offset sizeof(double)*start. * CL_TRUE denotes that the call is blocking as * we do not want to execute any further kernels * on the device until we are sure that the data * is finished transfering */ cl::Event write_event; queue.enqueueWriteBuffer( buffer_cl_, opencl_context.in_order() || std::is_rvalue_reference::value, sizeof(T) * offset_size, sizeof(T) * rows_, A[i].data(), nullptr, &write_event); this->add_write_event(write_event); } } catch (const cl::Error& e) { check_opencl_error("matrix constructor", e); } /** * Constructor for the matrix_cl that * only allocates the buffer on the OpenCL device. * Regardless of `partial_view`, whole matrix is stored. * * @param rows number of matrix rows, must be greater or equal to 0 * @param cols number of matrix columns, must be greater or equal to 0 * @param partial_view which part of the matrix is used * * @throw std::system_error if the * matrices do not have matching dimensions * */ matrix_cl(const int rows, const int cols, matrix_cl_view partial_view = matrix_cl_view::Entire) : rows_(rows), cols_(cols), view_(partial_view) { if (size() == 0) { return; } cl::Context& ctx = opencl_context.context(); try { // creates the OpenCL buffer of the provided size buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * rows_ * cols_); } catch (const cl::Error& e) { check_opencl_error("matrix constructor", e); } } /** * Constructor for the matrix_cl that * creates a copy of the Eigen matrix on the OpenCL device. * Regardless of `partial_view`, whole matrix is stored. * * @tparam T type of data in the \c Eigen \c Matrix * @param A the \c Eigen \c Matrix * @param partial_view which part of the matrix is used * * @throw std::system_error if the * matrices do not have matching dimensions */ template ..., require_same_vt...> explicit matrix_cl(Mat&& A, matrix_cl_view partial_view = matrix_cl_view::Entire) : rows_(A.rows()), cols_(A.cols()), view_(partial_view) { if (size() == 0) { return; } cl::Context& ctx = opencl_context.context(); try { buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * A.size()); cl::Event transfer_event; cl::CommandQueue& queue = opencl_context.queue(); queue.enqueueWriteBuffer( this->buffer_cl_, opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(T) * A.size(), A.eval().data(), nullptr, &transfer_event); this->add_write_event(transfer_event); } catch (const cl::Error& e) { check_opencl_error("matrix constructor", e); } } /** * Constructor for the matrix_cl that * creates a copy of a scalar on the OpenCL device. * Regardless of `partial_view`, whole matrix is stored. * * @param A the scalar * @param partial_view which part of the matrix is used */ template >> explicit matrix_cl(Scal&& A, matrix_cl_view partial_view = matrix_cl_view::Diagonal) : rows_(1), cols_(1), view_(partial_view) { cl::Context& ctx = opencl_context.context(); cl::CommandQueue& queue = opencl_context.queue(); try { buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(std::decay_t)); cl::Event transfer_event; queue.enqueueWriteBuffer( buffer_cl_, opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(std::decay_t), &A, nullptr, &transfer_event); this->add_write_event(transfer_event); } catch (const cl::Error& e) { check_opencl_error("matrix constructor", e); } } /** * Construct a matrix_cl of size Nx1 from \c std::vector * * @param A Standard vector * @param partial_view which part of the matrix is used * @throw std::system_error if the * matrices do not have matching dimensions */ template ..., require_same_vt...> explicit matrix_cl(Vec&& A, matrix_cl_view partial_view = matrix_cl_view::Entire) : matrix_cl(std::forward(A), A.size(), 1) {} /** * Construct from \c std::vector with given rows and columns * * @param A Standard vector * @param R Number of rows the matrix should have. * @param C Number of columns the matrix should have. * @param partial_view which part of the matrix is used * @throw std::system_error if the * matrices do not have matching dimensions */ template ..., require_same_vt...> explicit matrix_cl(Vec&& A, const int& R, const int& C, matrix_cl_view partial_view = matrix_cl_view::Entire) : rows_(R), cols_(C), view_(partial_view) { if (size() == 0) { return; } cl::Context& ctx = opencl_context.context(); cl::CommandQueue& queue = opencl_context.queue(); try { buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * A.size()); cl::Event transfer_event; queue.enqueueWriteBuffer( buffer_cl_, opencl_context.in_order() || std::is_rvalue_reference::value, 0, sizeof(T) * A.size(), A.data(), nullptr, &transfer_event); this->add_write_event(transfer_event); } catch (const cl::Error& e) { check_opencl_error("matrix constructor", e); } } /** * Construct from \c array of doubles with given rows and columns * * @param A array of doubles * @param R Number of rows the matrix should have. * @param C Number of columns the matrix should have. * @param partial_view which part of the matrix is used * @throw std::system_error if the * matrices do not have matching dimensions */ template ...> explicit matrix_cl(const U* A, const int& R, const int& C, matrix_cl_view partial_view = matrix_cl_view::Entire) : rows_(R), cols_(C), view_(partial_view) { if (size() == 0) { return; } cl::Context& ctx = opencl_context.context(); cl::CommandQueue& queue = opencl_context.queue(); try { buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * size()); cl::Event transfer_event; queue.enqueueWriteBuffer(buffer_cl_, opencl_context.in_order(), 0, sizeof(T) * size(), A, nullptr, &transfer_event); this->add_write_event(transfer_event); } catch (const cl::Error& e) { check_opencl_error("matrix constructor", e); } } /** * Assign a \c matrix_cl to another */ matrix_cl& operator=(matrix_cl&& a) { view_ = a.view(); rows_ = a.rows(); cols_ = a.cols(); this->wait_for_read_write_events(); buffer_cl_ = std::move(a.buffer_cl_); write_events_ = std::move(a.write_events_); read_events_ = std::move(a.read_events_); return *this; } /** * Assign a \c matrix_cl to another */ matrix_cl& operator=(const matrix_cl& a) { this->view_ = a.view(); this->rows_ = a.rows(); this->cols_ = a.cols(); cl::Context& ctx = opencl_context.context(); cl::CommandQueue queue = opencl_context.queue(); try { buffer_cl_ = cl::Buffer(ctx, CL_MEM_READ_WRITE, sizeof(T) * this->size()); cl::Event cstr_event; queue.enqueueCopyBuffer(a.buffer(), this->buffer(), 0, 0, a.size() * sizeof(T), &a.write_events(), &cstr_event); this->add_write_event(cstr_event); a.add_read_event(cstr_event); } catch (const cl::Error& e) { check_opencl_error("copy (OpenCL)->(OpenCL)", e); } return *this; } }; // namespace math template using matrix_cl_prim = matrix_cl>; template using matrix_cl_fp = matrix_cl>; } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/value_type.hpp0000644000176200001440000000057213766554456023150 0ustar liggesusers#ifndef STAN_MATH_OPENCL_VALUE_TYPE_HPP #define STAN_MATH_OPENCL_VALUE_TYPE_HPP #ifdef STAN_OPENCL #include #include #include namespace stan { template struct value_type> { using type = typename std::decay_t::Scalar; }; } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/sub_block.hpp0000644000176200001440000000744413766554456022743 0ustar liggesusers#ifndef STAN_MATH_OPENCL_SUB_BLOCK_HPP #define STAN_MATH_OPENCL_SUB_BLOCK_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include #include namespace stan { namespace math { /** * Write the contents of A into * this starting at the top left of this * @param A input matrix * @param A_i the offset row in A * @param A_j the offset column in A * @param this_i the offset row for the matrix to be subset into * @param this_j the offset col for the matrix to be subset into * @param nrows the number of rows in the submatrix * @param ncols the number of columns in the submatrix */ template inline void matrix_cl>::sub_block( const matrix_cl>& A, size_t A_i, size_t A_j, size_t this_i, size_t this_j, size_t nrows, size_t ncols) try { if (nrows == 0 || ncols == 0) { return; } if ((A_i + nrows) > A.rows() || (A_j + ncols) > A.cols() || (this_i + nrows) > this->rows() || (this_j + ncols) > this->cols()) { domain_error("sub_block", "submatrix in *this", " is out of bounds", ""); } cl::CommandQueue cmdQueue = opencl_context.queue(); if (A.view() == matrix_cl_view::Entire) { std::array src_offset({A_i * sizeof(double), A_j, 0}); std::array dst_offset({this_i * sizeof(double), this_j, 0}); std::array size({nrows * sizeof(double), ncols, 1}); std::vector kernel_events = vec_concat(A.write_events(), this->read_write_events()); cl::Event copy_event; cmdQueue.enqueueCopyBufferRect(A.buffer(), this->buffer(), src_offset, dst_offset, size, A.rows() * sizeof(double), A.rows() * A.cols() * sizeof(double), sizeof(double) * this->rows(), this->rows() * this->cols() * sizeof(double), &kernel_events, ©_event); A.add_read_event(copy_event); this->add_write_event(copy_event); } else { opencl_kernels::sub_block(cl::NDRange(nrows, ncols), A, *this, A_i, A_j, this_i, this_j, nrows, ncols, A.rows(), A.cols(), this->rows(), this->cols(), A.view()); } // calculation of extreme sub- and super- diagonal written const int diag_in_copy = A_i - A_j; const int copy_low = contains_nonzero(A.view(), matrix_cl_view::Lower) ? 1 - nrows : diag_in_copy; const int copy_high = contains_nonzero(A.view(), matrix_cl_view::Upper) ? ncols - 1 : diag_in_copy; const int start = this_j - this_i; if (start + copy_low < 0) { this->view_ = either(this->view_, matrix_cl_view::Lower); } else if (this_i <= 1 && this_j == 0 && nrows + this_i >= rows_ && ncols >= std::min(rows_, cols_) - 1 && !contains_nonzero(A.view_, matrix_cl_view::Lower)) { this->view_ = both(this->view_, matrix_cl_view::Upper); } if (start + copy_high > 0) { this->view_ = either(this->view_, matrix_cl_view::Upper); } else if (this_i == 0 && this_j <= 1 && ncols + this_j >= cols_ && nrows >= std::min(rows_, cols_) - 1 && !contains_nonzero(A.view_, matrix_cl_view::Upper)) { this->view_ = both(this->view_, matrix_cl_view::Lower); } } catch (const cl::Error& e) { check_opencl_error("copy_submatrix", e); } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/cholesky_decompose.hpp0000644000176200001440000001042413766554456024647 0ustar liggesusers#ifndef STAN_MATH_OPENCL_CHOLESKY_DECOMPOSE_HPP #define STAN_MATH_OPENCL_CHOLESKY_DECOMPOSE_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include namespace stan { namespace math { namespace opencl { /** * Performs an in-place computation of the lower-triangular Cholesky factor * (i.e., matrix square root) of the specified square, symmetric matrix. The * return value \f$L\f$ will be a lower-traingular matrix such that the original * matrix \f$A\f$ is given by

\f$A = L \times L^T\f$. The Cholesky * decomposition is computed using an OpenCL kernel. This algorithm is * recursive. The matrix is subset into a matrix of size A.rows() / * 4, and if the submatrix size is less than 50 or min_block * then the cholesky decomposition on the OpenCL device is computed using that * submatrix. If the submatrix is greater than 50 or min_block then * cholesky_decompose is run again on a submatrix with size equal * to submat.rows() / 4. Once the Cholesky Decomposition is * computed, the full matrix cholesky is created by propogating the cholesky * forward as given in the reference report below. * * For a full guide to how this works * see the Cholesy decompostion chapter in the reference report * here. * @throw std::domain_error if m is not * positive definite (if m has more than 0 elements) */ template > inline void cholesky_decompose(matrix_cl& A) { if (A.rows() == 0) { return; } // Repeats the blocked cholesky decomposition until the size of the remaining // submatrix is smaller or equal to the minimum blocks size // or a heuristic of 100. // The Cholesky (OpenCL) algorithm only uses one local block so we need the // matrix To be less than the max thread block size. if (A.rows() <= opencl_context.tuning_opts().cholesky_min_L11_size) { try { opencl_kernels::cholesky_decompose(cl::NDRange(A.rows()), cl::NDRange(A.rows()), A, A.rows()); } catch (const cl::Error& e) { check_opencl_error("cholesky_decompose", e); } A.view(matrix_cl_view::Lower); return; } // NOTE: The code in this section follows the naming conventions // in the report linked in the docs. const int block = std::floor(A.rows() / opencl_context.tuning_opts().cholesky_partition); // Subset the top left block of the input A into A_11 matrix_cl A_11(block, block); A_11.sub_block(A, 0, 0, 0, 0, block, block); // The following function either calls the // blocked cholesky recursively for the submatrix A_11 // or calls the kernel directly if the size of the block is small enough opencl::cholesky_decompose(A_11); // Copies L_11 back to the input matrix A.sub_block(A_11, 0, 0, 0, 0, block, block); const int block_subset = A.rows() - block; matrix_cl A_21(block_subset, block); A_21.sub_block(A, block, 0, 0, 0, block_subset, block); // computes A_21*((L_11^-1)^T) // and copies the resulting submatrix to the lower left hand corner of A matrix_cl L_21 = A_21 * transpose(tri_inverse(A_11)); A.sub_block(L_21, 0, 0, block, 0, block_subset, block); matrix_cl A_22(block_subset, block_subset); A_22.sub_block(A, block, block, 0, 0, block_subset, block_subset); // computes A_22 - L_21*(L_21^T) matrix_cl L_22 = A_22 - multiply_transpose(L_21); // copy L_22 into A's lower left hand corner opencl::cholesky_decompose(L_22); A.sub_block(L_22, 0, 0, block, block, block_subset, block_subset); A.view(matrix_cl_view::Lower); } } // namespace opencl } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/copy_triangular.hpp0000644000176200001440000000303213766554456024167 0ustar liggesusers#ifndef STAN_MATH_OPENCL_COPY_TRIANGULAR_HPP #define STAN_MATH_OPENCL_COPY_TRIANGULAR_HPP #ifdef STAN_OPENCL #include #include #include #include #include #include #include namespace stan { namespace math { /** * Copies the lower or upper * triangular of the source matrix to * the destination matrix. * Both matrices are stored on the OpenCL device. * * @param src the source matrix * @tparam triangular_map int to describe * which part of the matrix to copy: * matrix_cl_view::Lower - copies the lower triangular * matrix_cl_view::Upper - copes the upper triangular * * @return the matrix with the copied content * */ template > inline matrix_cl copy_triangular(const matrix_cl& src) { if (src.size() == 0 || src.size() == 1) { matrix_cl dst(src); return dst; } matrix_cl_view dst_view = both(matrix_view, src.view()); matrix_cl dst(src.rows(), src.cols(), dst_view); try { opencl_kernels::copy_triangular(cl::NDRange(dst.rows(), dst.cols()), dst, src, dst.rows(), dst.cols(), dst_view); } catch (const cl::Error& e) { check_opencl_error("copy_triangular", e); } return dst; } } // namespace math } // namespace stan #endif #endif StanHeaders/inst/include/stan/math/opencl/is_matrix_cl.hpp0000644000176200001440000001003413766554456023442 0ustar liggesusers#ifndef STAN_MATH_OPENCL_IS_MATRIX_CL_HPP #define STAN_MATH_OPENCL_IS_MATRIX_CL_HPP #ifdef STAN_OPENCL #include #include namespace stan { namespace math { // Dummy class to instantiate matrix_cl to enable for specific types. template class matrix_cl { public: using Scalar = T; using type = T; }; } // namespace math namespace internal { /** * This underlying implimentation is used when the type is not an std vector. */ template struct is_matrix_cl_impl : std::false_type {}; /** * This specialization implimentation has a static member named value when the * template type is an std vector. */ template struct is_matrix_cl_impl> : std::true_type {}; } // namespace internal template struct is_matrix_cl : std::false_type {}; /** * Checks if the decayed type of T is a matrix_cl. */ template struct is_matrix_cl< T, std::enable_if_t>::value>> : std::true_type {}; template using require_matrix_cl_t = require_t>; template using require_not_matrix_cl_t = require_not_t>; template using require_all_matrix_cl_t = require_all_t...>; template using require_any_matrix_cl_t = require_any_t...>; template using require_all_not_matrix_cl_t = require_all_not_t...>; template using require_any_not_matrix_cl_t = require_any_not_t...>; /** * matrix_cl */ template