[R] Fortran
Ko-Kang Kevin Wang
Ko-Kang at xtra.co.nz
Sat Oct 26 05:45:35 CEST 2002
Hi,
I did this a few months ago. Suppose I have the following Fortran
subroutine:
c A Fortran program that calculates Fibonacci Sequence.
c Implemented by Ko-Kang Wang
c23456789
SUBROUTINE Fibonacci(num, a)
c Overriding all implicit rules, i.e. undeclare all variables.
IMPLICIT NONE
c Declaration of Variables
DOUBLE PRECISION num, i, fib, prev1, prev2
CHARACTER a
prev1 = 1
prev2 = 0
c When all = TRUE, follow this loop
c This loop prints out all values in the sequence
IF ((a .EQ. 'T') .OR. (a .EQ. 'TRUE')) THEN
write(*,*) 1
DO 10 i = 2, num
fib = prev1 + prev2
prev2 = prev1
prev1 = fib
write(*,*) fib
10 CONTINUE
c When all = FALSE, follow this loop
c This loop only prints the last value in the sequence
ELSEIF ((a .EQ. 'F') .OR. (a .EQ. 'FALSE')) THEN
DO 20 i = 2, num
fib = prev1 + prev2
num = fib
prev2 = prev1
prev1 = fib
20 CONTINUE
RETURN
ENDIF
END
Note that I have indented the subtroutine by 2 spaces, so it is easier to
read in the email. You may wish to remove the indentation.
Now, suppose that it is saves as Fibonacci.f and that you're running on
Unix/Linux, then you will want to do:
R CMD SHLIB Fibonacci.f
this will generates two files:
Fibonacci.so Fibonacci.o
If you're using Windows, you will need to do:
Rcmd SHLIB Fibonacci.f
as stated in "Writing R Extensions".
The next thing is to open R and:
# Load the compiled shared library in.
dyn.load("Fibonacci.so")
# Write a function that calls the Fortran subroutine.
Fibonacci <- function(n, all = T) {
.Fortran("fibonacci",
ans = as.double(n),
as.character(all))$ans
}
# Try it out!
Fibonacci(10)
Fibonacci(10, all = F)
This is just a silly example, but you get the idea... :-)
Cheers,
Kevin
------------------------------------------------
Ko-Kang Kevin Wang
Post Graduate PGDipSci Student
Department of Statistics
University of Auckland
New Zealand
www.stat.auckland.ac.nz/~kwan022
----- Original Message -----
From: "Stephen Elijah" <ilievs at lovell.econ.queensu.ca>
To: <r-help at stat.math.ethz.ch>
Sent: Saturday, October 26, 2002 1:24 PM
Subject: [R] Fortran
> Hello everybody,
> Could someone please send me a very simple example using Fortran from
> R? Say pass a value to an executable and get the result in R. Actually it
> seems it may be possible to call an *.f file ?? or I am wrong again?
> The manual is very terse on the subject.
> Thank you very much
>
> Stephen Elijah
>
> -.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.
-.-.-
> r-help mailing list -- Read
http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
> Send "info", "help", or "[un]subscribe"
> (in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
>
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._.
_._
>
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-help mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-help-request at stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
More information about the R-help
mailing list