decodebase Function

public function decodebase(string, basein, out_baseten)

NAME

decodebase(3f) - [M_strings:BASE] convert whole number string in base
[2-36] to base 10 number
(LICENSE:PD)

SYNOPSIS

logical function decodebase(string,basein,out10)

character(len=*),intent(in)  :: string
integer,intent(in)           :: basein
integer,intent(out)          :: out10

DESCRIPTION

Convert a numeric string representing a whole number in base BASEIN
to base 10. The function returns FALSE if BASEIN is not in the range
[2..36] or if string STRING contains invalid characters in base BASEIN
or if result OUT10 is too big

The letters A,B,...,Z represent 10,11,...,36 in the base > 10.

OPTIONS

string   input string. It represents a whole number in
         the base specified by BASEIN unless BASEIN is set
         to zero. When BASEIN is zero STRING is assumed to
         be of the form BASE#VALUE where BASE represents
         the function normally provided by BASEIN.
basein   base of input string; either 0 or from 2 to 36.
out10    output value in base 10

EXAMPLE

Sample program:

program demo_decodebase
use M_strings, only : codebase, decodebase
implicit none
integer           :: ba,bd
character(len=40) :: x,y
integer           :: r

print *,' BASE CONVERSION'
write(*,'("Start   Base (2 to 36): ")',advance='no'); read *, bd
write(*,'("Arrival Base (2 to 36): ")',advance='no'); read *, ba
INFINITE: do
   print *,''
   write(*,'("Enter number in start base: ")',advance='no'); read *, x
   if(x == '0') exit INFINITE
   if(decodebase(x,bd,r)) then
      if(codebase(r,ba,y)) then
        write(*,'("In base ",I2,": ",A20)')  ba, y
      else
        print *,'Error in coding number.'
      endif
   else
      print *,'Error in decoding number.'
   endif
enddo INFINITE

end program demo_decodebase

AUTHOR

John S. Urban

   Ref.: "Math matiques en Turbo-Pascal by
          M. Ducamp and A. Reverchon (2),
          Eyrolles, Paris, 1988".

based on a F90 Version By J-P Moreau (www.jpmoreau.fr)

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
integer, intent(in) :: basein
integer, intent(out) :: out_baseten

Return Value logical


Contents

Source Code


Source Code

logical function decodebase(string,basein,out_baseten)

! ident_80="@(#) M_strings decodebase(3f) convert whole number string in base [2-36] to base 10 number"

character(len=*),intent(in)  :: string
integer,intent(in)           :: basein
integer,intent(out)          :: out_baseten

character(len=len(string))   :: string_local
integer           :: long, i, j, k
real              :: y
real              :: mult
character(len=1)  :: ch
real,parameter    :: XMAXREAL=real(huge(1))
integer           :: out_sign
integer           :: basein_local
integer           :: ipound
integer           :: ierr

  string_local=upper(trim(adjustl(string)))
  decodebase=.false.

  ipound=index(string_local,'#')                                       ! determine if in form [-]base#whole
  if(basein == 0.and.ipound > 1)then                                  ! split string into two values
     call string_to_value(string_local(:ipound-1),basein_local,ierr)   ! get the decimal value of the base
     string_local=string_local(ipound+1:)                              ! now that base is known make string just the value
     if(basein_local >= 0)then                                         ! allow for a negative sign prefix
        out_sign=1
     else
        out_sign=-1
     endif
     basein_local=abs(basein_local)
  else                                                                 ! assume string is a simple positive value
     basein_local=abs(basein)
     out_sign=1
  endif

  out_baseten=0
  y=0.0
  ALL: if(basein_local<2.or.basein_local>36) then
    print *,'(*decodebase* ERROR: Base must be between 2 and 36. base=',basein_local
  else ALL
     out_baseten=0;y=0.0; mult=1.0
     long=LEN_TRIM(string_local)
     do i=1, long
        k=long+1-i
        ch=string_local(k:k)
        if(ch == '-'.and.k == 1)then
           out_sign=-1
           cycle
        endif
        if(ch<'0'.or.ch>'Z'.or.(ch>'9'.and.ch<'A'))then
           write(*,*)'*decodebase* ERROR: invalid character ',ch
           exit ALL
        endif
        if(ch<='9') then
              j=IACHAR(ch)-IACHAR('0')
        else
              j=IACHAR(ch)-IACHAR('A')+10
        endif
        if(j>=basein_local)then
           exit ALL
        endif
        y=y+mult*j
        if(mult>XMAXREAL/basein_local)then
           exit ALL
        endif
        mult=mult*basein_local
     enddo
     decodebase=.true.
     out_baseten=nint(out_sign*y)*sign(1,basein)
  endif ALL
end function decodebase