Fortran procedure pointer to subroutines in derived type - fortran

In Fortran, I need a procedure pointer inside a derived type that can point to one of several subroutines. This problem seems to be common on SO:
Fortran save procedure as property in derived type
Type bound procedure overloading in Fortran 2003
There is no matching specific subroutine for this type bound generic subroutine call
Generic type-bound procedures with procedure arguments
Type bound procedure as arguments
to name a few. The answer to this question for functions is provided very nicely in the first reference.
However, I'm still not clear on a methodology to develop such code well in the case that the type-bound procedure pointer is pointing to a subroutine. The difficulty seems to be that there is no type associated with what is returned (since nothing is really "returned").
I would also like to point out the nuance that, although a simple solution may exist in a more recent standard of fortran (2003,2008), this solution may not work on all compilers, which may be problematic in the future. So I'm interested in compiler-friendly solutions.
I have a small code (shown below) that currently works, but in my big code, I'm getting an internal compiler error (also shown below) in the file where I use procedure pointers in derived types. My question is: what can I do to the code below to
1) Strictly use explicit interfaces
2) Maximize information passed to the compiler
3) Ensure the code is portable between as many compilers as possible (i.e. use fortran 90 / 95 standards).
To what degree can the above be satisfied (1 being most important)? Is it possible to satisfy all of these criteria above? I know that's "satisfy all of these criteria" is subjective, but I would argue that the answer is 'yes' for the same question regarding functions instead of subroutines.
gcc version 5.1.0 (i686-posix-dwarf-rev0, Built by MinGW-W64 project)
The small code:
module subs_mod
implicit none
public :: add,mult
contains
subroutine add(x,y,z)
implicit none
integer,intent(inout) :: x
integer,intent(in) :: y,z
x = y+z
end subroutine
subroutine mult(x,y,z)
implicit none
integer,intent(inout) :: x
integer,intent(in) :: y,z
x = y*z
end subroutine
end module
module type_A_mod
use subs_mod
implicit none
public :: type_A,init,operate
type type_A
procedure(),pointer,nopass :: op
end type
contains
subroutine init(A,op)
implicit none
external :: op
type(type_A),intent(inout) :: A
A%op => op
end subroutine
subroutine operate(A,x,y,z)
implicit none
type(type_A),intent(in) :: A
integer,intent(inout) :: x
integer,intent(in) :: y,z
call A%op(x,y,z)
end subroutine
end module
program test
use type_A_mod
use subs_mod
implicit none
type(type_A) :: A
integer :: x
call init(A,mult)
call operate(A,x,3,5)
write(*,*) 'x = ',x
end program
Compiler error in big code:
f951.exe: internal compiler error: Segmentation fault
libbacktrace could not find executable to open
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://sourceforge.net/projects/mingw-w64> for instructions.
UPDATE
Here's a small modification that gives the compiler more information, but I have not tried this on the big code. However, it seems arbitrary, and I have no idea if it will help or not.
...
function add(x,y,z) result(TF)
...
logical :: TF
x = y+z
TF = .true.
end function
function mult(x,y,z) result(TF)
...
logical :: TF
x = y*z
TF = .true.
end function
end module
module type_A_mod
...
type type_A
procedure(logical),pointer,nopass :: op
end type
...
subroutine init(A,op)
implicit none
logical,external :: op
...
end subroutine
subroutine operate(A,x,y,z)
...
logical :: TF
TF = A%op(x,y,z)
end subroutine
end module
program test
...
end program
SOLUTION COMMENTS
Just to comment on the solution (provided by #IanH): there was one additional wrinkle, and that was that I had some derived types entering the abstract interface, which according to The New Features of Fortran 2003, the Import statement should be included to make the abstract interface aware of any entering derived types. Here is a small working example, which, applied to the big code, mitigates the internal compiler error I was having :)
module DT_mod
implicit none
private
public :: DT
type DT
integer :: i
end type
contains
end module
module subs_mod
use DT_mod
implicit none
private
public :: add,mult,op_int
abstract interface
subroutine op_int(d,x,y,z)
import :: DT
implicit none
type(DT),intent(inout) :: d
integer,intent(inout) :: x
integer,intent(in) :: y,z
end subroutine
end interface
contains
subroutine add(d,x,y,z)
implicit none
type(DT),intent(inout) :: d
integer,intent(inout) :: x
integer,intent(in) :: y,z
x = y+z
d%i = 1
end subroutine
subroutine mult(d,x,y,z)
implicit none
type(DT),intent(inout) :: d
integer,intent(inout) :: x
integer,intent(in) :: y,z
x = y*z
d%i = 2
end subroutine
end module
module type_A_mod
use DT_mod
use subs_mod
implicit none
private
public :: type_A,init,operate
type type_A
procedure(op_int),pointer,nopass :: op
end type
contains
subroutine init(A,op)
implicit none
procedure(op_int) :: op
type(type_A),intent(inout) :: A
A%op => op
end subroutine
subroutine operate(A,d,x,y,z)
implicit none
type(DT),intent(inout) :: d
type(type_A),intent(in) :: A
integer,intent(inout) :: x
integer,intent(in) :: y,z
call A%op(d,x,y,z)
end subroutine
end module
program test
use type_A_mod
use subs_mod
use DT_mod
implicit none
type(type_A) :: A
type(DT) :: d
integer :: x,y,z
y = 3; z = 5
call init(A,mult)
call operate(A,d,x,y,z)
write(*,*) 'x,y,x = ',y,z,x
write(*,*) 'd%i = ',d%i
end program
Any help is greatly appreciated.

Procedure pointers were not part of the standard language until Fortran 2003, so if you want to use them at all, then Fortran 95 compatibility is irrelevant.
An internal compiler error is a error with the compiler, regardless of the source provided to the compiler.
There is no such thing as a type bound procedure pointer. You either have a type bound procedure - which is a thing declared after the CONTAINS in a derived type construct, or you have a procedure pointer - which can be a component of a type or a stand-alone object. A procedure pointer that is a component is part of the value of an object of the derived type - it can be associated with different procedures at runtime. A type bound procedure is a fixed property of the type declaration.
If you want a procedure pointer (or dummy procedure) to have an explicit interface, then you must provide an interface name inside the parenthesis of the procedure declaration statement.
procedure(interface_name_goes_here) [, pointer, ...] :: thing_being_declared
The interface name provided can be the name of an accessible specific procedure (including one previously declared by a different procedure declaration statement), or the name of an abstract interface.
(If the interface name in a procedure declaration statement is a type, as it is for the component in your example code, the procedure that is declared is a function with a result of the given type, with an implicit interface.
If the interface name in a procedure declaration statement is completely missing, the procedure that is declared may be a function or subroutine (its subsequent use in that must be consistent with one or the other) with an implicit interface.)
So assuming you want to declare a procedure pointer component with an explicit interface to a function (contrary to the question title) with the same characteristics as add or mult in your second stretch of code:
TYPE type_A
PROCEDURE(the_interface), POINTER, NOPASS :: op
END TYPE type_A
ABSTRACT INTERFACE
FUNCTION the_interface(x, y, z) RESULT(tf)
IMPLICIT NONE
! function modifying arguments - poor style!!!
INTEGER, INTENT(INOUT) :: x
INTEGER, INTENT(IN) :: y, z
LOGICAL :: tf
END FUNCTION the_interface
END INTERFACE
If you want the procedure pointer to be a subroutine with an explicit interface (which is preferable to a function that modifies its arguments) - change the abstract interface appropriately.
The dummy procedure in the init subroutine does not have to be a pointer - inside init you are not changing what the op thing references - you are merely pointing another pointer at it:
PROCEDURE(the_interface) :: op
When your dummy procedures and procedure pointers are declared with an explicit interface, I would expect a reasonable compiler to diagnose any mismatches in characteristics.

Here's my working example:
module obj_mod
integer, parameter :: n = 5
type obj_type
procedure(sub_interface), pointer, nopass :: obj_sub => NULL()
end type
interface
subroutine sub_interface(y, x)
import n
double precision, dimension(n) :: x, y
end subroutine sub_interface
end interface
contains
subroutine sq_sub(x, y)
double precision, dimension(n) :: x, y
y = x ** 2
end subroutine
subroutine exp_sub(x, y)
double precision, dimension(n) :: x, y
y = exp(x)
end subroutine
end module
program member_subroutine
use obj_mod
type(obj_type) obj
double precision, dimension(n) :: x, y
x = (/ 1, 2, 3, 4, 5 /)
write(*,*) 'x =', x
obj%obj_sub => sq_sub
call obj%obj_sub(x, y)
write(*,*) 'y1 =', y
obj%obj_sub => exp_sub
call obj%obj_sub(x, y)
write(*,*) 'y2 =', y
end program member_subroutine

Related

Valid programs showing difference between intent(out) and intent(inout) in Fortran

This is a follow up to a post that I found on SO: Difference between intent(out) and intent(inout)
The linked question asked about the difference between intent(out) and intent(inout) in Fortran by asking an invalid program.
Could anyone come up with a simple valid program(s) that give different results by changing intent(inout) to intent(out) or vice versa?
Here you go...
program intent_test
implicit none
integer, allocatable :: a(:)
a = [1,2,3,4,5]
call intent_inout (a)
call intent_out (a)
contains
subroutine intent_inout (a)
integer, allocatable, intent(inout) :: a(:)
if (allocated(a)) then
print *, a
else
print *, "Unallocated"
end if
end subroutine intent_inout
subroutine intent_out (a)
integer, allocatable, intent(out) :: a(:)
if (allocated(a)) then
print *, a
else
print *, "Unallocated"
end if
end subroutine intent_out
end program intent_test
1 2 3 4 5
Unallocated
As Steve Lionel's answer, and the comments in my original answer which perhaps sparked this interest, the effects of intent(out) on the initial state of the dummy argument (and the actual argument) are a way in to answering this question.
intent(inout) has the dummy argument reflect the value of the actual argument on entry to the procedure. intent(out) "resets" the dummy argument. In the case of the linked question, this "undefinition" is the cause of the invalid nature of the program.
More precisely, we can say the following things about intent(out) dummy arguments:
allocatable actual arguments become deallocated;
the pointer association of pointer actual arguments becomes undefined;
for a non-pointer dummy argument any component not default initialized becomes undefined.
The linked question fell foul of the third point by trying to reference such an newly undefined value. However, default initialized components are not undefined, leading us to our first class of valid programs:
implicit none
type t
integer :: x=1
end type t
type(t) :: x=t(0)
call s1(x)
call s2(x)
contains
subroutine s1(x)
type(t), intent(inout) :: x
print*, x%x
end subroutine s1
subroutine s2(x)
type(t), intent(out) :: x
print*, x%x
end subroutine s2
end
Crucially, the default initialization of the component means that x%x isn't undefined even on entry to s2, but it takes a potentially different value from the actual argument's component prior to procedure entry.
Coming up with a suitable program with pointer arguments is tricky: a pointer with undefined pointer association status can't be referenced/queried before its pointer association status is redefined.
Which leaves us looking at allocatable components. Unlike with the pointers, where we can't query pointer association status when that's undefined, we can ask about the allocation status. An actual argument corresponding to an intent(out) dummy is deallocated; with intent(inout) the allocation status is unchanged:
implicit none
integer, allocatable :: i
allocate (i)
call s1(i); print*, allocated(i)
call s2(i); print*, allocated(i)
contains
subroutine s1(i)
integer, allocatable, intent(inout) :: i
end subroutine s1
subroutine s2(i)
integer, allocatable, intent(out) :: i
end subroutine s2
end
(This is a simpler version of Steve Lionel's example.)
This all shows that it's possible to have differences. Using intent incorrectly can lead to invalid programs or to significant changes in meaning. Understanding what intent(in), intent(inout), intent(out) and no specified intent mean is a crucial part of being a Fortran programmer.

User defined type as argument to elemental subroutine?

In my code I have an elemental subroutine which is basically like this:
elemental subroutine calc_stuff (x, a, b, c)
real, intent(in) :: a, b, c
real, intent(out) :: x
x = a/b + c
end subroutine calc_stuff
which I changed to this:
elemental subroutine calc_stuff (x, a, t)
real, intent(in) :: a
type(mytype), intent(in) :: t
real, intent(out) :: x
x = a/t%b + t%c
end subroutine calc_stuff
where mytype is a type containing some scalar real and integer, as well as a real, allocatable array. The members b and c are reals, making the second version basically the same as the first one.
The second version compiles fine on various compilers (Cray, Intel, NEC, GFortran), but now I read that the standard states for elemental subroutines:
All dummy arguments must be scalar, and must not have the ALLOCATABLE or POINTER attribute.
Is my code therefore not standard-conforming when passing a user-defined type to an elemental subroutine, but all the compilers "know" what I want because I am only using scalars from the type and not the allocatable array? Or am I misunderstanding the wording of the standard and everything is fine with the second version?
The dummy argument t is scalar1 and does not have the pointer attribute and does not have the allocatable attribute. It does not violate the condition.
The attributes of components of the type do not have a bearing on the attributes of the type itself.
1 Being of derived type doesn't make an object necessarily non-scalar. Even with multiple, or array components, the object itself may still be scalar. A derived type array is an array with element(s) of that type. Think also of a character object like character(len=3) name: it is scalar but consists of multiple substrings.

Proper way to pass pointers into many subroutines

I'm not a very good programmer and I'm just trying to interface with a model that provides data as pointers. These pointers are passed down through several subroutines before data is written to them. I'm not sure how to do this so that I avoid memory leaks.
Let's say I have an array pointer A that is passed to several subroutines before being written to, how do I handle the declarations, allocations, and deallocations?
module data
implicit none
contains
subroutine s1(a)
real, pointer, intent(out) :: a(5,5)
call s2(a)
end subroutine s1
subroutine s2(a)
real, pointer, intent(out) :: a(5,5)
integer :: i
do i = 1,5
a(:,i) = 5.0
end do
end subroutine s2
end module data
Program test
use data, only : s1, s2
real, pointer, dimension(:,:) :: A => NULL()
allocate(A(5,5))
call s1(A)
write(*,*) A
deallocate(A)
end Program test
Please note that your code is not Fortran 90. The intent attribute for dummy (formal) arguments that are pointers was introduced in Fortran 2003.
The intent refers to the association status of the pointer, not to its target. Also, if the argument is a derived type with
pointer components, the intent applies to the type object itself, not the targets of the pointers. That is, if, for example, intent(in) is used, the data area that the pointer is targeted at can be modified:
module MyType_mod
implicit none
private
type, public :: MyType
integer, pointer :: ptr(:)
contains
procedure :: sub => my_type_sub
end type MyType
contains
subroutine my_type_sub(self)
! Dummy argument
class(MyType), intent(in) :: self
! The following is perfectly legal,
! even though intent(in) was specified
self%ptr = 42
end subroutine my_type_sub
end module MyType_mod
program main
use MyType_mod, only: &
MyType
implicit none
type(MyType) :: foo
integer :: alloc_stat
allocate( integer :: foo%ptr(100), stat=alloc_stat )
call foo%sub()
end program main
Even though not required, in a case such as the previous example, it is better to state intent(inout) to indicate to the reader that modification of data is taking place.
On another note, you may find this answer useful Fortran subroutine returning wrong values

Interface mismatch in dummy procedure 'f' when passing a function to a subroutine

I am trying to write a subroutine (for minimisation) that has two arguments:
an array x of any length
a function f that takes an array of that length and returns a scalar
example module:
module foo
contains
subroutine solve(x, f)
real, dimension(:), intent(inout) :: x
interface
real pure function f(y)
import x
real, dimension(size(x)), intent(in) :: y
end function
end interface
print *, x
print *, f(x)
end subroutine
end module
and test program:
use foo
real, dimension(2) :: x = [1.0, 2.0]
call solve(x, g)
contains
real pure function g(y)
real, dimension(2), intent(in) :: y
g = sum(y)
end function
end
gfortran fails on:
call solve(x, g)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Shape mismatch in dimension 1 of argument 'y'
If I change size(x) => 2 then it compiles (and runs) fine. It also works fine if I change : => 2. But neither of these solutions gets me what I want.
Any ideas on how I can achieve this?
How about:
interface
real pure function f(y)
real, dimension(:), intent(in) :: y
end function
end interface
When you pass the argument of solve to the function, the size of the array will automatically be passed. You don't need to make this part of the interface.
If you want to gain safety as indicated in your comment of M.S.B's solution, you should use -fcheck=bounds and the compiler will generate run-time checks for assumed and deferred shape arrays. See the gfortran man page for more info on -fcheck. However, you will lose some speed.
You have the solution, but for what its worth an explanation... if the dummy argument has an explicit interface (which it does here) then there is a requirement that the characteristics of a procedure passed as an actual argument must match those of the dummy argument, with some exceptions around pureness and elemental intrinsics. The characteristics of a procedure include the characteristics of its dummy arguments, amongst other things.
The characteristics of a dummy argument include its shape, amongst other things. If that shape is not a constant expression - the characteristics include "the exact dependence [of the shape] on the entities in the expression".
The interface block for the dummy argument f declares the array to be of size SIZE(x). x is a host associated assumed shape variable - its size can vary at runtime, so SIZE(x) is not a constant. Hence that expression and the entities in it becomes a characteristic of the dummy argument.
The module procedure g declares the array to be of size 2. That is clearly a constant.
Regardless of the value of the non-constant expression for the size of the dummy argument of f, those array size characteristics (some sort of expression vs a constant) don't match - hence the error.
When you replace SIZE(x) with the constant 2 the characteristics obviously match. When you change the assumed shape x to be a constant size 2 - then SIZE(x) becomes a constant expression of value 2 - because it is a constant expression all that is relevant is its value - hence the characteristics of the two arguments then match. When you change both the dummy argument of f and the dummy argument of g to be assumed shape (:), the characteristics match.
Here is a demo to show how to pass allocatable array.
Some tips:
Use modules to avoid cumbersome interface.
Add extra matrix size information when pass array to the actual function. For example f(y, sizeinfo) so that inside your actual function you can declare the size of the input matrix correctly. The allocatable array can be passed to subroutine solve, so the size can be obtained using size(mat) in your subroutine solve.
So a corrected version looks like:
module foo
contains
subroutine solve(x, f)
real, dimension(:), intent(inout) :: x
real,external::f
integer::sizeinfo
print *,'x=', x
sizeinfo = size(x)
print *, 'f(x)=',f(x,sizeinfo)
end subroutine
real function g(y,sizeinfo)
integer::sizeinfo
real, dimension(sizeinfo) :: y
g = sum(y)
end function
end module
Here is main program:
program main
use foo
real, dimension(2) :: x = (/1.0, 2.0/)
call solve(x, g)
end program
And the result is :
x= 1.000000 2.000000
f(x)= 3.000000

Type-bound function overloading in Fortran 2003

I have a Fortran derived type T that contains data arrays of (many) different ranks and types. These arrays are hidden inside a complicated data structure and I would like to have a getter function of that does the following:
a => T%get(data_id)
where "a" is an array pointer of given type, and data_id is an integer that is used to find the data inside the data structure. I do that by overloading many "get_thistype()" functions under a generic name.
TYPE T
PROCEDURE :: get_real
PROCEDURE :: get_integer
GENERIC :: get => get_real,get_integer
END TYPE
This works if the get_thistype() routines are subroutines, but not if they are written as functions. This means my code looks like:
CALL T%get(a,data_id)
which I find much less readable. Is there a way to overload functions that have the same argument list but different return types? or do I have to use subroutines for that?
When a (pointer) assignment statement gets executed in fortran, the right hand side always gets evaluated fully before the assignment takes place. This happens independently of the left hand side, so there is absolutely no way that the LHS can influence the outcome of the evaluation of the RHS. It's just the way the language is designed.
I just came across this post, so for the benefit of anyone see this in the future:
If I understand the question correctly, you can accomplish this by overloading the assignment operator. Example:
file X.f90:
MODULE XModule
TYPE :: X
INTEGER, DIMENSION(:), POINTER :: IntArray
REAL, DIMENSION(:), POINTER :: RealArray
END TYPE
INTERFACE ASSIGNMENT (=)
MODULE PROCEDURE PointToInt
MODULE PROCEDURE PointToReal
END INTERFACE
CONTAINS
SUBROUTINE PointToInt(Ip, V)
INTEGER, POINTER, DIMENSION(:), INTENT(OUT) :: Ip
TYPE(X), INTENT(IN) :: V
Ip => V%IntArray
END SUBROUTINE PointToInt
SUBROUTINE PointToReal(Rp, V)
REAL, POINTER, DIMENSION(:), INTENT(OUT) :: Rp
TYPE(X), INTENT(IN) :: V
Rp => V%RealArray
END SUBROUTINE PointToReal
END MODULE
test driver file Driver.f90:
PROGRAM Driver
USE XModule
TYPE(X) :: Var
INTEGER, DIMENSION(:), POINTER :: I
REAL, DIMENSION(:), POINTER :: R
ALLOCATE(Var%IntArray(2))
ALLOCATE(Var%RealArray(3))
Var%IntArray = [1, 2]
Var%RealArray = [1., 2., 3.]
I = Var
PRINT*, I
R = Var
PRINT*, R
END PROGRAM
Output:
1 2
1.000000 2.000000 3.000000
Hope this helps.