Fortran procedure pointer to subroutines in derived type

Question

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.

Durer

Consider just showing the difference, it is difficult to see what you have changed in update 2, especially considering you don't use any empty lines in your code (that makes it hard to read). – Tetrapody

BTW, try -std=f95 in gfortran and you will see how many things are actually Fortran 2003 and later. – Tetrapody

Thanks @VladimirF, I recently tried this, it was helpful. – Durer

Answer 1

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.

Harlen

This looks very promising. I have one remaining problem with this implementation. When I try to init the procedure in my big code (call init(A,mult) in the small code), I'm getting an error that says "Interface mismatch in dummy procedure 'operator' at (1): INTENT mismatch in argument 'x'". That said, I was now able to compile the file that previously resulted in a internal compiler error. – Durer

Answer 2

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

Bartholomew

It is always better to describe what is the solution, not just dump some code. What did the OP wrong? Or how does your solution differ? What about ponts 1, 2 and 3 in the question? – Tetrapody