value_to_string Subroutine

public subroutine value_to_string(gval, chars, length, err, fmt, trimz)

NAME

  value_to_string(3f) - [M_strings:TYPE] return numeric string
  from a numeric value
  (LICENSE:PD)

SYNOPSIS

subroutine value_to_string(value,chars[,lgth,ierr,fmt,trimz])

 character(len=*) :: chars  ! minimum of 23 characters required
 !--------
 ! VALUE may be any <em>one</em> of the following types:
 doubleprecision,intent(in)               :: value
 real,intent(in)                          :: value
 integer,intent(in)                       :: value
 logical,intent(in)                       :: value
 !--------
 character(len=*),intent(out)             :: chars
 integer,intent(out),optional             :: lgth
 integer,optional                         :: ierr
 character(len=*),intent(in),optional     :: fmt
 logical,intent(in)                       :: trimz

DESCRIPTION

value_to_string(3f) returns a numeric representation of a numeric
value in a string given a numeric value of type REAL, DOUBLEPRECISION,
INTEGER or LOGICAL. It creates the string using internal writes. It
then removes trailing zeros from non-zero values, and left-justifies
the string.

OPTIONS

   VALUE   input value to be converted to a string
   FMT     You may specify a specific format that produces a string
           up to the length of CHARS; optional.
   TRIMZ   If a format is supplied the default is not to try to trim
           trailing zeros. Set TRIMZ to .true. to trim zeros from a
           string assumed to represent a simple numeric value.

RETURNS

   CHARS   returned string representing input value, must be at least
           23 characters long; or what is required by optional FMT
           if longer.
   LGTH    position of last non-blank character in returned string;
           optional.
   IERR    If not zero, error occurred; optional.

EXAMPLE

Sample program:

  program demo_value_to_string
  use M_strings, only: value_to_string
  implicit none
  character(len=80) :: string
  integer           :: lgth
     call value_to_string(3.0/4.0,string,lgth)
     write(*,*) 'The value is [',string(:lgth),']'

     call value_to_string(3.0/4.0,string,lgth,fmt='')
     write(*,*) 'The value is [',string(:lgth),']'

     call value_to_string&
     &(3.0/4.0,string,lgth,fmt='("THE VALUE IS ",g0)')
     write(*,*) 'The value is [',string(:lgth),']'

     call value_to_string(1234,string,lgth)
     write(*,*) 'The value is [',string(:lgth),']'

     call value_to_string(1.0d0/3.0d0,string,lgth)
     write(*,*) 'The value is [',string(:lgth),']'

  end program demo_value_to_string

Expected output

 The value is [0.75]
 The value is [      0.7500000000]
 The value is [THE VALUE IS .750000000]
 The value is [1234]
 The value is [0.33333333333333331]

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
class(*), intent(in) :: gval
character(len=*), intent(out) :: chars
integer, intent(out), optional :: length
integer, optional :: err
character(len=*), intent(in), optional :: fmt
logical, intent(in), optional :: trimz

Contents

Source Code


Source Code

subroutine value_to_string(gval,chars,length,err,fmt,trimz)

! ident_53="@(#) M_strings value_to_string(3fp) subroutine returns a string from a value"

class(*),intent(in)                      :: gval
character(len=*),intent(out)             :: chars
integer,intent(out),optional             :: length
integer,optional                         :: err
integer                                  :: err_local
character(len=*),optional,intent(in)     :: fmt         ! format to write value with
logical,intent(in),optional              :: trimz
character(len=:),allocatable             :: fmt_local
character(len=1024)                      :: msg

!  Notice that the value GVAL can be any of several types ( INTEGER,REAL,DOUBLEPRECISION,LOGICAL)

   if (present(fmt)) then
      select type(gval)
      type is (integer)
         fmt_local='(i0)'
         if(fmt /= '') fmt_local=fmt
         write(chars,fmt_local,iostat=err_local,iomsg=msg)gval
      type is (real)
         fmt_local='(bz,g23.10e3)'
         fmt_local='(bz,g0.8)'
         if(fmt /= '') fmt_local=fmt
         write(chars,fmt_local,iostat=err_local,iomsg=msg)gval
      type is (doubleprecision)
         fmt_local='(bz,g0)'
         if(fmt /= '') fmt_local=fmt
         write(chars,fmt_local,iostat=err_local,iomsg=msg)gval
      type is (logical)
         fmt_local='(l1)'
         if(fmt /= '') fmt_local=fmt
         write(chars,fmt_local,iostat=err_local,iomsg=msg)gval
      class default
         call journal('*value_to_string* UNKNOWN TYPE')
         chars=' '
      end select
      if(fmt == '') then
         chars=adjustl(chars)
         call trimzeros_(chars)
      endif
   else                                                  ! no explicit format option present
      err_local=-1
      select type(gval)
      type is (integer)
         write(chars,*,iostat=err_local,iomsg=msg)gval
      type is (real)
         write(chars,*,iostat=err_local,iomsg=msg)gval
      type is (doubleprecision)
         write(chars,*,iostat=err_local,iomsg=msg)gval
      type is (logical)
         write(chars,*,iostat=err_local,iomsg=msg)gval
      class default
         chars=''
      end select
      chars=adjustl(chars)
      if(index(chars,'.') /= 0) call trimzeros_(chars)
   endif
   if(present(trimz))then
      if(trimz)then
         chars=adjustl(chars)
         call trimzeros_(chars)
      endif
   endif

   if(present(length)) then
      length=len_trim(chars)
   endif

   if(present(err)) then
      err=err_local
   elseif(err_local /= 0)then
       ! cannot currently do I/O from a function being called from I/O
       !write(ERROR_UNIT,'(a)')'*value_to_string* WARNING:['//trim(msg)//']'
      chars=chars//' *value_to_string* WARNING:['//trim(msg)//']'
   endif

end subroutine value_to_string