How to use inteface blocks to pass a function to a subroutine?

Question

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 subr

Answer 1

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