Fortran Wiki
tostring (Rev #5, changes)

Showing changes from revision #4 to #5: (追記) Added (追記ここまで) | ~~(削除) Removed (削除ここまで)~~ | ~~(削除) Chan (削除ここまで)~~(追記) ged (追記ここまで)

NAME

tostring(3f) - [M_tostring] converts any standard scalar type to a string

SYNOPSIS

function tostring(g1,g2.g3,g4,g5,g6,g7,g8,g9)
 class(*),intent(in),optional :: g1,g2,g3,g4,g5,g6,g7,g8,g9
 character,len=(:),allocatable :: tostring

DESCRIPTION

tostring(3f) builds a space-separated string from up to nine scalar values.

Requires modern Fortran. Shows an example of unlimited polymorphic arguments, optional arguments, and new forms of formats.

Tested with GNU Fortran 7.3.0.

OPTIONS

g[1-9]: optional value to convert to a string. May be of type INTEGER, LOGICAL, REAL, DOUBLEPRECISION, COMPLEX, or CHARACTER.

RETURNS

tostring: string representing all the input values

EXAMPLES

 Sample program:
 program demo_tostring
 use M_tostring, only : tostring
 implicit none
 character(len=:),allocatable :: pr
 pr=tostring('HUGE(3f) integer',huge(0),'and real',huge(0.0),'and double',huge(0.0d0))
 write(*,'(a)')pr
 pr=tostring('real :',huge(0.0),0.0,12345.6789,tiny(0.0) )
 write(*,'(a)')pr
 pr=tostring('doubleprecision :',huge(0.0d0),0.0d0,12345.6789d0,tiny(0.0d0) )
 write(*,'(a)')pr
 pr=tostring('complex :',cmplx(huge(0.0),tiny(0.0)) )
 write(*,'(a)')pr
 end program demo_tostring
 Expected 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)

(削除)
!===================================================================================================================================
(削除ここまで)(追記)

module M_tostring
implicit none
private
public tostring
contains
function tostring(generic1, generic2, generic3, generic4, generic5, generic6, generic7, generic8, generic9)
implicit none
! convert up to nine scalar intrinsic values to a string
class(*),intent(in),optional :: generic1 ,generic2 ,generic3 ,generic4, generic5
class(*),intent(in),optional :: generic6 ,generic7 ,generic8 ,generic9
character(len=:), allocatable :: tostring
character(len=4096) :: line
integer :: istart
 istart=1
 if(present(generic1))call print_generic(generic1)
 if(present(generic2))call print_generic(generic2)
 if(present(generic3))call print_generic(generic3)
 if(present(generic4))call print_generic(generic4)
 if(present(generic5))call print_generic(generic5)
 if(present(generic6))call print_generic(generic6)
 if(present(generic7))call print_generic(generic7)
 if(present(generic8))call print_generic(generic8)
 if(present(generic9))call print_generic(generic9)
 tostring=trim(line)
contains
!===================================================================================================================================
 subroutine print_generic(generic)
 use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64, real128
 class(*),intent(in),optional :: generic
 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
 type is (real(kind=real128)); write(line(istart:),'(1pg0)') generic
 type is (logical); write(line(istart:),'(1l)') generic
 type is (character(len=*)); write(line(istart:),'(a)') generic
 type is (complex); write(line(istart:),'("(",1pg0,",",1pg0,")")') generic
 end select
 istart=len_trim(line)+2
 end subroutine print_generic
!===================================================================================================================================
end function tostring
!===================================================================================================================================
end module M_tostring
!===================================================================================================================================

(追記ここまで)~~(削除) (削除ここまで)~~(削除)
module M_tostring implicit none private public tostring contains !=================================================================================================================================== function tostring(generic1, generic2, generic3, generic4, generic5, generic6, generic7, generic8, generic9) implicit none &@(#)M_debug::tostring(3f): writes a message to a string composed of up to nine of any standard scalar types March 08, 2019" character(len=*),parameter::ident_1="& class(*),intent(in),optional :: generic1 ,generic2 ,generic3 ,generic4 ,generic5 class(*),intent(in),optional :: generic6 ,generic7 ,generic8 ,generic9 character(len=:), allocatable :: tostring character(len=4096) :: line integer :: istart istart=1 if(present(generic1))call print_generic(generic1) if(present(generic2))call print_generic(generic2) if(present(generic3))call print_generic(generic3) if(present(generic4))call print_generic(generic4) if(present(generic5))call print_generic(generic5) if(present(generic6))call print_generic(generic6) if(present(generic7))call print_generic(generic7) if(present(generic8))call print_generic(generic8) if(present(generic9))call print_generic(generic9) tostring=trim(line) contains !=================================================================================================================================== subroutine print_generic(generic) use,intrinsic :: iso_fortran_env, only : int8, int16, int32, int64, real32, real64, real128 class(*),intent(in),optional :: generic 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 type is (real(kind=real128)); write(line(istart:),'(1pg0)') generic type is (logical); write(line(istart:),'(1l)') generic type is (character(len=*)); write(line(istart:),'(a)') generic type is (complex); write(line(istart:),'("("1pg0,",",1pg0,")")') generic end select istart=len_trim(line)+2 end subroutine print_generic !=================================================================================================================================== end function tostring !=================================================================================================================================== end module M_tostring !===================================================================================================================================
(削除ここまで)

category: code

Revision from March 15, 2019 15:42:28 by urbanjost