codebase Function

public function codebase(inval10, outbase, answer)

NAME

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

SYNOPSIS

logical function codebase(in_base10,out_base,answer)

integer,intent(in)           :: in_base10
integer,intent(in)           :: out_base
character(len=*),intent(out) :: answer

DESCRIPTION

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.

EXAMPLE

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

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
integer, intent(in) :: inval10
integer, intent(in) :: outbase
character(len=*), intent(out) :: answer

Return Value logical


Contents

Source Code

codebase

Source Code

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