Is it possible to detect the type of a variable?

[CRquantum]

Sorry for a naïve question. For example, if I want to define a function func(x), its behavior depends on the type of the input x. I mean I can use module procedure to define several functions, then overload them to func. However, is it possible to do such things more easily? like

function func(x)
real :: func
if (  x is real  .or. x is complex  .or. x is integer) then 
do something 
end if

So that I do not need to write several do something functions which are the same actually, and then overload them to func?

PS.

The real two functions are my scattervi1d and scattervr1d which are mpi_scatterv wrapper as shown below, one deal with integer array scatterv, the other deal with real array scatterv. I overload them to scatterv. However the content of the scattervi1d and scattervr1d are almost exactly the same. The only difference is just type of the input variables r,rscatter (scattervi1d deals with integer input, scattervr1d deals with real input). I feel it is a little bit redundant to define basically the same functions twice.

interface scatterv ! scatterv from process 0 to all process, evenly scatter. inverse of gather
  module procedure scattervi1d   
  module procedure scattervr1d
end interface scatterv

! https://stackoverflow.com/questions/17508647/sending-2d-arrays-in-fortran-with-mpi-gather/17530368#17530368   

   subroutine scattervi1d(r,rscatter,scounts,displs)
   integer(kind=i4) :: r(:),rscatter(:)
   integer :: i,ierror,scounts_default(iproc),displs_default(iproc) 
   integer, optional :: scounts(iproc),displs(iproc) 
   if (.not.(present(scounts).and.present(displs))) then ! here assume no scounts and no displs.     
     call gather(size(rscatter),scounts_default)
     if (myrank()==0) then
       displs_default(1)=0
       do i=2,iproc
         displs_default(i)=displs_default(i-1)+scounts_default(i-1)
       enddo
     endif    
     call mpi_scatterv(r,scounts_default,displs_default,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)
   else
     call mpi_scatterv(r,scounts,displs,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)     
   endif

   return
   end subroutine scattervi1d  
   
   
   subroutine scattervr1d(r,rscatter,scounts,displs)  
   real(kind=r8) :: r(:),rscatter(:)
   integer :: i,ierror,scounts_default(iproc),displs_default(iproc) 
   integer, optional :: scounts(iproc),displs(iproc) 
   if (.not.(present(scounts).and.present(displs))) then ! here assume no scounts and no displs.     
     call gather(size(rscatter),scounts_default)
     if (myrank()==0) then
       displs_default(1)=0
       do i=2,iproc
         displs_default(i)=displs_default(i-1)+scounts_default(i-1)
       enddo
     endif    
     call mpi_scatterv(r,scounts_default,displs_default,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)
   else
     call mpi_scatterv(r,scounts,displs,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)     
   endif

   return
   end subroutine scattervr1d

[RonShepard]

The functionality is somewhat limited to do this, but at least in simple cases, the answer is yes, you can do this in fortran (since f2003). Look up class(*) declarations and the select type construct. Also, the routine needs an explicit interface because the compiler needs to pass some additional information from the caller to the callee. Because the type is determined at run time rather than at compile time, the calling overhead is larger than the usual case. Usually that’s not important, but if it is in a tight loop, then it can be significant.

[Beliavsky]

Here is an example of using a class(*) argument to handle multiple types.

module check_kind_mod
use iso_fortran_env, only: real32, real64
implicit none
contains
subroutine sub(x)
class(*), intent(in) :: x
select type (x)
   type is (real(real32))
   block
       real(real32) :: y,z
       print*,"type is real32"
   end block
   type is (real(real64))
   block
       real(real64) :: y,z
       print*,"type is real64"
   end block
end select
end subroutine sub
end module check_kind_mod
!
program main
use check_kind_mod
implicit none
call sub(1.0)
call sub(1.0d0)
end program main
! output:
!  type is real32
!  type is real64

[msz59]

If you mean functions which return different types also based on the type of argument (or, similarly, subroutines which have intent(out) argument of class(*), it gets even more complicated, as you need to use select type also in the caller

program test
  implicit none
  real :: x=1.2
  complex :: z=(0,1)
  class(*), allocatable :: poly

  call sub(z,poly)
  select type (poly)
  type is (complex)
    print *, poly
  end select
  poly = func(x)
  select type (poly)
  type is (real)
    print *, poly
  end select

contains
  function func(arg)
    class(*), intent(in) :: arg
    class(*), allocatable :: func
    select type (arg)
    type is (real)
      func = arg*10
    type is (complex)
      func = exp(arg)
    end select
  end function func
  subroutine sub(arg, res)
    class(*), intent(in) :: arg
    class(*), allocatable, intent(out) :: res
    select type (arg)
    type is (real)
      res = arg*10
    type is (complex)
      res = exp(arg)
    end select
  end subroutine sub
end program test

AFAIU the rules, to make direct assignment possible (to poly or to func above), the polymorphic entity must be allocatable. Also, although upon return from the subroutine or function, its type is known, one cannot use it directly as complex or real, only through another select type - containing just one entry.

I guess that for such cases (both argument and result “polymorphic”), functions overloaded by the types of their arguments are simpler

Edit: for a reason unknown, the above code compiled with gfortran 11 segfaults in the function part, though it compiles w/o any warnings. Intel ifort works fine.

[FortranFan]

@CRquantum

Sorry for a naïve question. For example, if I want to define a function func(x), its behavior depends on the type of the input x. I mean I can use module procedure to define several functions, then overload them to func. However, is it possible to do such things more easily? … I feel it is a little bit redundant to define basically the same functions twice.

@CRquantum ,

1. You may want to again take note there is no such thing as “a naïve question”! As goes the cliche, there can be “stupid answers”! But no need to worry about making inquiries!

2. You will note there are significant gaps and limitations when it comes to Generics in current standard Fortran (2018 revision) and the language is limiting in terms of what you can do with the situation you describe in the original post. In the "five features for Fortran 202Y thread by @certik, you will thus note enhanced Generics capability in Fortran being requested in several of the posts.

3. Your inclination, that has been aided by some of the responses here, has been toward employing polymorphism, unlimited polymorphism even (e.g., CLASS(*) dummy argument), to overcome the limitations with Generics in Fortran. I do not recommend this approach at all for a variety of reasons. But to each their own.

4. Re: “I feel it is a little bit redundant to define basically the same functions twice,” unfortunately however the only other approach I can suggest with current Fortran which does not involve polymorphism and that alleviates to a small extent at least the issues with code duplication is INCLUDE files.

I agree INCLUDE may not be ideal, but that it is what is there in the language and the concept after all is not all that foreign. It became more prevalent in the 1970s and it has persisted with C-like languages to this day.

So the INCLUDE option is something for you to consider i.e., until around year 2040 or 2045 when your Fortran compiler of choice may implement usable Generics assuming they introduced reasonably well in the next revision (Fortran 202Y).

• Say you author an include source, scatterv1d.i90:

integer :: i,ierror,scounts_default(iproc),displs_default(iproc) 
   integer, optional :: scounts(iproc),displs(iproc) 
   if (.not.(present(scounts).and.present(displs))) then ! here assume no scounts and no displs.     
     call gather(size(rscatter),scounts_default)
     if (myrank()==0) then
       displs_default(1)=0
       do i=2,iproc
         displs_default(i)=displs_default(i-1)+scounts_default(i-1)
       enddo
     endif    
     call mpi_scatterv(r,scounts_default,displs_default,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)
   else
     call mpi_scatterv(r,scounts,displs,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)     
   endif

   return

• then author your module as

interface scatterv ! scatterv from process 0 to all process, evenly scatter. inverse of gather
   module procedure scattervi1d   
   module procedure scattervr1d
end interface scatterv
..
subroutine scattervi1d(r,rscatter,scounts,displs)
   integer(kind=i4) :: r(:),rscatter(:)
   include "scatterv1d.i90"
end subroutine scattervi1d  

subroutine scattervr1d(r,rscatter,scounts,displs)  
   real(kind=r8) :: r(:),rscatter(:)
   include "scatterv1d.i90"
end subroutine scattervr1d

[FortranFan]

@msz59

If you mean functions which return different types also based on the type of argument (or, similarly, subroutines which have intent(out) argument of class(*), it gets even more complicated, as you need to use select type also in the caller

Not necessarily re: “as you need to use select type also in the caller”:

   integer n
   real x
   call sub( n )
   print *, n
   call sub( x )
   print *, x
contains
   subroutine sub( a )
      class(*), intent(out) :: a
      select type ( a )
         type is ( integer )
            a = 42
         type is ( real )
            a = -99.0
         class default
            ! error stop?
      end select
   end subroutine 
end

C:\Temp>gfortran p.f90 -o p.exe

C:\Temp>p.exe
          42
  -99.0000000

But I agree in other, more complicated scenarios in various computations, the use of SELECT TYPE gets messy and its use can prove to be a “mushroom cloud” in a program.

This is among the reasons for my suggestion upthread to avoid the use of unlimited polymorphism as a substitute for generic subprograms.

[RonShepard]

Here is another annoying feature of the unlimited polymorphism approach. Suppose the subroutine has several arguments, and you want to consider only the cases where all the arguments have the same type and kind (or at least some small fraction of the possibilities). I do not think there is a concise way to specify this condition in the declaration or to otherwise inform the compiler that this is the case. Modifying the above example a little:

subroutine sub( a, b, c, d )
   class(*) :: a, b, c, d
   select type ( a )
      type is ( integer )
      ...want a, b, c, and d to all be integers...
      type is ( real )
      ...want a, b, c, and d to all be real...
   end select
end subroutine sub

Are there any shortcuts to allow this? Any declarations? Any way to avoid four-level nested select type blocks?

[septc]

I also use the “include” method (mentioned by FortranFan above), though a bit different purpose (for making several OpenMP routines where the “core” part is common and it is included into the OpenMP constructs). I guess if generics/templates are available, the OP’s case will be straightforward, probably…

As a “third” approach, is it also possible to use class(*) and just get its address to pass to MPI routines? (does this also need select type?)

[FortranFan]

@RonShepard

Are there any shortcuts to allow this? Any declarations? Any way to avoid four-level nested select type blocks?

No help from the language standard here.

In such situations, one has to look outside the standard: FYPP can likely help, check with @aradi

GitHub - aradi/fypp: Python powered Fortran preprocessor

[FortranFan]

@septc

As a “third” approach, is it also possible to use class(*) and just get its address to pass to MPI routines? (does this also need select type?)

The other unlimited polymorphic option in the language, TYPE(*), may be better here.

[RonShepard]

@FortranFan

No help from the language standard here.

Would it be productive to add something like the following to the language?

subroutine sub( a, b, c, d )
   class(*) :: a
   type_of(a) :: b, c, d   ! this requires the actual arguments to all be of the same type.
   select type ( a )
      type is ( integer )
      ...want a, b, c, and d to all be integers...
      type is ( real )
      ...want a, b, c, and d to all be real...
   end select
end subroutine sub

Although a compiler might be able to verify consistency in some cases, in general this would need to be enforced at run time.

I have wanted to have this kind of declaration when using extended types. There may be several dummy arguments of the extended type, but all the cases of interest involved those where all the arguments have the same extended type, not just the same base type.

[msz59]

@RonShepard

type_of(a) :: b, c, d   ! this requires the actual arguments to all be fo the same type.
select type ( a )

or maybe

select type ( a,b,c,d )

?

[urbanjost]

There are shortcuts for special cases. For example, this shows how you can take numbers of many different types and promote them all to default real kind (as an example) and place the results back
into selected input values.

 program main
use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64 
use,intrinsic :: iso_fortran_env, only : real32, real64, real128
use M_anything, only : anyscalar_to_real, gt=>get_type
use M_msg,      only : set
implicit none
integer(kind=int8)         :: i8=2
integer(kind=int16)        :: i16=25
integer(kind=int32)        :: i32=100
integer(kind=int64)        :: i64=1234
real(kind=real32)          :: r32=4*atan(1.0)
real(kind=real64)          :: r64=1.0d0/3.0d0
character(len=*),parameter :: g='(*(g0,1x))'
   write(*, g)i8, i16, i32, i64, r32, r64

   call something( i8, i16, i32, i64, r32, r64)
   write(*, g)i8, i16, i32, i64, r32, r64

   call something( r64, r32, i64, i32, i16, i8)
   write(*,g) r64, r32, i64, i32, i16, i8 

  write(*,g) gt(r64), gt(r32), gt(i64), gt(i32), gt(i16), gt(i8)

contains

subroutine something(a,b,c,d,e,f)
implicit none
class(*)             :: a,b,c,d,e,f
real                 :: ar,br,cr,dr,er,fr
   ar=anyscalar_to_real(a)*2
   if(anyscalar_to_real(b).ge.0)then
      br=sqrt(anyscalar_to_real(b))
   else
      br=-sqrt(-anyscalar_to_real(b))
   endif
   cr=anyscalar_to_real(c)/2.0
   dr=ar*br*cr
   er=ar+br+cr
   fr=sin(anyscalar_to_real(f))
   call set([ar,br,cr,dr,er,fr],a,b,c,d,e,f)
   
end subroutine something

end program main

fpm run
Project is up to date
2 25 100 1234 3.14159274 0.33333333333333331
4 5 50 1000 59.0000000 0.32719472050666809
0.65438944101333618 7.68114567 500 2513 508 0
real64               real32               int64                int32                int16                int8                

It uses two external modules. If you use fpm(1) you can just add them in the fpm.toml
file; else they contain a Makefile.

[dependencies]
M_msg       =  {  git  =  "https://github.com/urbanjost/M_msg.git"  }
M_anything  =  {  git  =  "https://github.com/urbanjost/M_anything.git"  }

The procedures used from them are a bit long to include here, but if interested you can download those.

There is a cost to promoting, casting, and molding and polymorphism; but if you want to allow multiple arguments to be different types but can treat them all as single type a few helper routines greatly reduce
the repetitive complexity that otherwise might be required.

So if the cost of promotion is not significant (usually there is a performance cost converting everything to high precision or larger values) you can create something like ANYTHING_TO_REAL128() or the other procedures in those modules.

The example is very artificial, but it shows you can create something with multiple arguments of relatively arbitrary type if you really need to; although I generally prefer generics.

I have used the anything_to_bytes() for passing arbitrary data as well, although TRANSFER can usually be used for a similar purpose more generally.

[FortranFan]

@RonShepard

Would it be productive to add something like the following to the language?

Great question and post, it is something the committee has pondered over a lot and Fortran 202X introduces support via 2 new intrinsics, TYPEOF and CLASSOF c.f. https://wg5-fortran.org/N2151-N2200/N2194.pdf

2.3 US 16. The specifiers typeof and classof

The specifier typeof is available to declare one or more entities to be nonpolymorphic
with the type and type parameters of a previously declared entity. The previous entity
may have intrinsic type. It may be polymorphic, in which case its declared type is used; 
it must not be unlimited polymorphic or abstract.

The specifier classof is available to declare one or more entities to be polymorphic with 
the declared type and type parameters of a previously declared entity. The previous 
entity must not be of assumed type or intrinsic type. It may be unlimited polymorphic.

For both typeof and classof, if the previous entity is an optional dummy argument it 
must not have a deferred or assumed type parameter, but a type parameter is deferred
if it is deferred for the previous entity and this is not an optional dummy argument.

But my understanding is the above only addresses the declaration aspect, that there will remain limitations when it comes to referencing the objects; cascaded SELECT TYPE will still be needed to "dereference* an unlimited polymorphic dummy argument (a la a pointer) to a given type.

That the proper solution here will be the Generics capability to be introduced (hopefully) starting Fortran 202Y.

But I may be wrong on this.

[msz59]

@RonShepard

subroutine sub( a, b, c, d )
   class(*) :: a, b, c, d
   select type ( a )
      type is ( integer )
      ...want a, b, c, and d to all be integers...
      type is ( real )
      ...want a, b, c, and d to all be real...
   end select
end subroutine sub

Are there any shortcuts to allow this? Any declarations? Any way to avoid four-level nested select type blocks?

There is an intrinsic function same_type_as(a,b) which could, in principle, help, like

subroutine sub( a, b, c, d )
   class(*) :: a, b, c, d
  if (same_type_as(a,b) .and. same_type_as(a,c) .and. same_type_as(a,d)) then
    select type ( a )
! ...
    end select
  else
!  error service
  endif
end subroutine sub

but there may be a problem with some types, like intrinsic. The standard says

16.9.165.5 Result Value. If the dynamic type of A or B is extensible, the result is true if and only if the dynamic type of A is the same as the dynamic type of B. If neither A nor B has extensible dynamic type, the result is processor dependent.

I checked the followin code with gfortran 10, 11 and ifort, on Linux and MacOS and it worked fine but if I understand well the above statement, for intrinsic typeconfor s this is not guaranteed? Any expert to confirm that?

[FortranFan]

@msz59

There is an intrinsic function same_type_as(a,b)

I didn’t suggest same_type_as because of 2 reasons:

1. it only works with extensible types. Intrinsic types such as integer, real, etc. are not extensible. Whereas the use case in the original post here included intrinsic types.
2. the same_type_as has limited utility with some checks, but it doesn’t help with the fundamental issue: which is that a reference to each object which is unlimited polymorphic requires it be cast in a SELECT TYPE construct.

[RonShepard]

@msz59

There is an intrinsic function same_type_as(a,b) which could, in principle, help, like

subroutine sub( a, b, c, d )
   class(*) :: a, b, c, d
  if (same_type_as(a,b) .and. same_type_as(a,c) .and. same_type_as(a,d)) then
    select type ( a )
! ...
    end select
  else
!  error service
  endif
end subroutine sub

Yes, that intrinsic does help to verify that they are all the same type, but then when those variables are actually used in expressions, they must still be within nested select type blocks.

I think basically, that the compiler must know through the select type block what are the variable types before they can be referenced in expressions. Even if it has been verified somehow by the programmer that they are all of the same type (such as using the same_type_as() intrinsic), the compiler must know this separately. Right now, I think select type is the only way to do this. My original question was asking about any possible alternatives to this verbose process.

I think the select_type approach works more or less alright for a single variable. But it fails for multiple arguments because it requires a nested select_type block for each variable.

I mostly have used select_type for extended dynamic types, not for unlimited polymorphism. I was not aware of the limitation that prevents its use for intrinsic types.

[msz59]

I ended up with the following sample code. It requires some extra procedures but allows to avoid nested select type. With intrinsic types (as it is written now) it may not work (if I properly understand the standard constraint, though it works in my processors) and with extended dynamic types the procedures for setting values may or may not be trivial, so it is just an exercise but I have had fun creating it

Code

program test
  implicit none
  real :: x=1.0, y=2.0, t=3.0
  complex :: z=(1,2)
  call sub(x,y,t)
  call sub(x,z,t)
  call sub(cmplx(x), cmplx(y),z)
contains
  subroutine sub(a,b,c)
    class(*), intent(in) :: a,b,c
    if (same_type_as(a,b) .and. same_type_as(a,c)) then
      select type (a)
      type is (real)
        block
          real :: x1,x2,x3
          x1 = a
          call setrval(b, x2)
          call setrval(c, x3)
          print *, x1*x2*x3
        end block
      type is (complex)
        block
          complex :: x1,x2,x3
          x1 = a
          call setcval(b, x2)
          call setcval(c, x3)
          print *, x1*x2*x3
        end block
      end select
    else
      print *, 'not same type'
    endif
  end subroutine sub
  subroutine setrval(a,x)
    class(*), intent(in) :: a
    real, intent(out) :: x
    select type (a)
    type is (real)
      x = a
    class default
      error stop "first arg not real in setrval"
    end select
  end subroutine setrval
  subroutine setcval(a,x)
    class(*), intent(in) :: a
    complex, intent(out) :: x
    select type (a)
    type is (complex)
      x = a
    class default
      error stop "first arg not complex in setcval"
    end select
  end subroutine setcval
end program test

[RonShepard]

This code is basically equivalent to the following:

module xxx
   implicit none
   interface sub
      module procedure sub_rrr, sub_ccc
   end interface sub
contains
   subroutine sub_rrr(a,b,c)
      real, intent(in) :: a, b, c
      print *, a*b*c
   end subroutine sub_rrr
   subroutine sub_ccc(a,b,c)
      complex, intent(in) :: a, b, c
      print *, a*b*c
   end subroutine sub_ccc
end module xxx

program test_xxx
   use xxx
   implicit none
   real :: x=1.0, y=2.0, t=3.0
   complex :: z=(1,2)
   call sub(x,y,t)
   !call sub(x,z,t)
   call sub(cmplx(x), cmplx(y),z)
end program test_xxx

One difference is that if you uncomment the sub(x,z,t) line, you get a compile time error rather than a run time error. Arguably, that is even better, right? But the main difference is that the generic interface code is much simpler, and probably much more efficient. It seems like that will always be the case when there are subroutines with multiple arguments which require either explicit conversions of types or nested select type blocks. [edit: case typo changed to type]

The single executable statement is identical in the two routines, so in principle it could be moved to a separate file and INCLUDEd, making the source code simpler to maintain by eliminating the redundancy.

[urbanjost]

Example 1: Using INCLUDE

As alluded to, since the only difference in these particular procedures
are the two top and the bottom line, using INCLUDE just requires standard
Fortran:

The body of redundant code is placed in a separate file

scatterv1d.inc

integer :: i,ierror,scounts_default(iproc),displs_default(iproc) 
integer, optional :: scounts(iproc),displs(iproc) 
   if (.not.(present(scounts).and.present(displs))) then ! here assume no scounts and no displs.     
     call gather(size(rscatter),scounts_default)
     if (myrank()==0) then
       displs_default(1)=0
       do i=2,iproc
         displs_default(i)=displs_default(i-1)+scounts_default(i-1)
       enddo
     endif    
     call mpi_scatterv(r,scounts_default,displs_default,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)
   else
     call mpi_scatterv(r,scounts,displs,mpir8,rscatter,size(rscatter),mpir8,0, &
                       mpi_comm_world,ierror)     
   endif

The redundant code is included multiple times sandwiched between the lines that are unique
for each procedure:

M_wrappers.f90

module M_wrappers
use, intrinsic :: iso_fortran_env, only : real32,real64,int8,int16,int32,int64
interface scatterv ! scatterv from process 0 to all process, evenly scatter. inverse of gather
  module procedure scatterv1d_real32
  module procedure scatterv1d_real64
  module procedure scatterv1d_int8
  module procedure scatterv1d_int16
  module procedure scatterv1d_int32
  module procedure scatterv1d_int64
end interface scatterv
contains
$!==================================================================================================
subroutine scatterv1d_real32(r,rscatter,scounts,displs)
real(kind=real32) :: r(:),rscatter(:)
include "scatterv1d.inc"
end subroutine scatterv1d_real32

subroutine scatterv1d_real64(r,rscatter,scounts,displs)
real(kind=real64) :: r(:),rscatter(:)
include "scatterv1d.inc"
end subroutine scatterv1d_real64

subroutine scatterv1d_int8(r,rscatter,scounts,displs)
integer(kind=int8) :: r(:),rscatter(:)
include "scatterv1d.inc"
end subroutine scatterv1d_int8

subroutine scatterv1d_int16(r,rscatter,scounts,displs)
integer(kind=int16) :: r(:),rscatter(:)
include "scatterv1d.inc"
end subroutine scatterv1d_int16

subroutine scatterv1d_int32(r,rscatter,scounts,displs)
integer(kind=int32) :: r(:),rscatter(:)
include "scatterv1d.inc"
end subroutine scatterv1d_int32

subroutine scatterv1d_int64(r,rscatter,scounts,displs)
integer(kind=int64) :: r(:),rscatter(:)
include "scatterv1d.inc"
end subroutine scatterv1d_int64

$!==================================================================================================
end module M_wrappers

So in this case nothing except standard Fortran is used and the redundant code is in it’s own file, easily maintained.