decodebase(3f) - [M_strings:BASE] convert whole number string in base
[2-36] to base 10 number
(LICENSE:PD)
logical function decodebase(string,basein,out10)
character(len=*),intent(in) :: string
integer,intent(in) :: basein
integer,intent(out) :: out10
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.
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
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
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)
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(in) | :: | string | |||
| integer, | intent(in) | :: | basein | |||
| integer, | intent(out) | :: | out_baseten |
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