I understand the interface command can be used to pass a a function into a subroutine. So for example in the main program I'd define some function and then pass it to some subroutine like:
MainProgran
Use ....
Implicit None
Type decorations etc
Interface
Function test(x,y)
REAL, INTENT(IN) :: x, y
REAL :: test
END function
End Interface
Call Subroutine( limit1, limit2, test, Ans)
End MainProgram
Is this the correct way of doing this? I'm quite stuck! Also within the Subroutine is there anything I need to put to let it know that a function is coming in? The Subroutine in this case will be a library so I don't want to have to keep recompiling it to change the function.
Module:
module fmod
interface
function f_interf(x,y)
real, intent(in) :: x, y
real :: f_interf
end function
end interface
contains
function f_sum(x,y)
real, intent(in) :: x, y
real f_sum
f_sum = x + y
end function
function f_subst(x,y)
real, intent(in) :: x, y
real f_subst
f_subst = x - y
end function
subroutine subr(limit1, limit2, func, ans)
real limit1, limit2
procedure(f_interf) func
real ans
ans = func(limit1, limit2)
end subroutine
end module
main program:
program pass_func
use fmod
Implicit None
real ans, limit1, limit2
limit1 = 1.0
limit2 = 2.0
call subr( limit1, limit2, f_subst, ans)
write(*,*) ans
call subr( limit1, limit2, f_sum, ans)
write(*,*) ans
end program pass_func
and output:
-1.000000
3.000000
A simple way to do this is to go old school and just leave the function external:
program main
real f,z
external f
call subr(f,z)
write(*,*)z
end
real function f(x)
real x
f=x**2
end
! below possibly in a precompiled library:
subroutine subr(f,y)
real f,y
y=f(2.)
end
out: 4
Of course with this approach you can not use advanced language features that require an explicit interface. **
On the other hand if you are interfacing with standard libraries that need function arguments this is I think the only way.
** per MSB's comment you can handle that issue with an interface block in the subroutine,
for example if we want to pass a function that returns an array:
function f(x)
real x,f(2)
f(1)=x
f(2)=x**2
end
as in the first example f is an external function, and the sub can be in
a precompiled library:
subroutine subr(g,y)
interface
function g(x)
real x,g(2)
end function
end interface
real y,z(2)
z=g(2.)
y=z(1)+z(2)
end
out: 6
As noted, this is only strictly necessary if relying on language features that need the interface.
The most elegant way I know of right now is to put your functions into a module so that you don't have to do construct interface but simply use 'external'. Here is a example to do that.
It covers different situations using subroutine or function as arguments for subroutine or function.
Notice if you want to pass array as argument without receiving null arraies, here is a tip to do that.
Module part:
module func_arg_test
!I used ifort to compile but other compilers should also be fine.
!Written by Kee
!Feb 20, 2017
contains
!-------------------------
real function func_func(f, arg)
!========================================
!This shows how to pass number as argument
!========================================
implicit none
real, external::f !Use external to indicate the f is a name of a function
real::arg
func_func=f(arg)
end function func_func
real function func_sub(subr, arg)
!========================================
!This shows how to pass subroutine as arg to function
!========================================
implicit none
external::subr !Use external to indicate subr is a subroutine
real::arg
call sub(arg)
func_sub = arg
end function func_sub
subroutine sub_func(f,arg)
!========================================
!This shows how to pass function as argument
!in subroutine
!========================================
real::arg
real,external::f
arg = f(arg)
end subroutine sub_func
subroutine sub_sub(subr,arg)
!========================================
!This shows how to pass subroutine as argument
!in subroutine
!========================================
real::arg
external::subr
call subr(arg)
end subroutine sub_sub
real function funcmat(f, mat)
!========================================
!This shows how to pass matrix as argument
!========================================
implicit none
real, external::f
real,dimension(:)::mat!Here memory for mat is already allocated when mat is
!passed in, so don't need specific size
integer::sizeinfo
sizeinfo = size(mat)
funcmat = f(mat,sizeinfo)
end function funcmat
!--------------------------
real function f1(arg)
!This test function double the number arg
implicit none
real::arg
f1 = arg*2
return
end function f1
real function f2(arg)
!This test function square the number arg
implicit none
real::arg
f2 = arg*arg
return
end function f2
real function fmat(mat,sizeinfo)
!This test function sum up all elements in the mat
implicit none
integer::sizeinfo!This is the method I come up with to get around the
!restriction.
real,dimension(sizeinfo)::mat!This mat cannot be undetermined, otherwise it
!won't recevie mat correctly. I don't know why yet.
fmat = sum(mat)
end function fmat
subroutine sub(arg)
real::arg
arg = arg*3
end subroutine sub
end module
Main program:
program main
use func_arg_test
implicit none
real::a = 5d0
real::output
real, dimension(:),allocatable::mat
write(*,*) 'value of a=',a
output = func_func(f1,a)
write(*,*) 'a is doubled'
write(*,*) output
output = func_func(f2,a)
write(*,*) 'a is squared'
write(*,*) output
output = func_sub(sub,a)
write(*,*) 'a is tripled and overwritten'
write(*,*) output
call sub_func(f2,a)
write(*,*) 'a is squared and overwritten'
write(*,*) a
call sub_sub(sub,a)
write(*,*) 'a is tripled and overwritten'
write(*,*) a
allocate(mat(3))
mat = (/1d0,10d0,1d0/)!The allocatable arrray has to have a determined shape before
!pass as arguemnt
write(*,*) '1D matrix:',mat
write(*,*) 'Summation of the matrix:'
output = funcmat(fmat,mat)!elements of mat are summed
write(*,*) output
end program
And the result is:
value of a= 5.000000
a is doubled
10.00000
a is squared
25.00000
a is tripled and overwritten
15.00000
a is squared and overwritten
225.0000
a is tripled and overwritten
675.0000
1D matrix: 1.000000 10.00000 1.000000
Summation of the matrix:
12.00000
Related
I have the following Fortran program. But I don't understand why the output is 4 instead of 1. I am using GNU 6.4 Fortran compiler:
program aa
implicit none
real, pointer, dimension(:,:) :: t => null()
integer :: i,j
allocate(t(0:100,20))
do i = 0, 100
do j = 1, 20
t(i,j) = i*j
end do
end do
call te(t(1:,:))
stop
contains
subroutine te(a)
implicit none
real,dimension(:,:),pointer,intent(in) :: a
print *, a(1,1)
end subroutine te
end program aa
The Intel compiler 18.0.2 returns the error message
/pt.f90(17): error #7121: A ptr dummy may only be argument associated with a ptr, and this array element or section does not inherit the POINTER attr from its parent array. [T]
call te(t(1:,:))
Change the line in your subroutine to
real,dimension(:,:),intent(in) :: a
and all is good.
I would like to be able to create a dispatch for a user-defined type which will essentially do an inplace copy. However, I would like to do it in a type-stable manner, and thus I would like to avoid using getfield directly, and instead try to use a generated function. Is it possible for a type like
type UserType{T}
x::Vector{T}
y::Vector{T}
z::T
end
to generate some function
recursivecopy!(A::UserType,B::UserType)
# Do it for x
if typeof(A.x) <: AbstractArray
recursivecopy!(A.x,B.x)
else
A.x = B.x
end
# Now for y
if typeof(A.y) <: AbstractArray
recursivecopy!(A.y,B.y)
else
A.y = B.y
end
# Now for z
if typeof(A.z) <: AbstractArray
recursivecopy!(A.z,B.z)
else
A.z = B.z
end
end
The recursivecopy! in RecursiveArrayTools.jl makes this handle nested (Vector{Vector}) types well, but the only problem is that I do not know the fields the user will have in advance, just at compile-time when this function would be called. Sounds like a job for generated functions, but I'm not quite sure how to generate this.
You don't need to bend over backwards to avoid getfield and setfield. Julia can infer them just fine. The trouble comes when Julia can't figure out which field it's accessing… like in a for loop.
So the only special thing the generated function needs to do is effectively unroll the loop with constant values spliced into getfield:
julia> immutable A
x::Int
y::Float64
end
julia> #generated function f(x)
args = [:(getfield(x, $i)) for i=1:nfields(x)]
:(tuple($(args...)))
end
f (generic function with 1 method)
julia> f(A(1,2.4))
(1,2.4)
julia> #code_warntype f(A(1,2.4))
Variables:
#self#::#f
x::A
Body:
begin # line 2:
return (Main.tuple)((Main.getfield)(x::A,1)::Int64,(Main.getfield)(x::A,2)::Float64)::Tuple{Int64,Float64}
end::Tuple{Int64,Float64}
Just like you can splice in multiple arguments to a function call, you can also directly splice in multiple expressions to the function body.
julia> type B
x::Int
y::Float64
end
julia> #generated function f!{T}(dest::T, src::T)
assignments = [:(setfield!(dest, $i, getfield(src, $i))) for i=1:nfields(T)]
:($(assignments...); dest)
end
f! (generic function with 1 method)
julia> f!(B(0,0), B(1, 2.4))
B(1,2.4)
julia> #code_warntype f!(B(0,0), B(1, 2.4))
Variables:
#self#::#f!
dest::B
src::B
Body:
begin # line 2:
(Main.setfield!)(dest::B,1,(Main.getfield)(src::B,1)::Int64)::Int64
(Main.setfield!)(dest::B,2,(Main.getfield)(src::B,2)::Float64)::Float64
return dest::B
end::B
You can, of course, make the body of that comprehension as complicated as you'd like. That effectively becomes the inside of your for loop. Splatting the array into the body of the function does the unrolling for you.
I wrote a recursive program on Fortran to calculate the combinations of npoints of ndim dimensions as follows. I first wrote this program on MATLAB and it was perfectly running. But in Fortran, my problem is that after the first iteration it is assigning absurd values for the list of points, with no explanation. Could somebody give me a hand?
PROGRAM MAIN
IMPLICIT NONE
INTEGER :: ndim, k, npontos, contador,i,iterate, TEST
integer, dimension(:), allocatable :: pontos
print*, ' '
print*, 'npoints?'
read *, npontos
print*, 'ndim?'
read *, ndim
k=1
contador = 1
open(450,file= 'combination.out',form='formatted',status='unknown')
write(450,100) 'Comb ','stat ',(' pt ',i,' ',i=1,ndim)
write(450,120) ('XXXXXXXXXX ',i=1,ndim+1)
allocate(pontos(ndim))
do i=1,4
pontos(i)=i
end do
TEST = iterate(pontos, ndim, npontos,k,contador)
end program MAIN
recursive integer function iterate(pontos, ndim, npontos, k,contador)
implicit NONE
integer, intent(in) :: ndim, k, npontos
integer,dimension(:) :: pontos
integer contador,inic,i,j,m
if (k.eq.ndim) then
inic=pontos(ndim)
do i = pontos(ndim),npontos
pontos(k)= i
write(*,*) pontos(:)
contador=contador+1
end do
pontos(ndim)= inic + 1
else
inic = pontos (k)
do j = pontos(k),(npontos-ndim+k)
pontos(k)=j
pontos= iterate(pontos, ndim, npontos, k+1,contador)
end do
end if
pontos(k)=inic+1;
if (pontos(k).gt.(npontos-ndim+k+1)) then
do m =k+1,ndim
pontos(m)=pontos(m-1)+1
end do
end if
end function iterate
There are too many issues in that code... I stopped debugging it. This is what I got so far, it's too much for a comment.
This doesn't make sense:
pontos= iterate(pontos, ndim, npontos, k+1,contador)
You are changing pontos inside iterate, and never set a return value within the function.
You need to a) provide a result statement for recursive functions (and actually set it) or b) convert it to a subroutine. Since you are modifying at least one dummy argument, you should go with b).
Since you are using assumed-shape dummy arguments, you need to specify an interface to the function/subroutine, either explicitly or with a module.
Neither format 100 nor format 120 are specified in your code.
I have a Fortran subroutine that selects a function based on the value of a string and then executes that function.
!! file:select.f90
module funcs
contains
subroutine add(x, y, xy)
real :: x, y, xy
xy = x + y
return
end subroutine
subroutine diff(x, y, xy)
real :: x, y, xy
xy = x - y
return
end subroutine
end module
subroutine simple(modname)
use funcs
procedure(), pointer :: model => null()
character(10) :: modname
real :: x, y, xy
print *, "-",modname,"-"
select case (modname)
case("add")
model => add
case("diff")
model => diff
case default
print *, "No model with that name!"
stop
end select
x = 4
y = 3
call model(x, y, xy)
print *, xy
end subroutine
I would like to call this subroutine from an R script.
# file:select.R
dyn.load("select.so")
.Fortran("simple", "add")
.Fortran("simple", "diff")
As a standalone Fortran program that takes a command line argument, this runs perfectly fine. It's even insensitive to spaces before or after modname. However, when I try to pass in a character as an argument from R, it correctly re-prints the character (without any extra spaces), but then doesn't recognize it as a case and skips to the default. What is going on here? Is there some encoding issue with R characters that makes them incompatible with Fortran?
I believe your select case statement is not properly matching because the modname is 10 characters long, and none of your cases cover a string of that length. The best thing to do is to also pass in the length of the string to your Fortran function, then use this to slice your character array.
subroutine simple(modname,length)
then select case (modname(1:length))
Fortran strings are not zero terminated like the C language. It's an array based language.
Also when passing a string from R to .Fortran, it might be better to pass it as raw bytes. Simple example below. First is the Fortran code, then the R wrapper code.
subroutine print_this ( str, length )
integer :: length
character(length) :: str
print *, str(1:length)
end subroutine print_this
test <- function(str) {
l <- nchar(str)
str_raw <- character(l)
str_raw <- charToRaw(str)
.Fortran("print_this",str_raw,l)
l #returns length
}
I am starting this thread because I want to learn how to successfully use the same pointer to serve as the aliases of different array-valued functions, say, f1 and f2, sequentially.
Here is an unsuccessful code to illustrate what I want. Thanks. Lee
PROGRAM main
...
REAL(WP), POINTER, DIMENSION(:) :: p
p=>f1
print*,p(1.0_wp) ! the outcome should be 3
p=>f2
print*,p(2.0_wp) ! the outcome should be 3 1
CONTAINS
FUNCTION f1(x)
IMPLICIT NONE
REAL(WP), TARGET :: f1
REAL(WP), INTENT(IN) :: x
f1=x+2
END FUNCTION f1
FUNCTION f2(x)
IMPLICIT NONE
REAL(WP), TARGET :: f2(2)
REAL(WP), INTENT(IN) :: x
f2(1) = x+1
f2(2) = x-1
END FUNCTION f2
END PROGRAM main
For a pointer to a function that returns an array, you want to have an interface to describe a pointer to a function that returns an array.
Here is an example of how to setup function pointers that might set you in the right direction:
How to alias a function name in Fortran
Edit: OK, here is some example source code:
module ExampleFuncs
implicit none
contains
function f1 (x)
real, dimension (:), allocatable :: f1
real, intent (in) :: x
allocate (f1 (1:2))
f1 (1) = 2.0 * x
f1 (2) = -2.0 * x
return
end function f1
function f2 (x)
real, dimension (:), allocatable :: f2
real, intent (in) :: x
allocate (f2 (1:3))
f2 (1) = x
f2 (2) = x**2
f2 (3) = x**3
return
end function f2
end module ExampleFuncs
program test_func_ptrs
use ExampleFuncs
implicit none
abstract interface
function func (z)
real, dimension (:), allocatable :: func
real, intent (in) :: z
end function func
end interface
procedure (func), pointer :: f_ptr
real :: input
do
write (*, '( // "Input test value: ")', advance="no" )
read (*, *) input
if ( input < 0.0 ) then
f_ptr => f1
else
f_ptr => f2
end if
write (*, '( "evaluate function: ", *(ES14.4) )' ) f_ptr (input)
end do
end program test_func_ptrs