Assumed-Size Dummy Argument Not Working in Module Procedure

This is a good way to look at how it works. It is artificial in the sense that nothing is done in that procedure call by any C coprocessor, it is all done on just the fortran side of the interface “as if” there will eventually be some later reference to a C function.

A nice thing about the c_f_pointer() and c_loc() combination is that it works for arbitrary array ranks. A downside is that it only works for data types that are interoperable. If you want to work with, say, a derived type, in this way, then you have to step back and write the appropriate subroutine call to do the one-line pointer assignment. This suggests that maybe that particular functionality within fortran should be generalized and made a real, first-class, part of the language.

@tyranids and any other reader interested in working with assumed-sized received arguments via a generic interface:

As I pointed out upthread, if you want to consume assumed-sized received arguments via a generic interface then you need to provide assumed-size effective arguments. That’s just how the language is, take it or leave it. As shown above, a helper internal procedure can help here. A simple example worked out case is like so:

module m
   private
   generic, public :: sub => sub_as, sub_rank1, sub_rank2
contains
   subroutine sub_as( a, n )
      integer, intent(inout) :: a(*)
      integer, intent(in)    :: n
      a(1:n) = [( i, i=1, n )]
   end subroutine 
   subroutine sub_rank1( a )
      integer, intent(inout) :: a(:)
      a = 1
   end subroutine 
   subroutine sub_rank2( a )
      integer, intent(inout) :: a(:,:)
      a = 2
   end subroutine 
end module
   use m, only : sub
   integer :: x(1,2,3), y(1,2), z(1)
   !call sub( x, size(x) ) !<-- Not supported with generic interface
   call helper( x, size(x) )
   print *, "After helper sub: x = ", x
   call sub( y )
   print *, "After sub with rank-2 case: y = ", y 
   call sub( z )
   print *, "After sub with rank-1 case: z = ", z
contains
   subroutine helper( a, n )
      integer, intent(inout) :: a(*)
      integer, intent(in)    :: n
      call sub( a, n )
   end subroutine
end 
C:\temp>ifort /free /standard-semantics p.f
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.9.0 Build 20230302_000000
Copyright (C) 1985-2023 Intel Corporation.  All rights reserved.

Microsoft (R) Incremental Linker Version 14.34.31937.0
Copyright (C) Microsoft Corporation.  All rights reserved.

-out:p.exe
-subsystem:console
p.obj

C:\temp>p.exe
 After helper sub: x =  1 2 3 4 5 6
 After sub with rank-2 case: y =  2 2
 After sub with rank-1 case: z =  1

Thank all for replying to this post. As usual, the members on this forum have a lot of knowledge to share and there are many excellent methods posted above. Ultimately this is my fault for providing too simple an example and not clearly explaining my objection to wrapper routines, but this is the actual module I am trying to write/use:

module random
use, intrinsic :: iso_fortran_env, only: real32, real64, real128, int8, int16, int32, int64
implicit none
private

    interface  randrng
        module procedure randrng_sp
        module procedure randrng_dp
        module procedure randrng_qp
        module procedure randrng_i8
        module procedure randrng_i16
        module procedure randrng_i32
        module procedure randrng_i64
    end interface randrng
    public :: randrng

    interface normrnd
        module procedure normrnd_sp
        module procedure normrnd_dp
        module procedure normrnd_qp
    end interface normrnd
    public :: normrnd

    integer, parameter :: sp = real32
    integer, parameter :: dp = real64
    integer, parameter :: qp = real128
    integer, parameter :: i8 = int8
    integer, parameter :: i16 = int16
    integer, parameter :: i32 = int32
    integer, parameter :: i64 = int64
    real, parameter :: twopi_sp = 2.0_sp*acos(-1.0_sp)
    real, parameter :: twopi_dp = 2.0_dp*acos(-1.0_dp)
    real, parameter :: twopi_qp = 2.0_qp*acos(-1.0_qp)

    contains

        subroutine randrng_sp(val, n, val_min, val_max)
        implicit none
            real(sp), intent(out) :: val(*)
            integer, intent(in) :: n
            real(sp), intent(in) :: val_min, val_max
            call random_number(val(1:n))
            val(1:n) = val(1:n)*(val_max - val_min) + val_min
        end subroutine randrng_sp

        subroutine randrng_dp(val, n, val_min, val_max)
        implicit none
            real(dp), intent(out) :: val(*)
            integer, intent(in) :: n
            real(dp), intent(in) :: val_min, val_max
            call random_number(val(1:n))
            val(1:n) = val(1:n)*(val_max - val_min) + val_min
        end subroutine randrng_dp

        subroutine randrng_qp(val, n, val_min, val_max)
        implicit none
            real(qp), intent(out) :: val(*)
            integer, intent(in) :: n
            real(qp), intent(in) :: val_min, val_max
            call random_number(val(1:n))
            val(1:n) = val(1:n)*(val_max - val_min) + val_min
        end subroutine randrng_qp

        subroutine randrng_i8(val, n, val_min, val_max)
        implicit none
            integer(i8), intent(out) :: val(*)
            integer, intent(in) :: n
            integer(i8), intent(in) :: val_min, val_max
            real :: work(n)
            call random_number(work)
            val(1:n) = floor(work*(real(val_max) - real(val_min) + 1.0)) + val_min
        end subroutine randrng_i8

        subroutine randrng_i16(val, n, val_min, val_max)
        implicit none
            integer(i16), intent(out) :: val(*)
            integer, intent(in) :: n
            integer(i16), intent(in) :: val_min, val_max
            real :: work(n)
            call random_number(work)
            val(1:n) = floor(work*(real(val_max) - real(val_min) + 1.0)) + val_min
        end subroutine randrng_i16

        subroutine randrng_i32(val, n, val_min, val_max)
        implicit none
            integer(i32), intent(out) :: val(*)
            integer, intent(in) :: n
            integer(i32), intent(in) :: val_min, val_max
            real :: work(n)
            call random_number(work)
            val(1:n) = floor(work*(real(val_max) - real(val_min) + 1.0)) + val_min
        end subroutine randrng_i32

        subroutine randrng_i64(val, n, val_min, val_max)
        implicit none
            integer(i64), intent(out) :: val(*)
            integer, intent(in) :: n
            integer(i64), intent(in) :: val_min, val_max
            real :: work(n)
            call random_number(work)
            val(1:n) = floor(work*(real(val_max) - real(val_min) + 1.0)) + val_min
        end subroutine randrng_i64

        subroutine normrnd_sp(val, n, val_mu, val_sig)
        implicit none
            real(sp), intent(out) :: val(*)
            integer, intent(in) :: n
            real(sp), intent(in) :: val_mu, val_sig
            real(sp) :: u(ceiling(n/2.0),2)
            integer :: i
            call random_number(u)
            do i=1,size(u, dim=1)
                do while (u(i,1).eq.0.0)
                    call random_number(u(i,1))
                end do
            end do
            val(1:n/2) = val_mu + val_sig*sqrt(-2.0*log(u(1:n/2,1)))*cos(twopi_sp*u(1:n/2,2))
            val(n/2+1:n) = val_mu + val_sig*sqrt(-2.0*log(u(1:n-n/2,1)))*sin(twopi_sp*u(1:n-n/2,2))
        end subroutine normrnd_sp

        subroutine normrnd_dp(val, n, val_mu, val_sig)
        implicit none
            real(dp), intent(out) :: val(*)
            integer, intent(in) :: n
            real(dp), intent(in) :: val_mu, val_sig
            real(dp) :: u(ceiling(n/2.0),2)
            integer :: i
            call random_number(u)
            do i=1,size(u, dim=1)
                do while (u(i,1).eq.0.0)
                    call random_number(u(i,1))
                end do
            end do
            val(1:n/2) = val_mu + val_sig*sqrt(-2.0*log(u(1:n/2,1)))*cos(twopi_dp*u(1:n/2,2))
            val(n/2+1:n) = val_mu + val_sig*sqrt(-2.0*log(u(1:n-n/2,1)))*sin(twopi_dp*u(1:n-n/2,2))
        end subroutine normrnd_dp

        subroutine normrnd_qp(val, n, val_mu, val_sig)
        implicit none
            real(qp), intent(out) :: val(*)
            integer, intent(in) :: n
            real(qp), intent(in) :: val_mu, val_sig
            real(qp) :: u(ceiling(n/2.0),2)
            integer :: i
            call random_number(u)
            do i=1,size(u, dim=1)
                do while (u(i,1).eq.0.0)
                    call random_number(u(i,1))
                end do
            end do
            val(1:n/2) = val_mu + val_sig*sqrt(-2.0*log(u(1:n/2,1)))*cos(twopi_qp*u(1:n/2,2))
            val(n/2+1:n) = val_mu + val_sig*sqrt(-2.0*log(u(1:n-n/2,1)))*sin(twopi_qp*u(1:n-n/2,2))
        end subroutine normrnd_qp

end module random

I want my routines to be callable with a single name, either randrng for uniform or normrnd for normal random numbers. They should work for the intrinsic real and integer types, regardless of rank, with the compiler selecting the correct routine at compile time for minimal overhead. It is already bad enough having to copy/paste the same logic 7 times for the intrinsic types. I do not want to also have 15 versions of each one to cover each possible array rank.

Maybe I’m not interpreting this sentence correctly, but it is not necessary to match an assumed size dummy argument with only assumed size actual arguments. The interface is doing type, kind, and rank (TKR) matching, so if the TKR matches, then the generic interface will match the correct specific routine with the call statement. In the example you give, there are two subroutines that have rank-1 dummy arguments, so they must be differentiated in another way. You have chosen one of them to have two arguments and the other one has a single argument. So that is why it works.

To test this hypothesis, change the declaration in helper() to

integer, intent(inout) :: a(n)

It should then associate correctly to the assumed size dummy argument because it matches TKR (and it has two arguments, to pick the right specific routine).

This is also why one cannot associate a 2D actual argument with a 1D dummy argument through the generic interface: the ranks don’t match. That is pretty much the point of using generic interfaces, to match generic subroutines with actual subroutines through TKR.

You are looking for Generics support in the language which does not exist yet. Fortran 202Y or more like Fortran 203X might be when a better way might be possible. Until then you need to implement by yourself support for each and every possible combination of type, kind, and rank if you want “routines to be callable with a single name”, that’s a lot of verbosity via duplicate code. That’s just how it is. Using a preprocessor like fypp is just another option you can consider.

You might also consider an elemental routine. A single elemental subprogram will match calls with arbitrary ranks. Of course, you will still need to write separate versions for the various types and kinds. You may need to modify the argument list in order to conform with the restrictions of elemental subprograms.

I wish the standard intrinsic random_number() worked with integers. Currently it only works with real arguments.

Nice suggestion. This does also work

After the comments about storage association, assumed size, and generic interfaces above, I checked my copy of Modern Fortran Explained and indeed it was clearly spelled out that generic interfaces + assumed size dummy arguments are not supported per the standard.

My reading did clarify however that intent(out) arguments can never be expressions, which is the only hangup to using assumed rank for me. I am making a small tester, but I would prefer to know directly: is the select rank construct evaluated at compile time or run time? Ideally I would like as minimal calling overhead as possible, which is why I prefer avoiding wrapper routines where possible. These types of things may be called billions of times in a simulation run, etc.

One can “click” on the little triangles to open drop-down boxes containing more information; is this what you are referring to as in need of fixing? The drop-down boxes might be inaccessible if you are not using a mouse/touch-pad. Or is there something else?

@kargl what is the misinformation in the original post?

1 Like

Disinformation, as opposed to misinformation, is an utmost serious charge. @certik, you’re absolutely right to ask for an explanation, it needs to be provided clearly by the one making the charge and failing to do so must count against. All moderators should take notice.

I don’t have time to read every message. If something is pointed out to me that needs attention, I do my best. I still don’t understand what the mis- or disinformation is based on the error message. Can you please elaborate?

Is it why you previously stated that “I refuse to use assumed rank for the time being due to lack of proper support in gfortran.” ?

It can be only at runtime. But the overhead of a wrapper plus a select is absolutely negligible compared to the amount of operations in the inner routine (as I understand it, this is a random number generator on n elements, right?)

The ifort compiler has an error message starting

error #6285: There is no matching specific subroutine 

Yes, exactly. You can read more here: Gfortran bug or am I missing something? - #14 by urbanjost

Regardless how small, it is a measurable overhead for small n and being called enough times (test is n=10 with repetitions on the order of millions). It looks somewhat silly, but the entire logic can be contained in a select rank subroutine for a given type and kind:

        subroutine randrng_ar(val, val_min, val_max)
        implicit none
            real(sp), intent(out) :: val(..)
            real(sp), intent(in) :: val_min, val_max
            select rank(val)
                rank(1)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(2)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(3)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(4)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(5)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(6)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(7)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(8)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(9)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(10)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(11)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(12)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(13)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(14)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
                rank(15)
                    call random_number(val)
                    val = val*(val_max - val_min) + val_min
            end select
        end subroutine randrng_ar

Maybe some day in the future I won’t have to copy/paste literally the exact same code 15 times. At least it doesn’t require any modification though, and if the algorithm ever has to change, it’s all in one place. – Looking at it I should probably add rank(0) for 16 times and rank default to just error out if the routine somehow receives something that is not rank 0-15. I believe ifort may support up to 31 ranks, but that is not standard?

Using impure elemental subroutines, you don’t need separate subroutines for each rank, as shown below:

module m
implicit none
contains
impure elemental subroutine rand(xscale, x)
real, intent(in)  :: xscale
real, intent(out) :: x
call random_number(x)
x = x*xscale
end subroutine rand
end module m
!
program main
use m
implicit none
real :: x, xvec(3), xmat(2,4)
real, parameter :: xscale = 10.0
character (len=*), parameter :: fmt_cr="(a, ' =',*(1x,f6.3))"
call random_seed()
call rand(xscale, x)
call rand(xscale, xvec)
call rand(xscale, xmat)
print fmt_cr,"x",x
print fmt_cr,"xvec",xvec
print fmt_cr,"xmat",xmat
end program main
! sample output:
! x =  9.241
! xvec =  5.519  6.971  7.582
! xmat =  4.776  6.341  8.248  8.008  1.933  9.342  0.750  7.551

@kargl ah I see, yes, that indeed looks like an ifort error message, not gfortran. Thanks for letting me know.

@tyranids would you please mind fixing your very first message and note that it’s an ifort (?) error message (not gfortran)?

@certik, @tyranids

Note gfortran will issue a similar message as required by the standard though the text will be different:

module m
   interface sub
      module procedure sub_as
   end interface 
contains
   subroutine sub_as( a, n )
      integer, intent(inout) :: a(*)
      integer, intent(in)    :: n
      a(1:n) = [( i, i=1, n )]
   end subroutine 
end module
   use m, only : sub
   integer :: x(1,2)
   call sub( x, size(x) )
end
C:\temp>gfortran -c -ffree-form p.f
p.f:14:25:

   14 |    call sub( x, size(x) )
      |                         1
Error: There is no specific subroutine for the generic 'sub' at (1)

Thus OP can either change the text of the comment and state, “The above error is from xxx, but gfortran say similar.” instead of “The above error is from gfortran, but ifort and ifx say similar.”

Or modify the text of the error message to reflect that from gfortran.

1 Like

I no longer seem able to edit the OP. Is there a time limit after which it cannot be edited?

Regardless, sorry for any confusion re: compiler error messages. With a non-conforming generic interface trying to call assumed size routines with rank 2 arguments, here are the errors:

gfortran
app/main.f90:28:47:

   28 |     call gen_randrng_asi(x2, n, 0.0_sp, 1.0_sp)
      |                                               1
Error: There is no specific subroutine for the generic ‘gen_randrng_asi’ at (1)
ifort
app/main.f90(28): error #6285: There is no matching specific subroutine for this generic subroutine call.   [GEN_RANDRNG_ASI]
    call gen_randrng_asi(x2, n, 0.0_sp, 1.0_sp)
---------^
app/main.f90(138): catastrophic error: Too many errors, exiting
ifx
app/main.f90(28): error #6285: There is no matching specific subroutine for this generic subroutine call.   [GEN_RANDRNG_ASI]
    call gen_randrng_asi(x2, n, 0.0_sp, 1.0_sp)
---------^
app/main.f90(138): catastrophic error: Too many errors, exiting

There was no intention to throw shade or cause confusion, I had been swapping between compilers trying to see if it worked for any of them and evidently copied the wrong message into the OP - as you can see they are very similar.

3 Likes