anyscalar_to_double(3f) - [M_anything] convert integer or real parameter of any kind to doubleprecision
(LICENSE:MIT)
pure elemental function anyscalar_to_double(valuein) result(d_out)
class(*),intent(in) :: valuein
doubleprecision :: d_out
This function uses polymorphism to allow input arguments of different
types. It is used to create other procedures that can take many
scalar arguments as input options.
VALUEIN input argument of a procedure to convert to type DOUBLEPRECISION.
May be of KIND kind=int8, kind=int16, kind=int32, kind=int64,
kind=real32, kind=real64, or kind=real128
D_OUT The value of VALUIN converted to doubleprecision (assuming
it is actually in the range of type DOUBLEPRECISION).
Sample program
program demo_anyscalar_to_double
use, intrinsic :: iso_fortran_env, only : int8, int16, int32, int64
use, intrinsic :: iso_fortran_env, only : real32, real64, real128
implicit none
! call same function with many scalar input types
write(*,*)squarei(2_int8)
write(*,*)squarei(2_int16)
write(*,*)squarei(2_int32)
write(*,*)squarei(2_int64)
write(*,*)squarei(2.0_real32)
write(*,*)squarei(2.0_real64)
write(*,*)squarei(2.0_real128)
contains
function squarei(invalue) result (dvalue)
use M_anything, only : anyscalar_to_double
class(*),intent(in) :: invalue
doubleprecision :: invalue_local
doubleprecision :: dvalue
invalue_local=anyscalar_to_double(invalue)
dvalue=invalue_local*invalue_local
end function squarei
end program demo_anyscalar_to_double
John S. Urban
MIT
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(*), | intent(in) | :: | valuein |
pure elemental function anyscalar_to_double(valuein) result(d_out) ! ident_4="@(#) M_anything anyscalar_to_double(3f) convert integer or real parameter of any kind to doubleprecision" class(*),intent(in) :: valuein doubleprecision :: d_out doubleprecision,parameter :: big=huge(0.0d0) 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) #ifdef HAS_REAL128 Type is (real(kind=real128)) !IMPURE! if(valuein > big)then !IMPURE! write(stderr,'(*(g0,1x))')'*anyscalar_to_double* value too large ',valuein !IMPURE! endif d_out=dble(valuein) #endif type is (logical); d_out=merge(0.0d0,1.0d0,valuein) type is (character(len=*)); read(valuein,*) d_out class default !IMPURE! stop '*M_anything::anyscalar_to_double: unknown type' end select end function anyscalar_to_double