What is wrong with this fortran code using pointer aliases - pointers

The example consists of two files
md_ptr.f90 :
module md_ptr
implicit none
public
type test_data
real :: x, y(3), z(2) , dx, dy, dz
integer :: ii , jj , kk
real :: res
end type
type(test_data), allocatable, target :: dat(:)
real, pointer :: res(:)
contains
subroutine alloc(n)
implicit none
integer, intent(in) :: n
allocate(dat(n))
res => dat(:)%res
res(1:2) = 112312.12 ! for debugging!
end subroutine
subroutine call_alloc(n)
implicit none
integer, intent(in) :: n
call alloc(n)
end subroutine
end module
The second file test_ptr.f90
program testpointer
use md_ptr
implicit none
call call_alloc(100)
write(*,*) res(1:2), dat(1:2)% res
end program
Compiling this with gfortran version 9.3.0:
gfortran -c md_ptr.f90 test_ptr.f90; gfortran md_ptr.o test_ptr.o
Now when running I get following output:
112312.117 0.00000000 112312.117 112312.117
As you can see the second output of the pointer alias res is not correct!
Now, if i replace gfortran with ifort I get the expected output:
112312.117 112312.117 112312.117 112312.117
**UPDATE
Also tested with gfortran 10.1.0 with similar outcome as version 9.3.0
Tested with Cray compiler which did indeed produce the expected outcome as with ifort

Related

Fortran Procedure Pointers to Interfaces [duplicate]

I am using procedure overloading and interfaces in order to achieve some sort of genericity in a Fortran program.
For this, I have a module which contains a number of procedures, all duplicated in order to be able to change the variable types. I also have at the beginning of the module, a series of interfaces of the type:
interface norm
module procedure &
norm_r8, &
norm_c
end interface
Now my problem is that I am trying to reference norm using a procedure pointer, as such (in a different module):
procedure(), POINTER :: pNorm => NULL()
pNorm => norm
However, in this situation, gfortran gives me an error saying that I have an undefined reference to norm. If I point to norm_r8 or norm_c, no problem. But since the part of the code that assigns the pointer is not aware of the type of the variables that will be used when norm is called, I need to point to the generic name! Is there a way to point towards an overloaded procedure?
As far as I can tell, a procedure pointer is not allowed to point at a generic interface. The standard only mentions procedures with the EXTERNAL attribute, a module procedures, or certain intrinsic procedures may be associated with a procedure pointer (C1220, ISO/IEC 1539-1:2010). Gfortran also issues a helpful error message for your case:
Error: Procedure pointer target 'norm' at (1) must be either an intrinsic,
host or use associated, referenced or have the EXTERNAL attribute
It also makes sense that you cannot associate to an interface, but only a procedure. An interface is only used in the procedure(INTERFACE) statement to give an explicit interface to the procedures it can point at.
This shouldn't be a showstopper for you, as the purpose of a generic interface can negate your need for a pointer. As long as all potential calls the pointer would be used for are unique in type, kind, rank and number of arguments (so the compiler can differentiate between them), you can just add all of them to a single generic interface and call that in lieu of the pointer. Alternatively you could use a select type() construct to selectively associate your pointer with the specific procedure for your type to avoid needing to associate with a generic interface.
Here is an example of a wrapper procedure to assign the pointer to a specific procedure based on an argument type
subroutine get_proc_ptr(pp, arg)
implicit none
procedure(), pointer, intent(out) :: pp
class(*), intent(inout) :: arg
select type(arg)
type is (real(kind=kind(1d0)))
pp => norm_r8
type is (real)
pp => norm_r
type is (integer)
pp => norm_i
type is (complex)
pp => norm_c
class default
pp => null()
end select
end subroutine
Which can be made use of like this:
real(kind=kind(1d0)) :: arg_r8
procedure(), pointer :: pNorm => null()
arg_r8 = 4.0123456789d30
call get_proc_ptr(pNorm, arg_r8)
call pNorm(arg_r8)
Here is a complete compilable example:
module proc
implicit none
interface norm
module procedure &
norm_r8, &
norm_r, &
norm_i, &
norm_c
end interface
contains
subroutine norm_r8(arg)
implicit none
real(kind=kind(1d0)), intent(in) :: arg
write (*,*) "real8: ", arg
end subroutine
subroutine norm_r(arg)
implicit none
real, intent(in) :: arg
write (*,*) "real: ", arg
end subroutine
subroutine norm_i(arg)
implicit none
integer, intent(in) :: arg
write (*,*) "integer: ", arg
end subroutine
subroutine norm_c(arg)
implicit none
complex, intent(in) :: arg
write (*,*) "complex: ", arg
end subroutine
subroutine get_proc_ptr(pp, arg)
implicit none
procedure(), pointer, intent(out) :: pp
class(*), intent(inout) :: arg
select type(arg)
type is (real(kind=kind(1d0)))
pp => norm_r8
type is (real)
pp => norm_r
type is (integer)
pp => norm_i
type is (complex)
pp => norm_c
class default
pp => null()
end select
end subroutine
end module
program test
use proc
implicit none
real(kind=kind(1d0)) :: arg_r8
real :: arg_r
integer :: arg_i
complex :: arg_c
procedure(), pointer :: pNorm => null()
arg_r8 = 4.0123456789d30
arg_r = 12.5
arg_i = 56
arg_c = (34,3)
call get_proc_ptr(pNorm, arg_r8)
call pNorm(arg_r8)
call get_proc_ptr(pNorm, arg_r)
call pNorm(arg_r)
call get_proc_ptr(pNorm, arg_i)
call pNorm(arg_i)
call get_proc_ptr(pNorm, arg_c)
call pNorm(arg_c)
end program
And here is the output of this program:
$ ./testprocptr
real8: 4.0123456788999999E+030
real: 12.5000000
integer: 56
complex: ( 34.0000000 , 3.00000000 )
If I understand well, you want to achieve two things at one time.
First, you want to use polymorphism to let the compiler call the correct routine dependent on whether you have a different type, rank, number of arguments etcetera.
Second, you want to use procedure pointers to switch between different procedures that have the same interface.
I tried the same. I did not manage to set a pointer to an interface, but I managed to make an interface with pointers.
If you have a module like this
module some_module
! This is the abstract interface for procedure pointers.
interface
subroutine shape_1_interface(arg)
implicit none
real, intent(in) :: arg
end subroutine shape_1_interface
subroutine shape_2_interface(arg)
implicit none
integer, intent(in) :: arg
end subroutine shape_2_interface
end interface
contains
subroutine routine_shape_1_implementation_1(arg)
implicit none
real, intent(in) :: arg
write(*,*) "Arg is real",arg
write(*,*) "Implementation 1"
end subroutine routine_shape_1_implementation_1
subroutine routine_shape_2_implementation_1(arg)
implicit none
integer, intent(in) :: arg
write(*,*) "Arg is int",arg
write(*,*) "Implementation 1"
end subroutine routine_shape_2_implementation_1
subroutine routine_shape_1_implementation_2(arg)
implicit none
real, intent(in) :: arg
write(*,*) "Arg is real",arg
write(*,*) "Implementation 2"
end subroutine routine_shape_1_implementation_2
subroutine routine_shape_2_implementation_2(arg)
implicit none
integer, intent(in) :: arg
write(*,*) "Arg is int",arg
write(*,*) "Implementation 2"
end subroutine routine_shape_2_implementation_2
subroutine routine_shape_1_implementation_3(arg)
implicit none
real, intent(in) :: arg
write(*,*) "Arg is real",arg
write(*,*) "Implementation 3"
end subroutine routine_shape_1_implementation_3
subroutine routine_shape_2_implementation_3(arg)
implicit none
integer, intent(in) :: arg
write(*,*) "Arg is int",arg
write(*,*) "Implementation 3"
end subroutine routine_shape_2_implementation_3
end module some_module
then you can do in your main program:
program main
use some_module
implicit none
procedure(shape_1_interface), pointer :: routine_shape_1
procedure(shape_2_interface), pointer :: routine_shape_2
interface routine
procedure routine_shape_1
procedure routine_shape_2
end interface routine
routine_shape_1 => routine_shape_1_implementation_1
routine_shape_2 => routine_shape_2_implementation_1
call routine(4)
routine_shape_1 => routine_shape_1_implementation_2
routine_shape_2 => routine_shape_2_implementation_2
call routine(4.0)
end program main
It is a pity that when you want to set the pointers to a different implementation, you have to do that for all shapes, but the good thing is that you can just call 'routine' and you automatically get the desired function.
This is the output:
Arg is int 4
Implementation 1
Arg is real 4.00000000000000
Implementation 2

Can I point to variable ranked arrays in Fortran? [duplicate]

There are basically two ways to pass arrays to a subroutine in Fortran 90/95:
PROGRAM ARRAY
INTEGER, ALLOCATABLE :: A(:,:)
INTEGER :: N
ALLOCATE(A(N,N))
CALL ARRAY_EXPLICIT(A,N)
! or
CALL ARRAY_ASSUMED(A)
END PROGRAM ARRAY
SUBROUTINE ARRAY_EXPLICIT(A,N)
INTEGER :: N
INTEGER :: A(N,N)
! bla bla
END SUBROUTINE ARRAY_EXPLICIT
SUBROUTINE ARRAY_ASSUMED(A)
INTEGER, ALLOCATABLE :: A(:,:)
N=SIZE(A,1)
! bla bla
END SUBROUTINE ARRAY_ASSUMED
where you need an explicit interface for the second, usually through the use of a module.
From FORTRAN77, I'm used to the first alternative, and I read this is also the most efficient if you pass the whole array.
The nice thing with the explicit shape is that I can also call a subroutine and treat the array as a vector instead of a matrix:
SUBROUTINE ARRAY_EXPLICIT(A,N)
INTEGER :: N
INTEGER :: A(N**2)
! bla bla
END SUBROUTINE ARRAY_EXPLICIT
I wondered if there is a nice way to do that kind of thing using the second, assumed shape interface, without copying it.
See the RESHAPE intrinsic, e.g.
http://gcc.gnu.org/onlinedocs/gfortran/RESHAPE.html
Alternatively, if you want to avoid the copy (in some cases an optimizing compiler might be able to do a reshape without copying, e.g. if the RHS array is not used afterwards, but I wouldn't count on it), as of Fortran 2003 you can assign pointers to targets of different rank, using bounds remapping. E.g. something like
program ptrtest
real, pointer :: a(:)
real, pointer :: b(:,:)
integer :: n = 10
allocate(a(n**2))
a = 42
b (1:n, 1:n) => a
end program ptrtest
I was looking to do the same thing and came across this discussion. None of the solutions suited my purposes, but I found that there is a way to reshape an array without copying the data using iso_c_binding if you are using the fortran 2003 standard which current fortran 90/95 compilers tend to support. I know the discussion is old, but I figured I would add what I came up with for the benefit of others with this question.
The key is to use the function C_LOC to convert an array to an array pointer, and then use C_F_POINTER to convert this back into a fortran array pointer with the desired shape. One challenge with using C_LOC is that C_LOC only works for array that have a directly specified shape. This is because arrays in fortran with an incomplete size specification (i.e., that use a : for some dimension) include an array descriptor along with the array data. C_LOC does not give you the memory location of the array data, but the location of the descriptor. So an allocatable array or a pointer array don't work with C_LOC (unless you want the location of the compiler specific array descriptor data structure). The solution is to create a subroutine or function that receives the array as an array of fixed size (the size really doesn't matter). This causes the array variable in the function (or subroutine) to point to the location of the array data rather than the location of the array descriptor. You then use C_LOC to get a pointer to the array data location and C_F_POINTER to convert this pointer back into an array with the desired shape. The desired shape must be passed into this function to be used with C_F_POINTER. Below is an example:
program arrayresize
implicit none
integer, allocatable :: array1(:)
integer, pointer :: array2(:,:)
! allocate and initialize array1
allocate(array1(6))
array1 = (/1,2,3,4,5,6/)
! This starts out initialized to 2
print *, 'array1(2) = ', array1(2)
! Point array2 to same data as array1. The shape of array2
! is passed in as an array of intergers because C_F_POINTER
! uses and array of intergers as a SIZE parameter.
array2 => getArray(array1, (/2,3/))
! Change the value at array2(2,1) (same as array1(2))
array2(2,1) = 5
! Show that data in array1(2) was modified by changing
! array2(2,1)
print *, 'array(2,1) = array1(2) = ', array1(2)
contains
function getArray(array, shape_) result(aptr)
use iso_c_binding, only: C_LOC, C_F_POINTER
! Pass in the array as an array of fixed size so that there
! is no array descriptor associated with it. This means we
! can get a pointer to the location of the data using C_LOC
integer, target :: array(1)
integer :: shape_(:)
integer, pointer :: aptr(:,:)
! Use C_LOC to get the start location of the array data, and
! use C_F_POINTER to turn this into a fortran pointer (aptr).
! Note that we need to specify the shape of the pointer using an
! integer array.
call C_F_POINTER(C_LOC(array), aptr, shape_)
end function
end program
#janneb has already answered re RESHAPE. RESHAPE is a function -- usually used in an assignment statement so there will be a copy operation. Perhaps it can be done without copying using pointers. Unless the array is huge, it is probably better to use RESHAPE.
I'm skeptical that the explicit shape array is more efficient than the assumed shape, in terms of runtime. My inclination is to use the features of the Fortran >=90 language and use assumed shape declarations ... that way you don't have to bother passing the dimensions.
EDIT:
I tested the sample program of #janneb with ifort 11, gfortran 4.5 and gfortran 4.6. Of these three, it only works in gfortran 4.6. Interestingly, to go the other direction and connect a 1-D array to an existing 2-D array requires another new feature of Fortran 2008, the "contiguous" attribute -- at least according to gfortran 4.6.0 20110318. Without this attribute in the declaration, there is a compile time error.
program test_ptrs
implicit none
integer :: i, j
real, dimension (:,:), pointer, contiguous :: array_twod
real, dimension (:), pointer :: array_oned
allocate ( array_twod (2,2) )
do i=1,2
do j=1,2
array_twod (i,j) = i*j
end do
end do
array_oned (1:4) => array_twod
write (*, *) array_oned
stop
end program test_ptrs
You can use assumed-size arrays, but it can mean multiple layers of wrapper
routines:
program test
implicit none
integer :: test_array(10,2)
test_array(:,1) = (/1, 2, 3, 4, 5, 6, 7, 8, 9, 10/)
test_array(:,2) = (/11, 12, 13, 14, 15, 16, 17, 18, 19, 20/)
write(*,*) "Original array:"
call print_a(test_array)
write(*,*) "Reshaped array:"
call print_reshaped(test_array, size(test_array))
contains
subroutine print_reshaped(a, n)
integer, intent(in) :: a(*)
integer, intent(in) :: n
call print_two_dim(a, 2, n/2)
end subroutine
subroutine print_two_dim(a, n1, n2)
integer, intent(in) :: a(1:n1,1:*)
integer, intent(in) :: n1, n2
call print_a(a(1:n1,1:n2))
end subroutine
subroutine print_a(a)
integer, intent(in) :: a(:,:)
integer :: i
write(*,*) "shape:", shape(a)
do i = 1, size(a(1,:))
write(*,*) a(:,i)
end do
end subroutine
end program test
I am using ifort 14.0.3 and 2D to 1D conversion, I could use an allocatable array for 2D array and a pointer array for 1D:
integer,allocatable,target :: A(:,:)
integer,pointer :: AP(:)
allocate(A(3,N))
AP(1:3*N) => A
As #M.S.B mentioned, in case both A and AP have the pointer attribute, I had to use contiguous attribute for A to guarantee the consistency of the conversion.
Gfortran is a bit paranoid with interfaces. It not only wants to know the type, kind, rank and number of arguments, but also the shape, the target attribute and the intent (although I agree with the intent part). I encountered a similar problem.
With gfortran, there are three different dimension definition:
1. Fixed
2. Variable
3. Assumed-size
With ifort, categories 1 and 2 are considered the same, so you can do just define any dimension size as 0 in the interface and it works.
program test
implicit none
integer, dimension(:), allocatable :: ownlist
interface
subroutine blueprint(sz,arr)
integer, intent(in) :: sz
integer, dimension(0), intent(in) :: arr
! This zero means that the size does not matter,
! as long as it is a one-dimensional integer array.
end subroutine blueprint
end interface
procedure(blueprint), pointer :: ptr
allocate(ownlist(3))
ownlist = (/3,4,5/)
ptr => rout1
call ptr(3,ownlist)
deallocate(ownlist)
allocate(ownlist(0:10))
ownlist = (/3,4,5,6,7,8,9,0,1,2,3/)
ptr => rout2
call ptr(3,ownlist)
deallocate(ownlist)
contains
! This one has a dimension size as input.
subroutine rout1(sz,arr)
implicit none
integer, intent(in) :: sz
integer, dimension(sz), intent(in) :: arr
write(*,*) arr
write(*,*) arr(1)
end subroutine rout1
! This one has a fixed dimension size.
subroutine rout2(sz,arr)
implicit none
integer, intent(in) :: sz
integer, dimension(0:10), intent(in) :: arr
write(*,*) "Ignored integer: ",sz
write(*,*) arr
write(*,*) arr(1)
end subroutine rout2
end program test
Gfortran complains about the interface. Changing the 0 into 'sz' solves the problem four 'rout1', but not for 'rout2'.
However, you can fool gfortran around and say dimension(0:10+0*sz) instead of dimension(0:10) and gfortran compiles and gives the same
result as ifort.
This is a stupid trick and it relies on the existence of the integer 'sz' that may not be there. Another program:
program difficult_test
implicit none
integer, dimension(:), allocatable :: ownlist
interface
subroutine blueprint(arr)
integer, dimension(0), intent(in) :: arr
end subroutine blueprint
end interface
procedure(blueprint), pointer :: ptr
allocate(ownlist(3))
ownlist = (/3,4,5/)
ptr => rout1
call ptr(ownlist)
deallocate(ownlist)
allocate(ownlist(0:10))
ownlist = (/3,4,5,6,7,8,9,0,1,2,3/)
ptr => rout2
call ptr(ownlist)
deallocate(ownlist)
contains
subroutine rout1(arr)
implicit none
integer, dimension(3), intent(in) :: arr
write(*,*) arr
write(*,*) arr(1)
end subroutine rout1
subroutine rout2(arr)
implicit none
integer, dimension(0:10), intent(in) :: arr
write(*,*) arr
write(*,*) arr(1)
end subroutine rout2
end program difficult_test
This works under ifort for the same reasons as the previous example, but gfortran complains about the interface. I do not know how I can fix it.
The only thing I want to tell gfortran is 'I do not know the dimension size yet, but we will fix it.'. But this needs a spare integer arguemnt (or something else that we can turn into an integer) to fool gfortran around.

Passing a null pointer actual argument to a member procedure of a derived type

Is passing a null pointer to a function and a subroutine valid according
to the Fortran 2003 standard? Please suppose that the called function and
the subroutine can correctly handle the case in which the dummy argument is
a null pointer. I am especially interested in the case where such function and
subroutine are a 'member' function and subroutine of a derived type.
I would like to avoid checking the association status of each pointer in the
calling side if it is allowed by standard, in much the same way that I don't
have to treat the zero-size array separately. At the same time, I do not want to
rely on a behavior not specified by the standard.
As far as I tried with the following example, ifort and gfortran showed
different behaviors regarding this point.
moo.f90
MODULE moo
IMPLICIT NONE
PRIVATE
PUBLIC LL
TYPE LL
INTEGER :: i0
CONTAINS
PROCEDURE :: func1
PROCEDURE :: func2
END type LL
CONTAINS
FUNCTION func1(self) RESULT(pLL_dest)
TYPE(LL), POINTER :: pLL_dest
CLASS(LL), TARGET, INTENT(IN) :: self
write(*,*) 'hello from func1'
pLL_dest => null()
!pLL_dest => self
END FUNCTION func1
FUNCTION func2(self) RESULT(flg)
LOGICAL :: flg
CLASS(LL), TARGET, INTENT(IN) :: self
write(*,*) 'hello from func2'
flg = .true.
END FUNCTION func2
END MODULE moo
main.f90
PROGRAM chk_nullpo
USE moo, ONLY : LL
IMPLICIT NONE
!CLASS(LL), POINTER :: pLL_s=>null()
TYPE(LL), POINTER :: pLL_s=>null()
TYPE(LL), POINTER :: pLL_d=>null()
LOGICAL :: flg
write(*,*) 'associated(pLL_s) =',associated(pLL_s)
write(*,*) 'associated(pLL_d) =',associated(pLL_d)
write(*,*) 'func1..'
pLL_d => pLL_s%func1()
write(*,*) 'associated(pLL_s) =',associated(pLL_s)
write(*,*) 'associated(pLL_d) =',associated(pLL_d)
write(*,*) 'func2..'
flg =pLL_s%func2()
write(*,*) 'flg=', flg
write(*,*) 'associated(pLL_s) =',associated(pLL_s)
write(*,*) 'associated(pLL_d) =',associated(pLL_d)
write(*,*) 'normal end'
END PROGRAM chk_nullpo
Executable generated by ifort caused a run-time error when the member
subroutine func2 is called with the null pointer.
$ ifort -v
ifort version 14.0.2
$ ifort -c moo.f90 -stand f03 -warn all -check
$ ifort -c main.f90 -stand f03 -warn all -check
$ ifort -o ex_ifort moo.o main.o -stand f03 -warn all -check
ifort: warning #10182: disabling optimization; runtime debug checks enabled
$ ./ex_ifort
associated(pLL_s) = F
associated(pLL_d) = F
func1..
hello from func1
associated(pLL_s) = F
associated(pLL_d) = F
func2..
forrtl: severe (408): fort: (7): Attempt to use pointer PLL_S when it is not associated with a target
Image PC Routine Line Source
ex_ifort 0000000000402AE1 Unknown Unknown Unknown
ex_ifort 0000000000402336 Unknown Unknown Unknown
libc.so.6 00002AC53B23DF45 Unknown Unknown Unknown
ex_ifort 0000000000402229 Unknown Unknown Unknown
$
On the other hand, executable generated by gfortran finished without error.
$ gfortran --version
GNU Fortran (Ubuntu 4.8.4-2ubuntu1~14.04.3) 4.8.4
Copyright (C) 2013 Free Software Foundation, Inc.
GNU Fortran comes with NO WARRANTY, to the extent permitted by law.
You may redistribute copies of GNU Fortran
under the terms of the GNU General Public License.
For more information about these matters, see the file named COPYING
$ gfortran -c moo.f90 -std=f2003 -Wall -fbounds-check
moo.f90:26.21:
FUNCTION func2(self) RESULT(flg)
1
Warning: Unused dummy argument 'self' at (1)
moo.f90:16.21:
FUNCTION func1(self) RESULT(pLL_dest)
1
Warning: Unused dummy argument 'self' at (1)
$ gfortran -c main.f90 -std=f2003 -Wall -fbounds-check
$ gfortran -o ex_gfortran moo.o main.o -std=f2003 -Wall -fbounds-check
$ ./ex_gfortran
associated(pLL_s) = F
associated(pLL_d) = F
func1..
hello from func1
associated(pLL_s) = F
associated(pLL_d) = F
func2..
hello from func2
flg= T
associated(pLL_s) = F
associated(pLL_d) = F
normal end
$
Is the behavior of ifort not comforming the standard, or
is the behavior of gfortran just graceful? Or, the standard doesn't
say anything about this point?
I note that both of these compilers are older versions, and I guess
a newer version might show different behavior.
Both compilers are behaving in a legitimate way here. That is, the code is faulty but not in a way which requires a compiler to provide diagnostics.
Look at the pointer assignment statement
pLL_d => pLL_s%func1()
This is a reference to the binding name func1 of type LL. However, at the point execution reaches here pLL_s is not associated. The procedure reference is therefore not allowed. According to Fortran 2008 12.5.1:
The data-ref in a procedure-designator shall not be ... a pointer that is not associated.
As this is not a numbered constraint it is the responsibility of the programmer to ensure compliance.
Moving on beyond this problem to the general question "is passing a null pointer to a function and a subroutine valid?", the answer is "yes, as long as its use doesn't violate the usual conditions".
In summary, although conceptually the reference in
pLL_d => pLL_s%func1() ! Using func1 as a binding name
is like that in
pLL_d => func1(pLL_s) ! For the module's procedure func1
the problem isn't that pLL_s is a not associated pointer actual argument. That latter form is allowed but the former isn't.1
Of interest for this question is the requirement about definition of the function result. For func1 the function result is a pointer, so it is necessary that the association status of the result be defined. If the function is referenced by its binding name then necessarily the association status of self is defined. Indeed, self is associated.
1 That's actually a little of an oversimplification. While it's true that a procedure may be allowed an actual argument that is a not associated pointer, that doesn't hold for those procedures here.
Look at the declaration of the dummy arguments
CLASS(LL), TARGET, INTENT(IN) :: self
Here self is a non-optional non-pointer dummy. To be argument associated with a pointer actual argument that actual argument must be pointer associated. So, the functions aren't ones which "correctly handle the case in which the dummy argument is a null pointer".
That said, there'd be nothing wrong with a statement like
pLL_d => pLL_s%func1(ptr) ! or
pLL_d => func1(pLL_s, ptr)
with pLL_s pointer associated and ptr a potentially non-associated actual corresponding to a pointer dummy. The passed-object dummy argument is really just a very special case.

Procedure pointer to interfaced/overloaded procedure

I am using procedure overloading and interfaces in order to achieve some sort of genericity in a Fortran program.
For this, I have a module which contains a number of procedures, all duplicated in order to be able to change the variable types. I also have at the beginning of the module, a series of interfaces of the type:
interface norm
module procedure &
norm_r8, &
norm_c
end interface
Now my problem is that I am trying to reference norm using a procedure pointer, as such (in a different module):
procedure(), POINTER :: pNorm => NULL()
pNorm => norm
However, in this situation, gfortran gives me an error saying that I have an undefined reference to norm. If I point to norm_r8 or norm_c, no problem. But since the part of the code that assigns the pointer is not aware of the type of the variables that will be used when norm is called, I need to point to the generic name! Is there a way to point towards an overloaded procedure?
As far as I can tell, a procedure pointer is not allowed to point at a generic interface. The standard only mentions procedures with the EXTERNAL attribute, a module procedures, or certain intrinsic procedures may be associated with a procedure pointer (C1220, ISO/IEC 1539-1:2010). Gfortran also issues a helpful error message for your case:
Error: Procedure pointer target 'norm' at (1) must be either an intrinsic,
host or use associated, referenced or have the EXTERNAL attribute
It also makes sense that you cannot associate to an interface, but only a procedure. An interface is only used in the procedure(INTERFACE) statement to give an explicit interface to the procedures it can point at.
This shouldn't be a showstopper for you, as the purpose of a generic interface can negate your need for a pointer. As long as all potential calls the pointer would be used for are unique in type, kind, rank and number of arguments (so the compiler can differentiate between them), you can just add all of them to a single generic interface and call that in lieu of the pointer. Alternatively you could use a select type() construct to selectively associate your pointer with the specific procedure for your type to avoid needing to associate with a generic interface.
Here is an example of a wrapper procedure to assign the pointer to a specific procedure based on an argument type
subroutine get_proc_ptr(pp, arg)
implicit none
procedure(), pointer, intent(out) :: pp
class(*), intent(inout) :: arg
select type(arg)
type is (real(kind=kind(1d0)))
pp => norm_r8
type is (real)
pp => norm_r
type is (integer)
pp => norm_i
type is (complex)
pp => norm_c
class default
pp => null()
end select
end subroutine
Which can be made use of like this:
real(kind=kind(1d0)) :: arg_r8
procedure(), pointer :: pNorm => null()
arg_r8 = 4.0123456789d30
call get_proc_ptr(pNorm, arg_r8)
call pNorm(arg_r8)
Here is a complete compilable example:
module proc
implicit none
interface norm
module procedure &
norm_r8, &
norm_r, &
norm_i, &
norm_c
end interface
contains
subroutine norm_r8(arg)
implicit none
real(kind=kind(1d0)), intent(in) :: arg
write (*,*) "real8: ", arg
end subroutine
subroutine norm_r(arg)
implicit none
real, intent(in) :: arg
write (*,*) "real: ", arg
end subroutine
subroutine norm_i(arg)
implicit none
integer, intent(in) :: arg
write (*,*) "integer: ", arg
end subroutine
subroutine norm_c(arg)
implicit none
complex, intent(in) :: arg
write (*,*) "complex: ", arg
end subroutine
subroutine get_proc_ptr(pp, arg)
implicit none
procedure(), pointer, intent(out) :: pp
class(*), intent(inout) :: arg
select type(arg)
type is (real(kind=kind(1d0)))
pp => norm_r8
type is (real)
pp => norm_r
type is (integer)
pp => norm_i
type is (complex)
pp => norm_c
class default
pp => null()
end select
end subroutine
end module
program test
use proc
implicit none
real(kind=kind(1d0)) :: arg_r8
real :: arg_r
integer :: arg_i
complex :: arg_c
procedure(), pointer :: pNorm => null()
arg_r8 = 4.0123456789d30
arg_r = 12.5
arg_i = 56
arg_c = (34,3)
call get_proc_ptr(pNorm, arg_r8)
call pNorm(arg_r8)
call get_proc_ptr(pNorm, arg_r)
call pNorm(arg_r)
call get_proc_ptr(pNorm, arg_i)
call pNorm(arg_i)
call get_proc_ptr(pNorm, arg_c)
call pNorm(arg_c)
end program
And here is the output of this program:
$ ./testprocptr
real8: 4.0123456788999999E+030
real: 12.5000000
integer: 56
complex: ( 34.0000000 , 3.00000000 )
If I understand well, you want to achieve two things at one time.
First, you want to use polymorphism to let the compiler call the correct routine dependent on whether you have a different type, rank, number of arguments etcetera.
Second, you want to use procedure pointers to switch between different procedures that have the same interface.
I tried the same. I did not manage to set a pointer to an interface, but I managed to make an interface with pointers.
If you have a module like this
module some_module
! This is the abstract interface for procedure pointers.
interface
subroutine shape_1_interface(arg)
implicit none
real, intent(in) :: arg
end subroutine shape_1_interface
subroutine shape_2_interface(arg)
implicit none
integer, intent(in) :: arg
end subroutine shape_2_interface
end interface
contains
subroutine routine_shape_1_implementation_1(arg)
implicit none
real, intent(in) :: arg
write(*,*) "Arg is real",arg
write(*,*) "Implementation 1"
end subroutine routine_shape_1_implementation_1
subroutine routine_shape_2_implementation_1(arg)
implicit none
integer, intent(in) :: arg
write(*,*) "Arg is int",arg
write(*,*) "Implementation 1"
end subroutine routine_shape_2_implementation_1
subroutine routine_shape_1_implementation_2(arg)
implicit none
real, intent(in) :: arg
write(*,*) "Arg is real",arg
write(*,*) "Implementation 2"
end subroutine routine_shape_1_implementation_2
subroutine routine_shape_2_implementation_2(arg)
implicit none
integer, intent(in) :: arg
write(*,*) "Arg is int",arg
write(*,*) "Implementation 2"
end subroutine routine_shape_2_implementation_2
subroutine routine_shape_1_implementation_3(arg)
implicit none
real, intent(in) :: arg
write(*,*) "Arg is real",arg
write(*,*) "Implementation 3"
end subroutine routine_shape_1_implementation_3
subroutine routine_shape_2_implementation_3(arg)
implicit none
integer, intent(in) :: arg
write(*,*) "Arg is int",arg
write(*,*) "Implementation 3"
end subroutine routine_shape_2_implementation_3
end module some_module
then you can do in your main program:
program main
use some_module
implicit none
procedure(shape_1_interface), pointer :: routine_shape_1
procedure(shape_2_interface), pointer :: routine_shape_2
interface routine
procedure routine_shape_1
procedure routine_shape_2
end interface routine
routine_shape_1 => routine_shape_1_implementation_1
routine_shape_2 => routine_shape_2_implementation_1
call routine(4)
routine_shape_1 => routine_shape_1_implementation_2
routine_shape_2 => routine_shape_2_implementation_2
call routine(4.0)
end program main
It is a pity that when you want to set the pointers to a different implementation, you have to do that for all shapes, but the good thing is that you can just call 'routine' and you automatically get the desired function.
This is the output:
Arg is int 4
Implementation 1
Arg is real 4.00000000000000
Implementation 2

How to give an array with multiple dimensions from R to Fortran subroutine?

I want to use a fortran program in R, but I get errors when running the R program.
The fortran code has REAL variables with 2 dimensions. A test code for fortran looks like:
test_inside_program.f90:
program testprogram
implicit none
interface
SUBROUTINE testm(testvar, thelength)
IMPLICIT NONE
REAL, INTENT(IN), DIMENSION(:) :: testvar
INTEGER, INTENT(IN) :: thelength
END SUBROUTINE testm
end interface
REAL, DIMENSION(:),ALLOCATABLE :: testvar
INTEGER :: i
allocate(testvar(3))
DO i = 1,2
testvar(i) = i
ENDDO
call testm(testvar, 3)
write(*,*) 'program finished'
end program testprogram
SUBROUTINE testm(testvar,thelength)
IMPLICIT NONE
INTEGER, INTENT(IN) :: thelength
REAL, INTENT(IN), DIMENSION(:) :: testvar
write(*,*) 'program cont. X'
write(*,*)' THe testvar 1st variable is', testvar
END SUBROUTINE testm
I want to call the subroutine testm from R.
Of course I would like to maintain the dimensions.
Therefore I generated following test code in R:
test.r
dyn.load("test_inside_program.so")
is.loaded("testm")
dd <- c(5,2,3)
.Fortran("testm",as.single(dd),as.integer(3))
I would appreciate your help!
I generate the .so with
R CMD SHLIB test_inside_program.f90
You can't declare an assumed shape array here, since R won't know how to pass such an array (it's not just a pointer to data, it must come together with dimensions).
This will work:
subroutine testm(testvar,thelength)
implicit none
integer, intent(in) :: thelength
real, intent(in), dimension(thelength) :: testvar
write(*,*) 'program cont. x'
write(*,*) 'length=', thelength
write(*,*) 'testvar=', testvar
end subroutine testm
Also, depending on your needs, you may consider declaring double precision arrays in your program and passing them "as is" from R (it's the default numeric type). For integers, you may also write 3L directly in R, thus, for single and double, it goes like this:
.Fortran("testm", as.single(dd), 3L)
.Fortran("testm", dd, 3L)
Okay, problem solved!
subroutines in fortran:
SUBROUTINE testm(testvar, thelength)
IMPLICIT NONE
INTEGER, INTENT(IN) :: thelength
REAL, INTENT(IN), DIMENSION(thelength) :: testvar
END SUBROUTINE testm
in R
dd <- c(5.5,2,3.3)
#length(dd)
print("call fortran routine")
.Fortran("testm",as.single(dd),as.integer(3))
I dont know why it did not work before :o

Resources