Skip to content

Commit

Permalink
fixing remap for a couple cpp files
Browse files Browse the repository at this point in the history
  • Loading branch information
@doserjef
doserjef committed Aug 31, 2024
1 parent 5898631 commit acecd18
Show file tree
Hide file tree
Showing 3 changed files with 74 additions and 73 deletions.
1 change: 1 addition & 0 deletions src/intPGOcc.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
#include <omp.h>
#endif

#define R_NO_REMAP
#include <R.h>
#include <Rmath.h>
#include <Rinternals.h>
Expand Down
121 changes: 60 additions & 61 deletions src/svcTPGOccNNGP.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@
#include <omp.h>
#endif

#define R_NO_REMAP
#include <R.h>
#include <Rmath.h>
#include <Rinternals.h>
Expand Down Expand Up @@ -48,8 +49,8 @@ void updateBFSVCT(double *B, double *F, double *c, double *C, double *coords, in
C[mm*threadID+l*nnIndxLU[n+i]+k] = sigmaSq*spCor(e, phi, nu, covModel, &bk[threadID*nb]);
}
}
F77_NAME(dpotrf)(&lower, &nnIndxLU[n+i], &C[mm*threadID], &nnIndxLU[n+i], &info FCONE); if(info != 0){error("c++ error: dpotrf failed\n");}
F77_NAME(dpotri)(&lower, &nnIndxLU[n+i], &C[mm*threadID], &nnIndxLU[n+i], &info FCONE); if(info != 0){error("c++ error: dpotri failed\n");}
F77_NAME(dpotrf)(&lower, &nnIndxLU[n+i], &C[mm*threadID], &nnIndxLU[n+i], &info FCONE); if(info != 0){Rf_error("c++ error: dpotrf failed\n");}
F77_NAME(dpotri)(&lower, &nnIndxLU[n+i], &C[mm*threadID], &nnIndxLU[n+i], &info FCONE); if(info != 0){Rf_error("c++ error: dpotri failed\n");}
F77_NAME(dsymv)(&lower, &nnIndxLU[n+i], &one, &C[mm*threadID], &nnIndxLU[n+i], &c[m*threadID], &inc, &zero, &B[nnIndxLU[i]], &inc FCONE);
F[i] = sigmaSq - F77_NAME(ddot)(&nnIndxLU[n+i], &B[nnIndxLU[i]], &inc, &c[m*threadID], &inc);
}else{
Expand Down Expand Up @@ -196,7 +197,7 @@ extern "C" {
omp_set_num_threads(nThreads);
#else
if(nThreads > 1){
warning("n.omp.threads > %i, but source not compiled with OpenMP support.", nThreads);
Rf_warning("n.omp.threads > %i, but source not compiled with OpenMP support.", nThreads);
nThreads = 1;
}
#endif
Expand Down Expand Up @@ -285,46 +286,46 @@ extern "C" {
* Return Stuff
* *******************************************************************/
SEXP betaSamples_r;
PROTECT(betaSamples_r = allocMatrix(REALSXP, pOcc, nPost)); nProtect++;
PROTECT(betaSamples_r = Rf_allocMatrix(REALSXP, pOcc, nPost)); nProtect++;
zeros(REAL(betaSamples_r), pOcc * nPost);
SEXP alphaSamples_r;
PROTECT(alphaSamples_r = allocMatrix(REALSXP, pDet, nPost)); nProtect++;
PROTECT(alphaSamples_r = Rf_allocMatrix(REALSXP, pDet, nPost)); nProtect++;
zeros(REAL(alphaSamples_r), pDet * nPost);
SEXP zSamples_r;
PROTECT(zSamples_r = allocMatrix(REALSXP, JnYears, nPost)); nProtect++;
PROTECT(zSamples_r = Rf_allocMatrix(REALSXP, JnYears, nPost)); nProtect++;
zeros(REAL(zSamples_r), JnYears * nPost);
SEXP wSamples_r;
PROTECT(wSamples_r = allocMatrix(REALSXP, JwpTilde, nPost)); nProtect++;
PROTECT(wSamples_r = Rf_allocMatrix(REALSXP, JwpTilde, nPost)); nProtect++;
zeros(REAL(wSamples_r), JwpTilde * nPost);
SEXP etaSamples_r;
if (ar1) {
PROTECT(etaSamples_r = allocMatrix(REALSXP, nYearsMax, nPost)); nProtect++;
PROTECT(etaSamples_r = Rf_allocMatrix(REALSXP, nYearsMax, nPost)); nProtect++;
zeros(REAL(etaSamples_r), nYearsMax * nPost);
}
SEXP psiSamples_r;
PROTECT(psiSamples_r = allocMatrix(REALSXP, JnYears, nPost)); nProtect++;
PROTECT(psiSamples_r = Rf_allocMatrix(REALSXP, JnYears, nPost)); nProtect++;
zeros(REAL(psiSamples_r), JnYears * nPost);
// Detection random effects
SEXP sigmaSqPSamples_r;
SEXP alphaStarSamples_r;
if (pDetRE > 0) {
PROTECT(sigmaSqPSamples_r = allocMatrix(REALSXP, pDetRE, nPost)); nProtect++;
PROTECT(sigmaSqPSamples_r = Rf_allocMatrix(REALSXP, pDetRE, nPost)); nProtect++;
zeros(REAL(sigmaSqPSamples_r), pDetRE * nPost);
PROTECT(alphaStarSamples_r = allocMatrix(REALSXP, nDetRE, nPost)); nProtect++;
PROTECT(alphaStarSamples_r = Rf_allocMatrix(REALSXP, nDetRE, nPost)); nProtect++;
zeros(REAL(alphaStarSamples_r), nDetRE * nPost);
}
// Occurrence random effects
SEXP sigmaSqPsiSamples_r;
SEXP betaStarSamples_r;
if (pOccRE > 0) {
PROTECT(sigmaSqPsiSamples_r = allocMatrix(REALSXP, pOccRE, nPost)); nProtect++;
PROTECT(sigmaSqPsiSamples_r = Rf_allocMatrix(REALSXP, pOccRE, nPost)); nProtect++;
zeros(REAL(sigmaSqPsiSamples_r), pOccRE * nPost);
PROTECT(betaStarSamples_r = allocMatrix(REALSXP, nOccRE, nPost)); nProtect++;
PROTECT(betaStarSamples_r = Rf_allocMatrix(REALSXP, nOccRE, nPost)); nProtect++;
zeros(REAL(betaStarSamples_r), nOccRE * nPost);
}
// Likelihood samples for WAIC.
SEXP likeSamples_r;
PROTECT(likeSamples_r = allocMatrix(REALSXP, JnYears, nPost)); nProtect++;
PROTECT(likeSamples_r = Rf_allocMatrix(REALSXP, JnYears, nPost)); nProtect++;
zeros(REAL(likeSamples_r), J * nPost);

/**********************************************************************
Expand Down Expand Up @@ -378,17 +379,17 @@ extern "C" {
// For normal priors
// Occupancy regression coefficient priors.
F77_NAME(dpotrf)(lower, &pOcc, SigmaBetaInv, &pOcc, &info FCONE);
if(info != 0){error("c++ error: dpotrf SigmaBetaInv failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf SigmaBetaInv failed\n");}
F77_NAME(dpotri)(lower, &pOcc, SigmaBetaInv, &pOcc, &info FCONE);
if(info != 0){error("c++ error: dpotri SigmaBetaInv failed\n");}
if(info != 0){Rf_error("c++ error: dpotri SigmaBetaInv failed\n");}
double *SigmaBetaInvMuBeta = (double *) R_alloc(pOcc, sizeof(double));
F77_NAME(dsymv)(lower, &pOcc, &one, SigmaBetaInv, &pOcc, muBeta, &inc, &zero,
SigmaBetaInvMuBeta, &inc FCONE);
// Detection regression coefficient priors.
F77_NAME(dpotrf)(lower, &pDet, SigmaAlphaInv, &pDet, &info FCONE);
if(info != 0){error("c++ error: dpotrf SigmaAlphaInv failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf SigmaAlphaInv failed\n");}
F77_NAME(dpotri)(lower, &pDet, SigmaAlphaInv, &pDet, &info FCONE);
if(info != 0){error("c++ error: dpotri SigmaAlphaInv failed\n");}
if(info != 0){Rf_error("c++ error: dpotri SigmaAlphaInv failed\n");}
double *SigmaAlphaInvMuAlpha = (double *) R_alloc(pDet, sizeof(double));
F77_NAME(dsymv)(lower, &pDet, &one, SigmaAlphaInv, &pDet, muAlpha, &inc, &zero,
SigmaAlphaInvMuAlpha, &inc FCONE);
Expand Down Expand Up @@ -456,13 +457,13 @@ extern "C" {
double logDet;
double phiCand = 0.0, nuCand = 0.0, rhoCand = 0.0, sigmaSqCand = 0.0;
SEXP acceptSamples_r;
PROTECT(acceptSamples_r = allocMatrix(REALSXP, nThetaSave, nBatch)); nProtect++;
PROTECT(acceptSamples_r = Rf_allocMatrix(REALSXP, nThetaSave, nBatch)); nProtect++;
zeros(REAL(acceptSamples_r), nThetaSave * nBatch);
SEXP tuningSamples_r;
PROTECT(tuningSamples_r = allocMatrix(REALSXP, nThetaSave, nBatch)); nProtect++;
PROTECT(tuningSamples_r = Rf_allocMatrix(REALSXP, nThetaSave, nBatch)); nProtect++;
zeros(REAL(tuningSamples_r), nThetaSave * nBatch);
SEXP thetaSamples_r;
PROTECT(thetaSamples_r = allocMatrix(REALSXP, nThetaSave, nPost)); nProtect++;
PROTECT(thetaSamples_r = Rf_allocMatrix(REALSXP, nThetaSave, nPost)); nProtect++;
zeros(REAL(thetaSamples_r), nThetaSave * nPost);
double b, e, aij, aa;
double *a = (double *) R_alloc(pTilde, sizeof(double));
Expand Down Expand Up @@ -527,9 +528,9 @@ extern "C" {
AR1(nYearsMax, theta[rhoIndx], theta[sigmaSqTIndx], SigmaEta);
clearUT(SigmaEta, nYearsMax);
F77_NAME(dpotrf)(lower, &nYearsMax, SigmaEta, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky failed in initial time covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky failed in initial time covariance matrix\n");}
F77_NAME(dpotri)(lower, &nYearsMax, SigmaEta, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky inverse failed in initial time covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky inverse failed in initial time covariance matrix\n");}
}
double *eta = (double *) R_alloc(nYearsMax, sizeof(double)); zeros(eta, nYearsMax);
// For sigmaSqT sampler
Expand Down Expand Up @@ -630,12 +631,12 @@ extern "C" {


F77_NAME(dpotrf)(lower, &pOcc, tmp_ppOcc, &pOcc, &info FCONE);
if(info != 0){error("c++ error: dpotrf A.beta failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf A.beta failed\n");}
F77_NAME(dpotri)(lower, &pOcc, tmp_ppOcc, &pOcc, &info FCONE);
if(info != 0){error("c++ error: dpotri A.beta failed\n");}
if(info != 0){Rf_error("c++ error: dpotri A.beta failed\n");}
F77_NAME(dsymv)(lower, &pOcc, &one, tmp_ppOcc, &pOcc, tmp_pOcc, &inc, &zero, tmp_pOcc2, &inc FCONE);
F77_NAME(dpotrf)(lower, &pOcc, tmp_ppOcc, &pOcc, &info FCONE);
if(info != 0){error("c++ error: dpotrf A.beta2 failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf A.beta2 failed\n");}
mvrnorm(beta, tmp_pOcc2, tmp_ppOcc, pOcc);

/********************************************************************
Expand Down Expand Up @@ -677,12 +678,12 @@ extern "C" {
} // j

F77_NAME(dpotrf)(lower, &pDet, tmp_ppDet, &pDet, &info FCONE);
if(info != 0){error("c++ error: dpotrf A.alpha failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf A.alpha failed\n");}
F77_NAME(dpotri)(lower, &pDet, tmp_ppDet, &pDet, &info FCONE);
if(info != 0){error("c++ error: dpotri A.alpha failed\n");}
if(info != 0){Rf_error("c++ error: dpotri A.alpha failed\n");}
F77_NAME(dsymv)(lower, &pDet, &one, tmp_ppDet, &pDet, tmp_pDet, &inc, &zero, tmp_pDet2, &inc FCONE);
F77_NAME(dpotrf)(lower, &pDet, tmp_ppDet, &pDet, &info FCONE);
if(info != 0){error("c++ error: dpotrf here failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf here failed\n");}
mvrnorm(alpha, tmp_pDet2, tmp_ppDet, pDet);

/********************************************************************
Expand Down Expand Up @@ -842,9 +843,9 @@ extern "C" {
var[k * pTilde + k] += ff[k] + v[k];
} // k
F77_NAME(dpotrf)(lower, &pTilde, var, &pTilde, &info FCONE);
if(info != 0){error("c++ error: dpotrf var failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf var failed\n");}
F77_NAME(dpotri)(lower, &pTilde, var, &pTilde, &info FCONE);
if(info != 0){error("c++ error: dpotri var failed\n");}
if(info != 0){Rf_error("c++ error: dpotri var failed\n");}

// mu
zeros(mu, pTilde);
Expand All @@ -865,7 +866,7 @@ extern "C" {
F77_NAME(dsymv)(lower, &pTilde, &one, var, &pTilde, mu, &inc, &zero, tmp_pTilde, &inc FCONE);

F77_NAME(dpotrf)(lower, &pTilde, var, &pTilde, &info FCONE);
if(info != 0){error("c++ error: dpotrf var 2 failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf var 2 failed\n");}

mvrnorm(&w[ii * pTilde], tmp_pTilde, var, pTilde);
} // ii (site)
Expand Down Expand Up @@ -1019,9 +1020,9 @@ extern "C" {
AR1(nYearsMax, theta[rhoIndx], 1.0, SigmaEta);
clearUT(SigmaEta, nYearsMax);
F77_NAME(dpotrf)(lower, &nYearsMax, SigmaEta, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky failed in covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky failed in covariance matrix\n");}
F77_NAME(dpotri)(lower, &nYearsMax, SigmaEta, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky inverse failed in covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky inverse failed in covariance matrix\n");}
fillUTri(SigmaEta, nYearsMax);
// Compute t(eta) %*% SigmaEta^-1 %*% eta
for (t = 0; t < nYearsMax; t++) {
Expand Down Expand Up @@ -1050,13 +1051,13 @@ extern "C" {
// Invert SigmaEtaCand and log det cov.
logPostCand = 0.0;
F77_NAME(dpotrf)(lower, &nYearsMax, SigmaEtaCand, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky failed in proposal covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky failed in proposal covariance matrix\n");}
// Get log of the determinant of the covariance matrix.
for (k = 0; k < nYearsMax; k++) {
logPostCand += 2.0 * log(SigmaEtaCand[k*nYearsMax+k]);
} // k
F77_NAME(dpotri)(lower, &nYearsMax, SigmaEtaCand, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky inverse failed in proposal covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky inverse failed in proposal covariance matrix\n");}
logPostCand = 0.0;
// Jacobian and Uniform prior.
logPostCand += log(rhoCand - rhoA) + log(rhoB - rhoCand);
Expand All @@ -1070,12 +1071,12 @@ extern "C" {
clearUT(SigmaEta, nYearsMax);
logPostCurr = 0.0;
F77_NAME(dpotrf)(lower, &nYearsMax, SigmaEta, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky failed in covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky failed in covariance matrix\n");}
for (k = 0; k < nYearsMax; k++) {
logPostCurr += 2.0 * log(SigmaEta[k*nYearsMax+k]);
} // k
F77_NAME(dpotri)(lower, &nYearsMax, SigmaEta, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: Cholesky inverse failed in covariance matrix\n");}
if(info != 0){Rf_error("c++ error: Cholesky inverse failed in covariance matrix\n");}
logPostCurr = 0.0;
logPostCurr += log(rho - rhoA) + log(rhoB - rho);
// (-1/2) * tmp_JD` * C^-1 * tmp_JD
Expand Down Expand Up @@ -1118,15 +1119,15 @@ extern "C" {

// Cholesky of A.eta
F77_NAME(dpotrf)(lower, &nYearsMax, tmp_nnYears, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: dpotrf on A.eta failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf on A.eta failed\n");}
// Inverse of A.eta
F77_NAME(dpotri)(lower, &nYearsMax, tmp_nnYears, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: dpotri on A.eta failed\n");}
if(info != 0){Rf_error("c++ error: dpotri on A.eta failed\n");}
// A.eta.inv %*% b.eta. Stored in tmp_
F77_NAME(dsymv)(lower, &nYearsMax, &one, tmp_nnYears, &nYearsMax,
tmp_nYearsMax, &inc, &zero, tmp_nYearsMax2, &inc FCONE);
F77_NAME(dpotrf)(lower, &nYearsMax, tmp_nnYears, &nYearsMax, &info FCONE);
if(info != 0){error("c++ error: dpotrf on A.eta failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf on A.eta failed\n");}
// Args: destination, mu, cholesky of the covariance matrix, dimension
mvrnorm(eta, tmp_nYearsMax2, tmp_nnYears, nYearsMax);
}
Expand Down Expand Up @@ -1291,8 +1292,8 @@ extern "C" {
nResultListObjs += 1;
}

PROTECT(result_r = allocVector(VECSXP, nResultListObjs)); nProtect++;
PROTECT(resultName_r = allocVector(VECSXP, nResultListObjs)); nProtect++;
PROTECT(result_r = Rf_allocVector(VECSXP, nResultListObjs)); nProtect++;
PROTECT(resultName_r = Rf_allocVector(VECSXP, nResultListObjs)); nProtect++;

// Setting the components of the output list.
SET_VECTOR_ELT(result_r, 0, betaSamples_r);
Expand Down Expand Up @@ -1328,36 +1329,34 @@ extern "C" {
}
SET_VECTOR_ELT(result_r, ar1Ind, etaSamples_r);
}
// mkChar turns a C string into a CHARSXP
SET_VECTOR_ELT(resultName_r, 0, mkChar("beta.samples"));
SET_VECTOR_ELT(resultName_r, 1, mkChar("alpha.samples"));
SET_VECTOR_ELT(resultName_r, 2, mkChar("z.samples"));
SET_VECTOR_ELT(resultName_r, 3, mkChar("psi.samples"));
SET_VECTOR_ELT(resultName_r, 4, mkChar("theta.samples"));
SET_VECTOR_ELT(resultName_r, 5, mkChar("w.samples"));
SET_VECTOR_ELT(resultName_r, 6, mkChar("tune"));
SET_VECTOR_ELT(resultName_r, 7, mkChar("accept"));
SET_VECTOR_ELT(resultName_r, 8, mkChar("like.samples"));
// Rf_mkChar turns a C string into a CHARSXP
SET_VECTOR_ELT(resultName_r, 0, Rf_mkChar("beta.samples"));
SET_VECTOR_ELT(resultName_r, 1, Rf_mkChar("alpha.samples"));
SET_VECTOR_ELT(resultName_r, 2, Rf_mkChar("z.samples"));
SET_VECTOR_ELT(resultName_r, 3, Rf_mkChar("psi.samples"));
SET_VECTOR_ELT(resultName_r, 4, Rf_mkChar("theta.samples"));
SET_VECTOR_ELT(resultName_r, 5, Rf_mkChar("w.samples"));
SET_VECTOR_ELT(resultName_r, 6, Rf_mkChar("tune"));
SET_VECTOR_ELT(resultName_r, 7, Rf_mkChar("accept"));
SET_VECTOR_ELT(resultName_r, 8, Rf_mkChar("like.samples"));
if (pDetRE > 0) {
SET_VECTOR_ELT(resultName_r, 9, mkChar("sigma.sq.p.samples"));
SET_VECTOR_ELT(resultName_r, 10, mkChar("alpha.star.samples"));
SET_VECTOR_ELT(resultName_r, 9, Rf_mkChar("sigma.sq.p.samples"));
SET_VECTOR_ELT(resultName_r, 10, Rf_mkChar("alpha.star.samples"));
}
if (pOccRE > 0) {
SET_VECTOR_ELT(resultName_r, tmp_0, mkChar("sigma.sq.psi.samples"));
SET_VECTOR_ELT(resultName_r, tmp_0 + 1, mkChar("beta.star.samples"));
SET_VECTOR_ELT(resultName_r, tmp_0, Rf_mkChar("sigma.sq.psi.samples"));
SET_VECTOR_ELT(resultName_r, tmp_0 + 1, Rf_mkChar("beta.star.samples"));
}
if (ar1) {
SET_VECTOR_ELT(resultName_r, ar1Ind, mkChar("eta.samples"));
SET_VECTOR_ELT(resultName_r, ar1Ind, Rf_mkChar("eta.samples"));
}

// Set the names of the output list.
namesgets(result_r, resultName_r);
Rf_namesgets(result_r, resultName_r);

//unprotect
UNPROTECT(nProtect);

return(result_r);
}
}


25 changes: 13 additions & 12 deletions src/svcTPGOccNNGPPredict.cpp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
#include <omp.h>
#endif

#define R_NO_REMAP
#include <R.h>
#include <Rmath.h>
#include <Rinternals.h>
Expand Down Expand Up @@ -75,7 +76,7 @@ extern "C" {
omp_set_num_threads(nThreads);
#else
if(nThreads > 1){
warning("n.omp.threads > %i, but source not compiled with OpenMP support.", nThreads);
Rf_warning("n.omp.threads > %i, but source not compiled with OpenMP support.", nThreads);
nThreads = 1;
}
#endif
Expand Down Expand Up @@ -145,9 +146,9 @@ extern "C" {
int threadID = 0, status = 0;

SEXP z0_r, w0_r, psi0_r;
PROTECT(z0_r = allocMatrix(REALSXP, qnYears, nSamples)); nProtect++;
PROTECT(psi0_r = allocMatrix(REALSXP, qnYears, nSamples)); nProtect++;
PROTECT(w0_r = allocMatrix(REALSXP, Jw0pTilde, nSamples)); nProtect++;
PROTECT(z0_r = Rf_allocMatrix(REALSXP, qnYears, nSamples)); nProtect++;
PROTECT(psi0_r = Rf_allocMatrix(REALSXP, qnYears, nSamples)); nProtect++;
PROTECT(w0_r = Rf_allocMatrix(REALSXP, Jw0pTilde, nSamples)); nProtect++;
double *z0 = REAL(z0_r);
double *psi0 = REAL(psi0_r);
double *w0 = REAL(w0_r);
Expand Down Expand Up @@ -201,9 +202,9 @@ extern "C" {
}

F77_NAME(dpotrf)(lower, &m, &C[threadID*mm], &m, &info FCONE);
if(info != 0){error("c++ error: dpotrf failed\n");}
if(info != 0){Rf_error("c++ error: dpotrf failed\n");}
F77_NAME(dpotri)(lower, &m, &C[threadID*mm], &m, &info FCONE);
if(info != 0){error("c++ error: dpotri failed\n");}
if(info != 0){Rf_error("c++ error: dpotri failed\n");}

F77_NAME(dsymv)(lower, &m, &one, &C[threadID*mm], &m, &c[threadID*m], &inc, &zero, &tmp_m[threadID*m], &inc FCONE);

Expand Down Expand Up @@ -265,19 +266,19 @@ extern "C" {
SEXP result_r, resultName_r;
int nResultListObjs = 3;

PROTECT(result_r = allocVector(VECSXP, nResultListObjs)); nProtect++;
PROTECT(resultName_r = allocVector(VECSXP, nResultListObjs)); nProtect++;
PROTECT(result_r = Rf_allocVector(VECSXP, nResultListObjs)); nProtect++;
PROTECT(resultName_r = Rf_allocVector(VECSXP, nResultListObjs)); nProtect++;

SET_VECTOR_ELT(result_r, 0, z0_r);
SET_VECTOR_ELT(resultName_r, 0, mkChar("z.0.samples"));
SET_VECTOR_ELT(resultName_r, 0, Rf_mkChar("z.0.samples"));

SET_VECTOR_ELT(result_r, 1, w0_r);
SET_VECTOR_ELT(resultName_r, 1, mkChar("w.0.samples"));
SET_VECTOR_ELT(resultName_r, 1, Rf_mkChar("w.0.samples"));

SET_VECTOR_ELT(result_r, 2, psi0_r);
SET_VECTOR_ELT(resultName_r, 2, mkChar("psi.0.samples"));
SET_VECTOR_ELT(resultName_r, 2, Rf_mkChar("psi.0.samples"));

namesgets(result_r, resultName_r);
Rf_namesgets(result_r, resultName_r);

//unprotect
UNPROTECT(nProtect);
Expand Down

0 comments on commit acecd18

Please sign in to comment.