Is it possible to detect the type of a variable?

@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
1 Like

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.

1 Like

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?

1 Like

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?)

1 Like

No help from the language standard here.

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

1 Like

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

1 Like

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.

1 Like

or maybe

select type ( a,b,c,d )

?

1 Like

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.

1 Like

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.

1 Like

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?

1 Like

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.
1 Like

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.

1 Like

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 :slight_smile:

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
1 Like

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.

1 Like

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.

1 Like

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
2 Likes
  • 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
   ..
1 Like

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
1 Like

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
1 Like