!=================================================================================================================================== ! This module and the example function squarei() that uses it shows how you ! can use polymorphism to allow arguments of different types generically by casting !=================================================================================================================================== !----------------------------------------------------------------------------------------------------------------------------------- #define __INTEL_COMP 1 #define __GFORTRAN_COMP 2 #define __NVIDIA_COMP 3 #define __NAG_COMP 4 #define __flang__ 5 #define __UNKNOWN_COMP 9999 #define FLOAT128 #ifdef __INTEL_COMPILER # define __COMPILER__ __INTEL_COMP #elif __GFORTRAN__ == 1 # define __COMPILER__ __GFORTRAN_COMP #elif __flang__ # undef FLOAT128 # define __COMPILER__ __LLVM_FLANG_COMP #elif __NVCOMPILER # undef FLOAT128 # define __COMPILER__ __NVIDIA_COMP #else # define __COMPILER__ __UNKNOWN_COMP # warning NOTE: UNKNOWN COMPILER #endif !----------------------------------------------------------------------------------------------------------------------------------- #ifdef Linux_ifx #ifndef __INTEL_LLVM_COMPILER #define __INTEL_LLVM_COMPILER IFX #endif #endif !=================================================================================================================================== !> !!##NAME !! M_anything(3fm) - [M_anything::INTRO] procedures that use polymorphism to allow arguments of different types generically !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! Syntax: !! !! use M_anything,only : anyscalar_to_string !! use M_anything,only : anyscalar_to_int64 !! use M_anything,only : anyscalar_to_real !! use M_anything,only : anyscalar_to_real128 !! use M_anything,only : anyscalar_to_double !! use M_anything,only : anything_to_bytes !! use M_anything,only : anyinteger_to_string !! use M_anything,only : get_type !! use M_anything,only : bytes_to_anything !! use M_anything,only : empty, assignment(=) !! !!##DESCRIPTION !! anyscalar_to_string convert intrinsic type to string !! anyscalar_to_int64 convert integer or real of any kind to 64-bit integer !! anyscalar_to_real convert integer or real of any kind to real !! anyscalar_to_real128 convert integer or real of any kind to real128 !! anyscalar_to_double convert integer or real of any kind to doubleprecision !! anything_to_bytes convert anything to bytes !! anyinteger_to_string convert integer to string !! get_type return array of strings containing type names of arguments !! empty create an empty array !! !!##EXAMPLES !! !! !! At the cost of casting to a different type these functions can !! (among other uses such as in linked lists) allow for an alternative !! to duplicating code using generic procedure methods. For example, !! the following SQUAREALL function can take many input types and return a !! DOUBLEPRECISION value (it is a trivial example for demonstration purposes, !! and does not check for overflow, etc.).: !! !! Sample program !! !! program demo_M_anything !! 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(*,*)squareall(2_int8) !! write(*,*)squareall(2_int16) !! write(*,*)squareall(2_int32) !! write(*,*)squareall(2_int64) !! write(*,*)squareall(2.0_real32) !! write(*,*)squareall(2.0_real64) !! !write(*,*)squareall(2.0_real128) !! contains !! !! function squareall(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 squareall !! !! end program demo_M_anything !! !! Results: !! !! 4.00000000000000 !! 4.00000000000000 !! 4.00000000000000 !! 4.00000000000000 !! 4.00000000000000 !! 4.00000000000000 !! 4.00000000000000 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT module M_anything use, intrinsic :: ISO_FORTRAN_ENV, only : INT8, INT16, INT32, INT64 ! 1 2 4 8 use, intrinsic :: ISO_FORTRAN_ENV, only : REAL32, REAL64, REAL128 ! 4 8 10 use, intrinsic :: ISO_FORTRAN_ENV, only : CSZ => CHARACTER_STORAGE_SIZE use, intrinsic :: iso_fortran_env, only : stderr => error_unit !! ,input_unit,output_unit implicit none private integer,parameter :: dp=kind(0.0d0) public anyscalar_to_string ! convert integer parameter of any kind to string public anyscalar_to_int64 ! convert integer parameter of any kind to 64-bit integer public anyscalar_to_real ! convert integer or real parameter of any kind to real #ifdef FLOAT128 public anyscalar_to_real128 ! convert integer or real parameter of any kind to real128 #endif public anyscalar_to_double ! convert integer or real parameter of any kind to doubleprecision public anything_to_bytes public get_type public bytes_to_anything public anyinteger_to_string ! convert integer parameter of any kind to string !!public setany interface anything_to_bytes module procedure anything_to_bytes_arr module procedure anything_to_bytes_scalar end interface anything_to_bytes interface bytes_to_anything module procedure bytes_to_anything_arr module procedure bytes_to_anything_scalar end interface bytes_to_anything interface get_type module procedure get_type_arr module procedure get_type_scalar end interface get_type !=================================================================================================================================== ! Because there is no builtin "empty array" object, I've tried to mimic ! it with some user-defined type (just for fun). -- spectrum ! ! So, if there is a language support, it might be not too difficult ! to think of a common "empty array" thing (though not sure if it is ! sufficiently useful). ! public empty, assignment(=) type Empty_t endtype type(Empty_t) empty !! singleton interface assignment(=) module procedure & & ints_empty_, & & reals_empty_, & & doubles_empty_, & & strings_empty_ endinterface contains !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! empty(3f) - [M_anything] set an allocatable array to zero !! (LICENSE:MIT) !!##SYNOPSIS !! !! use M_anything, only : empty, assignment(=) !!##DESCRIPTION !! A convenience routine that sets an array to an empty set. !!##EXAMPLES !! !! !! Sample program: !! !! program demo_empty_ !! use M_anything, only : empty, assignment(=) !! integer, allocatable :: ints(:) !! character(:), allocatable :: strs(:) !! real, allocatable :: reals(:) !! ints=empty !! write(*,*)size(ints) !! !! write(*,*)'give them some size ...' !! reals = [1.0,2.0,3.0] !! ints = [1,2,3] !! strs = [character(len=10) :: "one","two","three","four"] !! write(*,*)size(ints) !! write(*,*)size(reals) !! write(*,*)size(strs) !! !! ints=empty !! reals=empty !! strs=empty !! write(*,*)'back to empty ...' !! write(*,*)size(ints) !! write(*,*)size(reals) !! write(*,*)size(strs) !! !! end program demo_empty_ !! !! Expected output: !! !! > 0 !! > give them some size ... !! > 3 !! > 3 !! > 4 !! > back to empty ... !! > 0 !! > 0 !! > 0 !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT subroutine ints_empty_( x, emp ) integer, allocatable, intent(inout) :: x(:) type(Empty_t), intent(in) :: emp if ( allocated( x ) ) deallocate( x ) allocate( x( 0 ) ) end subroutine ints_empty_ subroutine doubles_empty_( x, emp ) doubleprecision, allocatable, intent(inout) :: x(:) type(Empty_t), intent(in) :: emp if ( allocated( x ) ) deallocate( x ) allocate( x( 0 ) ) end subroutine doubles_empty_ subroutine reals_empty_( x, emp ) real, allocatable, intent(inout) :: x(:) type(Empty_t), intent(in) :: emp if ( allocated( x ) ) deallocate( x ) allocate( x( 0 ) ) end subroutine reals_empty_ subroutine strings_empty_( x, emp ) character(:), allocatable, intent(inout) :: x(:) type(Empty_t), intent(in) :: emp if ( allocated( x ) ) deallocate( x ) allocate( character(0) :: x( 0 ) ) end subroutine strings_empty_ !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! bytes_to_anything(3f) - [M_anything] convert bytes(character)len=1):: array(:)) to standard types !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! subroutine bytes_to_anything(chars,anything) !! !! character(len=1),allocatable :: chars(:) !! class(*) :: anything !! !!##DESCRIPTION !! !! This function uses polymorphism to allow input arguments of different !! types. It is used to create other procedures that can take many !! argument types as input options and convert them to a single type !! to simplify storing arbitrary data, to simplify generating data !! hashes, ... !! !!##OPTIONS !! CHARS The input value is an array of bytes (character(len=1)). !! !!##RETURN !! ANYTHING May be of KIND INTEGER(kind=int8), INTEGER(kind=int16), !! INTEGER(kind=int32), INTEGER(kind=int64), !! REAL(kind=real32, REAL(kind=real64), !! REAL(kind=real128), complex, or CHARACTER(len=*) !! !!##EXAMPLES !! !! !! Sample program !! !! program demo_bytes_to_anything !! use, intrinsic :: ISO_FORTRAN_ENV, only: & !! CSZ => CHARACTER_STORAGE_SIZE, & !! stderr => error_unit !! use :: M_anything, only : bytes_to_anything, anything_to_bytes !! implicit none !! character(len=1), allocatable :: chars(:) !! character(len=:), allocatable :: line !! character(len=:), allocatable :: lines(:) !! integer :: ints(10) !! integer :: i, int !! integer,allocatable :: somesize(:) !! !! call header('integer array to bytes') !! chars = anything_to_bytes([(i*i, i=1, size(ints))]) !! write (*, '(/,4(1x,z2.2))') chars !! call bytes_to_anything(chars, ints) !! write(*,*)'and bytes back to integer array' !! write (*, '(/,*(g0,1x))') ints !! !! call header('integer scalar to bytes') !! chars = anything_to_bytes(1234) !! write (*, '(/,"CHARS=",*(1x,z2.2))') chars !! call bytes_to_anything(chars, int) !! write(*,*)'and bytes back to integer scalar' !! write (*, '(/,"INT=",*(g0,1x))') int !! !! call header('a string') !! chars = anything_to_bytes('this is a string') !! write (*, '(/,"CHARS=",*(1x,z2.2))') chars !! write (*, '(/,"CHARS=",*(g0,1x))') chars !! ! string must be long enough to hold chars !! line=repeat(' ',size(chars)) !! call bytes_to_anything(chars, line) !! write (*, '(/,"LINE=",*(g0,1x))') line !! !! call header(& !! 'a string array (have to know length or size you wish to return to)') !! chars = anything_to_bytes([character(len=4) :: 'a', 'bb', 'ccc' ]) !! write (*, '(/,"CHARS=",*(1x,z2.2))') chars !! write (*, '(/,"CHARS=",*(g0,1x))') chars !! ! string must be long enough to hold chars, and have enough elements !! ! can just return as a scalar string if unknown length !! lines=[repeat(' ',size(chars))] !! ! of for that matter just work with the chars(1) array, !! ! but assuming know length in this case !! lines=[(repeat('#',4),i=1,3)] !! call bytes_to_anything(chars, lines) !! write (*, '(/,"LINES=",*("[",g0,"]",1x:))') lines !! !! call header('calculating size to allocate for non-string types') !! ! make sure array is of sufficient size to hold results !! chars = anything_to_bytes([11,22,33,44]) !! write (*, '(/,"CHARS=",*(1x,z2.2))') chars !! allocate(somesize(size(chars)/(storage_size(0)/CSZ))) !! call bytes_to_anything(chars, somesize) !! write (*, '(/,"SOMESIZE=",*("[",g0,"]",1x:))') somesize !! contains !! subroutine header(line) !! character(len=*),intent(in) :: line !! write(*,'(*(a))')'#',repeat('=',len(line)+2),'#' !! write(*,'("|",1x,a,1x,"|")') line !! write(*,'(*(a))')'#',repeat('=',len(line)+2),'#' !! end subroutine header !! end program demo_bytes_to_anything !! !! Results: !! !! > #========================# !! > | integer array to bytes | !! > #========================# !! > !! > 01 00 00 00 !! > 04 00 00 00 !! > 09 00 00 00 !! > 10 00 00 00 !! > 19 00 00 00 !! > 24 00 00 00 !! > 31 00 00 00 !! > 40 00 00 00 !! > 51 00 00 00 !! > 64 00 00 00 !! > and bytes back to integer array !! > !! > 1 4 9 16 25 36 49 64 81 100 !! > #=========================# !! > | integer scalar to bytes | !! > #=========================# !! > !! > CHARS= D2 04 00 00 !! > and bytes back to integer scalar !! > !! > INT=1234 !! > #==========# !! > | a string | !! > #==========# !! > !! > CHARS= 74 68 69 73 20 69 73 20 61 20 73 74 72 69 6E 67 !! > !! > CHARS=t h i s i s a s t r i n g !! > !! > LINE=this is a string !! > #====================================================================# !! > | a string array (have to know length or size you wish to return to) | !! > #====================================================================# !! > !! > CHARS= 61 20 20 20 62 62 20 20 63 63 63 20 !! > !! > CHARS=a b b c c c !! > !! > LINES=[a ] [bb ] [ccc ] !! > #===================================================# !! > | calculating size to allocate for non-string types | !! > #===================================================# !! > !! > CHARS= 0B 00 00 00 16 00 00 00 21 00 00 00 2C 00 00 00 !! > !! > SOMESIZE=[11] [22] [33] [44] !! !! !!##AUTHOR !! John S. Urban !!##LICENSE !! MIT subroutine bytes_to_anything_arr(chars,anything) character(len=1),intent(in) :: chars(:) class(*),intent(out) :: anything(:) select type(anything) type is (character(len=*)); anything=transfer(chars,anything) type is (complex); anything=transfer(chars,anything) type is (complex(kind=dp)); anything=transfer(chars,anything) type is (integer(kind=int8)); anything=transfer(chars,anything) type is (integer(kind=int16)); anything=transfer(chars,anything) type is (integer(kind=int32)); anything=transfer(chars,anything) type is (integer(kind=int64)); anything=transfer(chars,anything) type is (real(kind=real32)); anything=transfer(chars,anything) type is (real(kind=real64)); anything=transfer(chars,anything) #ifdef FLOAT128 type is (real(kind=real128)); anything=transfer(chars,anything) #endif type is (logical); anything=transfer(chars,anything) class default !anything=transfer(chars,anything) stop 'crud. bytes_to_anything(1) does not know about this type' end select end subroutine bytes_to_anything_arr subroutine bytes_to_anything_scalar(chars,anything) character(len=1),intent(in) :: chars(:) class(*),intent(out) :: anything select type(anything) ! caller must ensure string passed in is long enough for results type is (character(len=*)); anything=transfer(chars,repeat('x',size(chars))) if(len(anything).lt.size(chars))then write(stderr,*) '<ERROR> *bytes_to_anything* crud. string not long enough to hold results. cannot put',size(chars),& 'bytes in string of length',len(anything) stop endif type is (complex); anything=transfer(chars,anything) type is (complex(kind=dp)); anything=transfer(chars,anything) type is (integer(kind=int8)); anything=transfer(chars,anything) type is (integer(kind=int16)); anything=transfer(chars,anything) type is (integer(kind=int32)); anything=transfer(chars,anything) type is (integer(kind=int64)); anything=transfer(chars,anything) type is (real(kind=real32)); anything=transfer(chars,anything) type is (real(kind=real64)); anything=transfer(chars,anything) #ifdef FLOAT128 type is (real(kind=real128)); anything=transfer(chars,anything) #endif type is (logical); anything=transfer(chars,anything) class default !anything=transfer(chars,anything) stop 'crud. bytes_to_anything(1) does not know about this type' end select end subroutine bytes_to_anything_scalar !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! anything_to_bytes(3f) - [M_anything] convert standard types to bytes (character(len=1):: array(:)) !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! function anything_to_bytes(anything) result(chars) !! !! class(*),intent(in) :: anything !! or !! class(*),intent(in) :: anything(:) !! !! character(len=1),allocatable :: chars(:) !! !!##DESCRIPTION !! !! This function uses polymorphism to allow input arguments of different !! types. It is used to create other procedures that can take many !! argument types as input options and convert them to a single type !! to simplify storing arbitrary data, to simplify generating data !! hashes, ... !! !! The **transfer(3f)** function is now a standard, even more general !! equivalent. !! !!##OPTIONS !! !! VALUEIN input array or scalar to convert to type CHARACTER(LEN=1). !! May be of KIND INTEGER(kind=int8), INTEGER(kind=int16), !! INTEGER(kind=int32), INTEGER(kind=int64), !! REAL(kind=real32, REAL(kind=real64), !! REAL(kind=real128), complex, or CHARACTER(len=*) !!##RETURN !! !! CHARS The returned value is an array of bytes (character(len=1)). !! !!##EXAMPLES !! !! !! Sample program !! !! program demo_anything_to_bytes !! use M_anything, only : anything_to_bytes !! implicit none !! integer :: i !! write(*,"('select various types')") !! write(*,'(/,16(1x,z2.2))')anything_to_bytes([(i*i,i=1,10)]) !! write(*,'(/,16(1x,z2.2))')anything_to_bytes([11.11,22.22,33.33]) !! write(*,'(/,16(1x,z2.2))')anything_to_bytes('This is a string') !! !! write(*,"(/,'compare to TRANSFER(3f)')") !! write(*,'(/,16(1x,z2.2))') transfer([(i*i,i=1,10)],[' ']) !! write(*,'(/,16(1x,z2.2))') transfer([11.11,22.22,33.33],[' ']) !! write(*,'(/,16(1x,z2.2))') transfer('This is a string',[' ']) !! end program demo_anything_to_bytes !! ``` !! Results: !! !! > select various types !! > !! > 01 00 00 00 04 00 00 00 09 00 00 00 10 00 00 00 !! > 19 00 00 00 24 00 00 00 31 00 00 00 40 00 00 00 !! > 51 00 00 00 64 00 00 00 !! > !! > 8F C2 31 41 8F C2 B1 41 EC 51 05 42 !! > !! > 54 68 69 73 20 69 73 20 61 20 73 74 72 69 6E 67 !! > !! > compare to TRANSFER(3f) !! > !! > 01 00 00 00 04 00 00 00 09 00 00 00 10 00 00 00 !! > 19 00 00 00 24 00 00 00 31 00 00 00 40 00 00 00 !! > 51 00 00 00 64 00 00 00 !! > !! > 8F C2 31 41 8F C2 B1 41 EC 51 05 42 !! > !! > 54 68 69 73 20 69 73 20 61 20 73 74 72 69 6E 67 !! !!##AUTHOR !! John S. Urban !!##LICENSE !! MIT function anything_to_bytes_arr(anything) result(chars) ! this seems like it should just be a call to transfer(), but seems to need the select type on at least several compilers ! ident_1="@(#) M_anything anything_to_bytes_arr(3fp) any vector of intrinsics to bytes (an array of CHARACTER(LEN=1) variables)" class(*),intent(in) :: anything(:) character(len=1),allocatable :: chars(:) if(allocated(chars))deallocate(chars) allocate(chars( storage_size(anything)/CSZ * size(anything) ) ) select type(anything) type is (character(len=*)); chars=transfer(anything,chars) type is (complex); chars=transfer(anything,chars) type is (complex(kind=dp)); chars=transfer(anything,chars) type is (integer(kind=int8)); chars=transfer(anything,chars) type is (integer(kind=int16)); chars=transfer(anything,chars) type is (integer(kind=int32)); chars=transfer(anything,chars) type is (integer(kind=int64)); chars=transfer(anything,chars) type is (real(kind=real32)); chars=transfer(anything,chars) type is (real(kind=real64)); chars=transfer(anything,chars) #ifdef FLOAT128 type is (real(kind=real128)); chars=transfer(anything,chars) #endif type is (logical); chars=transfer(anything,chars) class default !stop 'crud. anything_to_bytes_arr(1) does not know about this type' chars=transfer(anything,chars) ! should work for everything, does not with some compilers end select end function anything_to_bytes_arr !----------------------------------------------------------------------------------------------------------------------------------- function anything_to_bytes_scalar(anything) result(chars) ! ident_2="@(#) M_anything anything_to_bytes_scalar(3fp) anything to bytes (an array of CHARACTER(LEN=1) variables)" class(*),intent(in) :: anything character(len=1),allocatable :: chars(:) if(allocated(chars))deallocate(chars) allocate(chars( storage_size(anything)/CSZ) ) select type(anything) type is (character(len=*)); chars=transfer(anything,chars) type is (complex); chars=transfer(anything,chars) type is (complex(kind=dp)); chars=transfer(anything,chars) type is (integer(kind=int8)); chars=transfer(anything,chars) type is (integer(kind=int16)); chars=transfer(anything,chars) type is (integer(kind=int32)); chars=transfer(anything,chars) type is (integer(kind=int64)); chars=transfer(anything,chars) type is (real(kind=real32)); chars=transfer(anything,chars) type is (real(kind=real64)); chars=transfer(anything,chars) #ifdef FLOAT128 type is (real(kind=real128)); chars=transfer(anything,chars) #endif type is (logical); chars=transfer(anything,chars) class default #ifdef __INTEL_LLVM_COMPILER stop 'crud. anything_to_bytes_arr(1) does not know about this type' #else chars=transfer(anything,chars) ! should work for everything, does not with some compilers #endif end select end function anything_to_bytes_scalar !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !!subroutine setany(anything,default,answer) !! !!$@(#) M_anything::setany(3fp): set absent parameter to default value !! !!class(*),intent(in),optional :: anything !!class(*),intent(in) :: default !!class(*),intent(out),allocatable :: answer !!if(present(anything))then !! answer=anything !!else !! answer=default !!endif !!end subroutine setany !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! anyscalar_to_real128(3f) - [M_anything] convert integer or real parameter of any kind to real128 !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! pure elemental function anyscalar_to_real128(valuein) result(d_out) !! !! class(*),intent(in) :: valuein !! real(kind=128) :: d_out !! !!##DESCRIPTION !! !! 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. !! !!##OPTIONS !! !! VALUEIN input argument of a procedure to convert to type REAL128. !! May be of KIND kind=int8, kind=int16, kind=int32, kind=int64, !! kind=real32, kind=real64, or kind=real128 !! !!##RESULTS !! !! D_OUT The value of VALUIN converted to REAL128 (assuming !! it is actually in the range of type REAL128). !! !!##EXAMPLES !! !! !! Sample program !! !! program demo_anyscalar_to_real128 !! use, intrinsic :: iso_fortran_env, only : & !! & i8=>int8, i16=>int16, i32=>int32, i64=>int64 !! use, intrinsic :: iso_fortran_env, only : & !! & sp=>real32, dp=>real64, qp=>real128 !! implicit none !! ! call same function with many scalar input types !! write(*,*)minall(& !! & 2_i8, 7_i16, 8_i32, 9_i64, 2.0123123_sp, 3.0123_dp, 5.0_qp) !! write(*,*)minall(& !! & 5.0_qp, 3.0123_dp, 2.0123123_sp, 9_i64, 8_i32, 7_i16, 2_i8) !! contains !! !! function minall(a,b,c,d,e,f,g) result (value) !! use M_anything, only : x=>anyscalar_to_real128 !! class(*),intent(in) :: a,b,c,d,e,f,g !! real(kind=qp) :: value !! value=min( x(a),x(b),x(c),x(d),x(e),x(f),x(g) ) !! end function minall !! !! end program demo_anyscalar_to_real128 !! !! Results: !! !! > 2.00000000000000000000000000000000000 !! > 2.00000000000000000000000000000000000 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT #ifdef FLOAT128 pure elemental function anyscalar_to_real128(valuein) result(d_out) ! ident_3="@(#) M_anything anyscalar_to_real128(3f) convert integer or real parameter of any kind to real128" class(*),intent(in) :: valuein real(kind=real128) :: d_out character(len=3) :: readable select type(valuein) type is (integer(kind=int8)); d_out=real(valuein,kind=real128) type is (integer(kind=int16)); d_out=real(valuein,kind=real128) type is (integer(kind=int32)); d_out=real(valuein,kind=real128) type is (integer(kind=int64)); d_out=real(valuein,kind=real128) type is (real(kind=real32)); d_out=real(valuein,kind=real128) type is (real(kind=real64)); d_out=real(valuein,kind=real128) Type is (real(kind=real128)); d_out=valuein type is (logical); d_out=merge(0.0_real128,1.0_real128,valuein) type is (character(len=*)); read(valuein,*) d_out class default readable='NaN' read(readable,*)d_out !!stop '*M_anything::anyscalar_to_real128: unknown type' end select end function anyscalar_to_real128 #endif !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! anyscalar_to_double(3f) - [M_anything] convert integer or real parameter of any kind to doubleprecision !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! pure elemental function anyscalar_to_double(valuein) result(d_out) !! !! class(*),intent(in) :: valuein !! doubleprecision :: d_out !! !!##DESCRIPTION !! !! 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. !! !!##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 !! !!##RESULTS !! !! D_OUT The value of VALUIN converted to doubleprecision (assuming !! it is actually in the range of type DOUBLEPRECISION). !! !!##EXAMPLES !! !! !! 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(*,*)sqrtany(2_int8) !! write(*,*)sqrtany(2_int16) !! write(*,*)sqrtany(2_int32) !! write(*,*)sqrtany(2_int64) !! write(*,*)sqrtany(2.0_real32) !! write(*,*)sqrtany(2.0_real64) !! write(*,*)sqrtany(2.0_real128) !! contains !! !! function sqrtany(invalue) result (value) !! use M_anything, only : anyscalar_to_double !! class(*),intent(in) :: invalue !! doubleprecision :: value !! value=sqrt(anyscalar_to_double(invalue)) !! end function sqrtany !! !! end program demo_anyscalar_to_double !! !! Results: !! !! > 1.4142135623730951 !! > 1.4142135623730951 !! > 1.4142135623730951 !! > 1.4142135623730951 !! > 1.4142135623730951 !! > 1.4142135623730951 !! > 1.4142135623730951 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT 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 #ifdef FLOAT128 doubleprecision,parameter :: big=huge(0.0d0) #endif 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 FLOAT128 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 !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! anyscalar_to_real(3f) - [M_anything] convert integer or real parameter of any kind to real !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! pure elemental function anyscalar_to_real(valuein) result(r_out) !! !! class(*),intent(in) :: valuein !! real :: r_out !! !!##DESCRIPTION !! !! 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. !! !!##OPTIONS !! !! VALUEIN input argument of a procedure to convert to type REAL. !! May be of KIND kind=int8, kind=int16, kind=int32, kind=int64, !! kind=real32, kind=real64, or kind=real128. !! !!##RESULTS !! !! R_OUT The value of VALUIN converted to real (assuming it is actually !! in the range of type REAL). !! !!##EXAMPLES !! !! Sample program !! !! program demo_anyscalar_to_real !! 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_real !! class(*),intent(in) :: invalue !! real :: invalue_local !! real :: dvalue !! invalue_local=anyscalar_to_real(invalue) !! dvalue=invalue_local*invalue_local !! end function squarei !! !! end program demo_anyscalar_to_real !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT pure elemental function anyscalar_to_real(valuein) result(r_out) ! ident_5="@(#) M_anything anyscalar_to_real(3f) convert integer or real parameter of any kind to real" class(*),intent(in) :: valuein real :: r_out real,parameter :: big=huge(0.0) select type(valuein) type is (integer(kind=int8)) ; r_out=real(valuein) type is (integer(kind=int16)) ; r_out=real(valuein) type is (integer(kind=int32)) ; r_out=real(valuein) type is (integer(kind=int64)) ; r_out=real(valuein) type is (real(kind=real32)) ; r_out=real(valuein) type is (real(kind=real64)) !!if(valuein > big)then !! write(stderr,*)'*anyscalar_to_real* value too large ',valuein !!endif r_out=real(valuein) #ifdef FLOAT128 type is (real(kind=real128)) !!if(valuein > big)then !! write(stderr,*)'*anyscalar_to_real* value too large ',valuein !!endif r_out=real(valuein) #endif type is (logical); r_out=merge(0.0d0,1.0d0,valuein) type is (character(len=*)); read(valuein,*) r_out end select end function anyscalar_to_real !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! !! anyscalar_to_int64(3f) - [M_anything] convert intrinsic scalar types !! to integer(kind=int64) !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! !! impure elemental function anyscalar_to_int64(valin) result(value) !! !! class(*),intent(in) :: valin !! integer(kind=int64) :: value !! !!##DESCRIPTION !! !! This function uses polymorphism to allow arguments of different types !! as input. It is typically used to create other procedures that can take !! many scalar arguments as input options, equivalent to passing the !! parameter VALUE as int(VALUE,0_int64) for integer; nint(VALUE,0_int64) !! for real values, returning 0_int64 for .true. and 1_int64 for logical, !! and the same as int(VALUE,0_int64) for character variables if the !! character variables represent an integer value. !! !!##OPTIONS !! !! VALUEIN input argument of a procedure to convert to type INTEGER(KIND=int64). !! !!##RESULTS !! The value of VALUIN converted to INTEGER(KIND=INT64). !!##EXAMPLES !! !! Sample program !! !! program demo_anyscalar_to_int64 !! use, intrinsic :: iso_fortran_env, only : int8, int16, int32, int64 !! implicit none !! ! call same function with many scalar input types !! write(*,*)squarei(huge(0_int8)),huge(0_int8) , & !! & '16129' !! write(*,*)squarei(huge(0_int16)),huge(0_int16) , & !! & '1073676289' !! write(*,*)squarei(huge(0_int32)),huge(0_int32) , & !! & '4611686014132420609' !! write(*,*)squarei(huge(0_int64)),huge(0_int64) , & !! & '85070591730234615847396907784232501249' !! contains !! ! !! function squarei(invalue) !! use M_anything, only : anyscalar_to_int64 !! class(*),intent(in) :: invalue !! doubleprecision :: invalue_local !! doubleprecision :: squarei !! invalue_local=anyscalar_to_int64(invalue) !! squarei=invalue_local*invalue_local !! end function squarei !! ! !! end program demo_anyscalar_to_int64 !! !! Results !! !! 16129.000000000000 127 \ !! 16129 !! 1073676289.0000000 32767 \ !! 1073676289 !! 4.6116860141324206E+018 2147483647 \ !! 4611686014132420609 !! 8.5070591730234616E+037 9223372036854775807 \ !! 85070591730234615847396907784232501249 !! 2.8948022309329049E+076 170141183460469231731687303715884105727 \ !! 28948022309329048855892746252171976962977213799489202546401021394546514198529 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT impure elemental function anyscalar_to_int64(valuein) result(ii38) ! ident_6="@(#) M_anything anyscalar_to_int64(3f) convert parameter of any intrinsic kind to 64-bit integer" class(*),intent(in) :: valuein integer(kind=int64) :: ii38 integer :: ios character(len=256) :: message select type(valuein) type is (integer(kind=int8)); ii38=int(valuein,kind=int64) type is (integer(kind=int16)); ii38=int(valuein,kind=int64) type is (integer(kind=int32)); ii38=valuein type is (integer(kind=int64)); ii38=valuein type is (real(kind=real32)); ii38=nint(valuein,kind=int64) type is (real(kind=real64)); ii38=nint(valuein,kind=int64) #ifdef FLOAT128 Type is (real(kind=real128)); ii38=nint(valuein,kind=int64) #endif type is (logical); ii38=merge(0_int64,1_int64,valuein) type is (character(len=*)) ; read(valuein,*,iostat=ios,iomsg=message)ii38 if(ios /= 0)then write(stderr,*)'*anyscalar_to_int64* ERROR: '//trim(message) stop 2 endif class default write(stderr,*)'*anyscalar_to_int64* ERROR: unknown input type' stop 3 end select end function anyscalar_to_int64 !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! anyscalar_to_string(3f) - [M_anything] converts up to twenty standard scalar type values to a string !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! Syntax: !! !! pure function anyscalar_to_string(g0,g1,g2,g3,g4,g5,g6,g7,g8,g9,& !! & ga,gb,gc,gd,ge,gf,gg,gh,gi,gj,sep) !! class(*),intent(in),optional :: g0,g1,g2,g3,g4,g5,g6,g7,g8,g9 !! class(*),intent(in),optional :: ga,gb,gc,gd,ge,gf,gg,gh,gi,gj !! character(len=*),intent(in),optional :: sep !! character,len=(:),allocatable :: anyscalar_to_string !! !!##DESCRIPTION !! anyscalar_to_string(3f) builds a space-separated string from up to twenty scalar values. !! !!##OPTIONS !! g[0-9a-j] optional value to print the value of after the message. May !! be of type INTEGER, LOGICAL, REAL, DOUBLEPRECISION, !! COMPLEX, or CHARACTER. !! !! Optionally, all the generic values can be !! single-dimensioned arrays. Currently, mixing scalar !! arguments and array arguments is not supported. !! !! sep separator string used between values. Defaults to a space. !! !!##RETURNS !! anyscalar_to_string a representation of the input as a string !! !!##EXAMPLES !! !! Sample program: !! !! program demo_anyscalar_to_string !! use M_anything, only : anyscalar_to_string !! implicit none !! character(len=:),allocatable :: pr !! character(len=:),allocatable :: frmt !! integer :: biggest !! !! pr=anyscalar_to_string('HUGE(3f) integers',huge(0),& !! &'and real',huge(0.0),'and double',huge(0.0d0)) !! write(*,'(a)')pr !! pr=anyscalar_to_string('real :',huge(0.0),0.0,12345.6789,tiny(0.0) ) !! write(*,'(a)')pr !! pr=anyscalar_to_string('doubleprecision :',huge(0.0d0),0.0d0,12345.6789d0,tiny(0.0d0) ) !! write(*,'(a)')pr !! pr=anyscalar_to_string('complex :',cmplx(huge(0.0),tiny(0.0)) ) !! write(*,'(a)')pr !! !! ! create a format on the fly !! biggest=huge(0) !! frmt=anyscalar_to_string('(*(i',int(log10(real(biggest))),':,1x))',sep='') !! write(*,*)'format=',frmt !! !! ! although it will often work, using anyscalar_to_string(3f) !! ! in an I/O statement is not recommended !! ! because if an error occurs anyscalar_to_string(3f) will try !! ! to write while part of an I/O statement !! ! which not all compilers can handle and is currently non-standard !! write(*,*)anyscalar_to_string('program will now stop') !! !! end program demo_anyscalar_to_string !! !! Output !! !! HUGE(3f) integers 2147483647 and real 3.40282347E+38 !! and double 1.7976931348623157E+308 !! real : 3.40282347E+38 0.00000000 12345.6787 1.17549435E-38 !! doubleprecision : 1.7976931348623157E+308 0.0000000000000000 !! 12345.678900000001 2.2250738585072014E-308 !! complex : (3.40282347E+38,1.17549435E-38) !! format=(*(i9:,1x)) !! program will now stop !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT pure function anyscalar_to_string(gen0, gen1, gen2, gen3, gen4, gen5, gen6, gen7, gen8, gen9, & & gena, genb, genc, gend, gene, genf, geng, genh, geni, genj, & & sep) ! ident_7="@(#) M_anything anyscalar_to_string(3fp) writes a message to a string composed of any standard scalar types" class(*),intent(in),optional :: gen0, gen1, gen2, gen3, gen4 class(*),intent(in),optional :: gen5, gen6, gen7, gen8, gen9 class(*),intent(in),optional :: gena, genb, genc, gend, gene class(*),intent(in),optional :: genf, geng, genh, geni, genj character(len=:),allocatable :: anyscalar_to_string character(len=4096) :: line integer :: istart integer :: increment character(len=*),intent(in),optional :: sep character(len=:),allocatable :: sep_local if(present(sep))then increment=len(sep)+1 sep_local=sep else increment=2 sep_local=' ' endif istart=1 line='' if(present(gen0))call print_generic(gen0,line,istart,increment,sep_local) if(present(gen1))call print_generic(gen1,line,istart,increment,sep_local) if(present(gen2))call print_generic(gen2,line,istart,increment,sep_local) if(present(gen3))call print_generic(gen3,line,istart,increment,sep_local) if(present(gen4))call print_generic(gen4,line,istart,increment,sep_local) if(present(gen5))call print_generic(gen5,line,istart,increment,sep_local) if(present(gen6))call print_generic(gen6,line,istart,increment,sep_local) if(present(gen7))call print_generic(gen7,line,istart,increment,sep_local) if(present(gen8))call print_generic(gen8,line,istart,increment,sep_local) if(present(gen9))call print_generic(gen9,line,istart,increment,sep_local) if(present(gena))call print_generic(gena,line,istart,increment,sep_local) if(present(genb))call print_generic(genb,line,istart,increment,sep_local) if(present(genc))call print_generic(genc,line,istart,increment,sep_local) if(present(gend))call print_generic(gend,line,istart,increment,sep_local) if(present(gene))call print_generic(gene,line,istart,increment,sep_local) if(present(genf))call print_generic(genf,line,istart,increment,sep_local) if(present(geng))call print_generic(geng,line,istart,increment,sep_local) if(present(genh))call print_generic(genh,line,istart,increment,sep_local) if(present(geni))call print_generic(geni,line,istart,increment,sep_local) if(present(genj))call print_generic(genj,line,istart,increment,sep_local) anyscalar_to_string=trim(line) contains !=================================================================================================================================== pure subroutine print_generic(generic,line,istart,increment,sep) class(*),intent(in) :: generic character(len=4096),intent(inout) :: line integer,intent(inout) :: istart integer,intent(in) :: increment character(len=*),intent(in) :: sep select type(generic) type is (integer(kind=int8)); write(line(istart:),'(i0)') generic type is (integer(kind=int16)); write(line(istart:),'(i0)') generic type is (integer(kind=int32)); write(line(istart:),'(i0)') generic type is (integer(kind=int64)); write(line(istart:),'(i0)') generic type is (real(kind=real32)); write(line(istart:),'(1pg0)') generic type is (real(kind=real64)); write(line(istart:),'(1pg0)') generic #ifdef FLOAT128 type is (real(kind=real128)); write(line(istart:),'(1pg0)') generic #endif type is (logical); write(line(istart:),'(l1)') generic type is (character(len=*)); write(line(istart:),'(a)') trim(generic) type is (complex); write(line(istart:),'("(",1pg0,",",1pg0,")")') generic end select istart=len_trim(line)+increment line=trim(line)//sep end subroutine print_generic end function anyscalar_to_string !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! !! anyinteger_to_string(3f) - [M_anything] convert integer of any kind to a string !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! impure function anyinteger_to_string(intin) result(str) !! !! character(len=:),allocatable :: anyinteger_to_string !! class(*),intent(in) :: intin !! !!##DESCRIPTION !! !! Converts an integer value to a string representing the value. !! This function allows arguments of different INTEGER types as input. !! !!##OPTIONS !! !! VALUEIN INTEGER input argument to be converted to a string. !! May be of KIND kind=int8, kind=int16, kind=int32, kind=int64. !! !!##RESULTS !! The value of VALUIN converted to a CHARACTER string. !! !!##EXAMPLES !! !! !! Sample program !! !! program demo_anyinteger_to_string !! use, intrinsic :: iso_fortran_env, only : int8, int16, int32, int64 !! use M_anything, only : itoc=>anyinteger_to_string !! implicit none !! write(*,*)itoc(huge(0_int8)), '=> 127' !! write(*,*)itoc(huge(0_int16)), '=> 32767' !! write(*,*)itoc(huge(0_int32)), '=> 2147483647' !! write(*,*)itoc(huge(0_int64)), '=> 9223372036854775807',huge(0_int64) !! write(*,*)itoc(-(huge(0_int64)-1)), '=> -9223372036854775806' !! end program demo_anyinteger_to_string !! !! Results: !! !! 127=> 127 !! 32767=> 32767 !! 2147483647=> 2147483647 !! 9223372036854775807=> 9223372036854775807 !! -9223372036854775806=> -9223372036854775806 !! !!##AUTHOR !! John S. Urban !! !!##LICENSE !! MIT impure function anyinteger_to_string(int) result(out) ! ident_8="@(#) M_anything anyinteger_to_string(3f) function that converts an integer value to a character string" class(*),intent(in) :: int character(len=:),allocatable :: out integer,parameter :: maxlen=32 ! assumed more than enough characters for largest input value integer :: i, k integer(kind=int64) :: intval integer(kind=int64) :: int_local integer :: str(maxlen) integer,parameter :: dig0= ichar('0') integer,parameter :: minus= ichar('-') int_local = anyscalar_to_int64(int) ! convert input to largest integer type intval = abs(int_local) do i=1,maxlen ! generate digits from smallest significant digit to largest str(i) = dig0 + mod(intval,10_int64) intval = intval / 10 if(intval == 0 )exit enddo if (int_local < 0 ) then ! now make sure the sign is correct i=i+1 str(i) = minus endif allocate(character(len=i) :: out) do k=i,1,-1 ! have all the digits in reverse order, now flip them and convert to a string out(i-k+1:i-k+1)=char(str(k)) enddo end function anyinteger_to_string !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== !> !!##NAME !! get_type(3f) - [M_anything] return array of strings containing type !! names of arguments !! (LICENSE:MIT) !! !!##SYNOPSIS !! !! function get_type(anything) result(chars) !! !! class(*),intent(in) :: anything !! or !! class(*),intent(in) :: anything(..) !! !! character(len=:),allocatable :: chars !! !!##DESCRIPTION !! !! This function uses polymorphism to allow input arguments of different !! types. It is used by other procedures that can take many !! argument types as input options. !! !!##OPTIONS !! VALUEIN input array or scalar to return type of !! May be of KIND INTEGER(kind=int8), INTEGER(kind=int16), !! INTEGER(kind=int32), INTEGER(kind=int64), !! REAL(kind=real32, REAL(kind=real64), !! REAL(kind=real128), complex, or CHARACTER(len=*) !!##RETURN !! CHARS The returned value is an array of names !! !!##EXAMPLES !! !! Sample program !! !! program demo_get_type !! use M_anything, only : get_type !! implicit none !! integer :: i !! write(*,*)get_type([(i*i,i=1,10)]) !! write(*,*)get_type([11.11,22.22,33.33]) !! write(*,*)get_type('This is a string') !! write(*,*)get_type(30.0d0) !! end program demo_get_type !! !! Results: !! !! int32 !! real32 !! character !! real64 !! !!##AUTHOR !! John S. Urban !!##LICENSE !! MIT function get_type_arr(anything) result(chars) ! ident_9="@(#) M_anything get_type_arr(3fp) any vector of intrinsics to bytes (an array of CHARACTER(LEN=1) variables)" class(*),intent(in) :: anything(:) ! anything(..) character(len=20) :: chars select type(anything) type is (character(len=*)); chars='character' type is (complex); chars='complex' type is (complex(kind=dp)); chars='complex_real64' type is (integer(kind=int8)); chars='int8' type is (integer(kind=int16)); chars='int16' type is (integer(kind=int32)); chars='int32' type is (integer(kind=int64)); chars='int64' type is (real(kind=real32)); chars='real32' type is (real(kind=real64)); chars='real64' #ifdef FLOAT128 type is (real(kind=real128)); chars='real128' #endif type is (logical); chars='logical' class default stop 'crud. get_type_arr(1) does not know about this type' end select end function get_type_arr !----------------------------------------------------------------------------------------------------------------------------------- elemental impure function get_type_scalar(anything) result(chars) ! ident_10="@(#) M_anything get_type_scalar(3fp) anything to bytes (an array of CHARACTER(LEN=1) variables)" class(*),intent(in) :: anything character(len=20) :: chars select type(anything) type is (character(len=*)); chars='character' type is (complex); chars='complex' type is (complex(kind=dp)); chars='complex_real64' type is (integer(kind=int8)); chars='int8' type is (integer(kind=int16)); chars='int16' type is (integer(kind=int32)); chars='int32' type is (integer(kind=int64)); chars='int64' type is (real(kind=real32)); chars='real32' type is (real(kind=real64)); chars='real64' #ifdef FLOAT128 type is (real(kind=real128)); chars='real128' #endif type is (logical); chars='logical' class default stop 'crud. get_type_scalar(1) does not know about this type' end select end function get_type_scalar !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !=================================================================================================================================== end module M_anything !=================================================================================================================================== !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !===================================================================================================================================