codebase(3f) - [M_strings:BASE] convert whole number in base 10 to
string in base [2-36]
(LICENSE:PD)
logical function codebase(in_base10,out_base,answer)
integer,intent(in) :: in_base10
integer,intent(in) :: out_base
character(len=*),intent(out) :: answer
Convert a number from base 10 to base OUT_BASE. The function returns
.FALSE. if OUT_BASE is not in [2..36] or if number IN_BASE10 is
too big.
The letters A,B,...,Z represent 10,11,...,36 in the base > 10.
Sample program:
program demo_codebase
use M_strings, only : codebase
implicit none
character(len=20) :: answer
integer :: i, j
logical :: ierr
do j=1,100
do i=2,36
ierr=codebase(j,i,answer)
write(*,*)'VALUE=',j,' BASE=',i,' ANSWER=',answer
enddo
enddo
end program demo_codebase
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 | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | inval10 | |||
integer, | intent(in) | :: | outbase | |||
character(len=*), | intent(out) | :: | answer |
logical function codebase(inval10,outbase,answer)
! ident_81="@(#) M_strings codebase(3f) convert whole number in base 10 to string in base [2-36]"
integer,intent(in) :: inval10
integer,intent(in) :: outbase
character(len=*),intent(out) :: answer
integer :: n
real :: inval10_local
integer :: outbase_local
integer :: in_sign
answer=''
in_sign=sign(1,inval10)*sign(1,outbase)
inval10_local=abs(inval10)
outbase_local=abs(outbase)
if(outbase_local<2.or.outbase_local>36) then
print *,'*codebase* ERROR: base must be between 2 and 36. base was',outbase_local
codebase=.false.
else
do while(inval10_local>0.0 )
n=INT(inval10_local-outbase_local*INT(inval10_local/outbase_local))
if(n<10) then
answer=ACHAR(IACHAR('0')+n)//answer
else
answer=ACHAR(IACHAR('A')+n-10)//answer
endif
inval10_local=INT(inval10_local/outbase_local)
enddo
codebase=.true.
endif
if(in_sign == -1)then
answer='-'//trim(answer)
endif
if(answer == '')then
answer='0'
endif
end function codebase