anyscalar_to_string – M

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

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

Arguments

Type	Intent	Optional		Name
class(*),	intent(in),	optional	::	gen0
class(*),	intent(in),	optional	::	gen1
class(*),	intent(in),	optional	::	gen2
class(*),	intent(in),	optional	::	gen3
class(*),	intent(in),	optional	::	gen4
class(*),	intent(in),	optional	::	gen5
class(*),	intent(in),	optional	::	gen6
class(*),	intent(in),	optional	::	gen7
class(*),	intent(in),	optional	::	gen8
class(*),	intent(in),	optional	::	gen9
class(*),	intent(in),	optional	::	gena
class(*),	intent(in),	optional	::	genb
class(*),	intent(in),	optional	::	genc
class(*),	intent(in),	optional	::	gend
class(*),	intent(in),	optional	::	gene
class(*),	intent(in),	optional	::	genf
class(*),	intent(in),	optional	::	geng
class(*),	intent(in),	optional	::	genh
class(*),	intent(in),	optional	::	geni
class(*),	intent(in),	optional	::	genj
character(len=*),	intent(in),	optional	::	sep

Return Value character(len=:), allocatable

Source Code

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 HAS_REAL128
      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

anyscalar_to_string Function

Contents

Source Code

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

NAME

SYNOPSIS

DESCRIPTION

OPTIONS

RETURNS

EXAMPLES

AUTHOR

LICENSE

Arguments

Return Value character(len=:), allocatable

Source Code