I don't know about the current Sparc Fortran compilers, but over the years have learned not to try to pass logicals and character strings between C and Fortran. I have seen Fortran compilers that treated integer -1 (all bits 1) as .true. and anything else as .false. and I have see ones that looked only at bit 7, counting from the right, to determine the value.
I recommend changing your Fortran code to accept an integer instead of a logical for boolean inputs and outputs. Bill Dunlap TIBCO Software wdunlap tibco.com On Wed, Mar 15, 2017 at 7:40 AM, Avraham Adler <avraham.ad...@gmail.com> wrote: > Hello. > > The Delaporte package works properly on all R-core platforms except > Solaris SPARC, where it compiles properly but fails a number of its > tests [1]. Not having access to a SPARC testbed, I'm limited in what > kind of diagnostics I can do. One thing I have noticed is that a lot > of the failures occur when I am passing non-default logicals (like > lower tail or log). For example, the first failure at that link is > when "log = true" is supposed to be passed, but the SPARC answers are > the unlogged values. Of the 22 failed tests, 12 of them pass logicals. > > I'll bring an example of how it is coded below, and if anyone > recognizes where SPARC specifically goes wrong, I'd appreciate. I > guess, if I absolutely had to, I could convert the logical to an > integer in C and pass the integer to Fortran which should work even > for SPARC, but I'd prefer not to if I could help it. > > Thank you, > > Avi > > [1] https://cran.r-project.org/web/checks/check_results_Delaporte.html > > *****Example Code***** > > R code: > > ddelap <- function(x, alpha, beta, lambda, log = FALSE){ > if(!is.double(x)) {storage.mode(x) <- 'double'} > if(!is.double(alpha)) {storage.mode(alpha) <- 'double'} > if(!is.double(beta)) {storage.mode(beta) <- 'double'} > if(!is.double(lambda)) {storage.mode(lambda) <- 'double'} > if(any(x > floor(x))) { > warning("Non-integers passed to ddelap. These will have 0 probability.") > } > .Call(ddelap_C, x, alpha, beta, lambda, log) > } > > C code: > > void ddelap_f(double *x, int nx, double *a, int na, double *b, int nb, > double *l, int nl, > int *lg, double *ret); > > extern SEXP ddelap_C(SEXP x, SEXP alpha, SEXP beta, SEXP lambda, SEXP lg){ > const int nx = LENGTH(x); > const int na = LENGTH(alpha); > const int nb = LENGTH(beta); > const int nl = LENGTH(lambda); > SEXP ret; > PROTECT(ret = allocVector(REALSXP, nx)); > ddelap_f(REAL(x), nx, REAL(alpha), na, REAL(beta), nb, REAL(lambda), > nl, LOGICAL(lg), REAL(ret)); > UNPROTECT(1); > return(ret); > } > > Fortran: (not posting ddelap_f_s as that doesn't handle the logging) > > subroutine ddelap_f(x, nx, a, na, b, nb, l, nl, lg, pmfv) bind(C, > name="ddelap_f") > > integer(kind = c_int), intent(in), value :: nx, na, nb, nl > ! Sizes > real(kind = c_double), intent(in), dimension(nx) :: x > ! Observations > real(kind = c_double), intent(out), dimension(nx):: pmfv > ! Result > real(kind = c_double), intent(in) :: a(na), b(nb), > l(nl)! Parameters > logical(kind = c_bool), intent(in) :: lg > ! Log flag > integer :: i > ! Integer > > !$omp parallel do default(shared) private(i) > do i = 1, nx > if (x(i) > floor(x(i))) then > pmfv(i) = ZERO > else > pmfv(i) = ddelap_f_s(x(i), a(mod(i - 1, na) + 1), & > b(mod(i - 1, nb) + 1), l(mod(i - > 1, nl) + 1)) > end if > end do > !$omp end parallel do > > if (lg) then > pmfv = log(pmfv) > end if > > end subroutine ddelap_f > > ______________________________________________ > R-package-devel@r-project.org mailing list > https://stat.ethz.ch/mailman/listinfo/r-package-devel ______________________________________________ R-package-devel@r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-package-devel
