On 06/20/2010 04:02 AM, David Scott wrote:
Thanks very much to all who replied. I went with Brian's approach, and
eventually, despite all my attempts to foul it up, I did get it to work
successfully. For the record here are the details.

The subroutine is:

        subroutine SSFcoef(nmax,nu,A)
        implicit double precision(a-h,o-z)
        implicit integer (i-n)

These 'implicit' declarations are dangerous. Use 'implicit none' instead and declare explicitly every variable (like you already are doing). You get much better error checks (eg, misspelled variable names are caught).

Göran

        integer k,i,nmax
        double precision nu,A(0:nmax,0:nmax)
        A(0,0) = 1D0
        do k=1,nmax
                do i=1,k-1
                        A(k,i) = (-nu+i+k-1D0)*A(k-1,i)+A(k-1,i-1)
                end do
                A(k,0) = (-nu+k-1D0)*A(k-1,0)
                A(k,k) = 1D0
        end do
        return
        end

This was in the file SSFcoef.f95 and was made into a dll with

R CMD SHLIB SSFcoef.f95

Then calling it in R went like this:

### Load the compiled shared library in.
dyn.load("SSFcoef.dll")

### Write a function that calls the Fortran subroutine
SSFcoef<- function(nmax, nu){
     .Fortran("SSFcoef",
              as.integer(nmax),
              as.double(nu),
            A = matrix(0, nmax+1, nmax+1)
              )$A
}

SSFcoef(10,2)


There are a number of comments I should make.

Yes, Brian, should have gone to R-devel. I had forgotten about that.

I recognised from my faintly recalled past Fortran experience that the
code was different and suspected a later Fortran, so good to be advised
it was 95.

I actually gave a wrong version of the Fortran subroutine, one I had
been messing around with and had added some extra arguments (nrowA and
ncolA). As pointed out these were unnecessary.

Something which then caused me a bit of grief before I noticed it.
Despite the 'implicit integer (i-n)' declaration in the subroutine, nu
is later declared to be double so has to be specified as double in the R
code.

Many thanks again, I at least learnt something about calling other
language code from R.

David

Prof Brian Ripley wrote:
On Sat, 19 Jun 2010, David Scott wrote:

I have no experience with incorporating Fortran code and am probably doing
something pretty stupid.

Surely you saw in the posting guide that R-help is not the place for
questions about C, C++, Fortran code?  Diverting to R-devel.

I want to use the following Fortran subroutine (not written by me) in the

Well, it is not Fortran 77 but Fortran 95, and so needs to be given a
.f95 extension to be sure to work.

file SSFcoef.f

      subroutine SSFcoef(nmax,nu,A,nrowA,ncolA)
      implicit double precision(a-h,o-z)
      implicit integer (i-n)
      integer l,i,nmax
      double precision nu,A(0:nmax,0:nmax)
      A(0,0) = 1D0
      do l=1,nmax
        do i=1,l-1
                A(l,i) = (-nu+i+l-1D0)*A(l-1,i)+A(l-1,i-1)
        end do
        A(l,0) = (-nu+l-1D0)*A(l-1,0)
        A(l,l) = 1D0
      end do
      return
      end


I created a dll (this is windows) using R CMD SHLIB SSFcoef.f

Then my R code is:

### Load the compiled shared library in.
dyn.load("SSFcoef.dll")

### Write a function that calls the Fortran subroutine
SSFcoef<- function(nmax, nu){
  .Fortran("SSFcoef",
           as.integer(nmax),
           as.integer(nu)
           )$A
}

That does not match.  nrowA and ncolA are unused, so you need
SSFcoef<- function(nmax, nu){
    .Fortran("SSFcoef",
             as.integer(nmax),
             as.integer(nu),
             A = matrix(0, nmax+1, nmax+1),
             0L, 0L)$A
}


SSFcoef(10,2)

which when run gives

SSFcoef(10,2)
NULL

I am pretty sure the problem is that I am not dealing with the matrix A
properly. I also tried this on linux and got a segfault.

Can anyone supply the appropriate modification to my call (and possibly to
the subroutine) to make this work?

David Scott




--
Göran Broström               phone: 46 90 786 5223
Department of Statistics     fax: 46 90 786 6614
Umeå University              email: g...@stat.umu.se
SE-90187 Umeå, Sweden        http://www.stat.umu.se

______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to