Is it possible to detect the type of a variable?

[urbanjost]

Example 2: Using cpp (and an included file)

If there were some simple conditional code in the body of the routine or additional
substitutions in the body of the text, the cpp(1) processor might provide a solution.

cpp(1) or fpp(1) is supported by most (all?) Fortran compilers.

sub.inc

subroutine _SCATTERV1D_(r,rscatter,scounts,displs)
_TYPE_(kind=_KIND_) :: 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    
#ifdef OTHER
     ! something else depending on TYPE _TYPE_ and KIND _KIND_
#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
end subroutine _SCATTERV1D_

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
$!==================================================================================================
#define OTHER

#define _TYPE_ real

#define _SCATTERV1D_ scatterv1d_real32
#define _KIND_ real32
#include "sub.inc"

#define _SCATTERV1D_ scatterv1d_real64
#define _KIND_ real64
#include "sub.inc"

#define _TYPE_ integer

#define _SCATTERV1D_ scatterv1d_int8
#define _KIND_ int8
#include "sub.inc"

#define _SCATTERV1D_ scatterv1d_int16
#define _KIND_ int16
#include "sub.inc"

#define _SCATTERV1D_ scatterv1d_int32
#define _KIND_ int32
#include "sub.inc"

#define _SCATTERV1D_ scatterv1d_int64
#define _KIND_ int64
#include "sub.inc"
$!==================================================================================================
end module M_wrappers

[FortranFan]

@RonShepard

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 case blocks…

• instead of “probably much more efficient”, chances are the use of generic interfaces makes the code generally “much more efficient” with current processors than with the use of unlimited polymorphism with run-time type interference!
• you meant select type instead of select case? A good code design consideration toward libraries where performance is important is to avoid the use of select type.

Re: the code is “much simpler,” with Fortran 2018 one can gain a bit more in terms of compact code via the GENERIC statement where one can attribute the visibility (PUBLIC if so desired) so an additional statement is not needed compared to Fortran 90-style INTERFACE construct.

   ..
   generic, public :: sub => sub_rrr, sub_ccc  !<-- also convenient when the default module visibility is PRIVATE
   ..

[urbanjost]

Example 3: Other preprocessors

For more flexible substitution and being able to keep the redundant code in a
single file with the rest of the source and other more advanced templating
features there are other pre-processors such as m4, coco, prep, and fypp.

You can even do very elaborate preprocessing use bash “here” documents. This
usually requires adding a Make or Cmake rule to automate building standard
Fortran source files from the un-preprocessed files, although some compilers
have switches to support invoking custom pre-processors.

This is a simple single-file example using string substitution and prep(1):

M_wrappers.ff

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
$!==================================================================================================
$PARCEL MYSUB
subroutine scatterv1d_${KIND}(r,rscatter,scounts,displs)
${TYPE}(kind=${KIND}) :: 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
end subroutine scatterv1d_${KIND}
$ENDPARCEL 
$!==================================================================================================
$set type real
$set kind real32
$post mysub
$set kind real64
$post mysub
$set type integer
$set kind int8
$post mysub
$set kind int16
$post mysub
$set kind int32
$post mysub
$set kind int64
$post mysub
$!==================================================================================================
end module M_wrappers

[urbanjost]

Example 4: promotion as a simple example of polymorphism

Aside from generics you can use polymorphism as described above.
Promotion is not always appropriate and has an overhead cost as
well. Assuming it is OK the anydble() procedure shows how to make
a promotion function. This just shows how it can be used for INTENT(IN)
values. I have a SET function in a module of mine (M_msg) that shows
how to put the values back into the input routine, or you can use
the SELECT stuff at the end of the procedure.

promote.f90

subroutine scatterv(classr,classrscatter,scounts,displs)
class(*) :: classr(:),classrscatter(:)
integer :: i,ierror,scounts_default(iproc),displs_default(iproc)
integer, optional :: scounts(iproc),displs(iproc)
doubleprecision,allocatable :: r(:),rscatter(:)

   ! promote to double
   r=anydble(classr)
   rscatter=anydble(classrscatter)

   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
contains
impure elemental function anydble(valuein) result(d_out)
use, intrinsic :: ISO_FORTRAN_ENV, only : INT8, INT16, INT32, INT64   
use, intrinsic :: ISO_FORTRAN_ENV, only : REAL32, REAL64, REAL128    
implicit none

!@(#) anydble(3f): convert integer or real vector of any kind to doubleprecision

class(*),intent(in)       :: valuein
doubleprecision           :: d_out
   select type(valuein)
   type is (integer(kind=int8));   d_out=dble(valuein)
   type is (integer(kind=int16));  d_out=dble(valuein)
   type is (integer(kind=int32));  d_out=dble(valuein)
   type is (integer(kind=int64));  d_out=dble(valuein)
   type is (real(kind=real32));    d_out=dble(valuein)
   type is (real(kind=real64));    d_out=dble(valuein)
   Type is (real(kind=real128));   d_out=dble(valuein) ! could be too big, could test
   class default
     stop '*M_anything::anydble: unknown type'
   end select
end function anydble

end subroutine scatterv