intmath.F90

Go to the documentation of this file.

 
 
module intmath
  implicit none
 
  interface ilog2 
     ! log(x)/log(2)
     module procedure ilog2_8 
     module procedure ilog2_4
     module procedure ilog2_2
     module procedure ilog2_1
  end interface ilog2
 
  interface i1log2
     ! log(x+1)/log(2) unless x=maxint, in which case log(x)/log(2)
     module procedure i1log2_8
     module procedure i1log2_4
     module procedure i1log2_2
     module procedure i1log2_1
  end interface i1log2
 
contains
 
  function i1log2_8(ival)
    implicit none
    integer(kind=8), value :: ival
    integer(kind=8)::i1log2_8
    integer(kind=8), parameter :: one=1
    if(ival+one<ival) then
       i1log2_8=ilog2_8(ival)
    else
       i1log2_8=ilog2_8(ival+one)
    endif
  end function i1log2_8
 
  function i1log2_4(ival)
    implicit none
    integer(kind=4), value :: ival
    integer(kind=4)::i1log2_4
    integer(kind=4), parameter :: one=1
    if(ival+one<ival) then
       i1log2_4=ilog2_4(ival)
    else
       i1log2_4=ilog2_4(ival+one)
    endif
  end function i1log2_4
 
  function i1log2_2(ival)
    implicit none
    integer(kind=2), value :: ival
    integer(kind=2)::i1log2_2
    integer(kind=2), parameter :: one = 1_2
    if(ival+one<ival) then
       i1log2_2=ilog2_2(ival)
    else
       i1log2_2=ilog2_2(ival+one)
    endif
  end function i1log2_2
 
  function i1log2_1(ival)
    implicit none
    integer(kind=1), value :: ival
    integer(kind=1)::i1log2_1
    integer(kind=1), parameter :: one = 1_1
    if(ival+one<ival) then
       i1log2_1=ilog2_1(ival)
    else
       i1log2_1=ilog2_1(ival+one)
    endif
  end function i1log2_1
 
  function ilog2_8(i_in)
    implicit none
    integer(kind=8), value :: i_in
    integer(kind=8)::ilog2_8,i
    ilog2_8=0
    i=i_in
    if(i<=0) return
    if(iand(i,i-1)/=0) then
       !write(0,*) 'iand i-1'
       ilog2_8=1
    endif
    if(iand(i,z'FFFFFFFF00000000')/=0) then
       ilog2_8=ilog2_8+32
       i=ishft(i,-32)
       !write(0,*) 'iand ffffffff',i,ilog2_8
    endif
    if(iand(i,z'00000000FFFF0000')/=0) then
       ilog2_8=ilog2_8+16
       i=ishft(i,-16)
       !write(0,*) 'iand ffff' ,i,ilog2_8
    endif
    if(iand(i,z'000000000000FF00')/=0) then
       ilog2_8=ilog2_8+8
       i=ishft(i,-8)
       !write(0,*) 'iand ff',i,ilog2_8
    endif
    if(iand(i,z'00000000000000F0')/=0) then
       ilog2_8=ilog2_8+4
       i=ishft(i,-4)
       !write(0,*) 'iand f',i,ilog2_8
    endif
    if(iand(i,z'000000000000000C')/=0) then
       ilog2_8=ilog2_8+2
       i=ishft(i,-2)
       !write(0,*) 'iand c',i,ilog2_8
    endif
    if(iand(i,z'0000000000000002')/=0) then
       ilog2_8=ilog2_8+1
       i=ishft(i,-1)
       !write(0,*) 'iand 2',i,ilog2_8
    endif
  end function ilog2_8
 
  function ilog2_4(i_in)
    implicit none
    integer(kind=4), value :: i_in
    integer(kind=4)::ilog2_4,i
    ilog2_4=0
    i=i_in
    if(i<=0) return
    if(iand(i,i-1)/=0) then
       !write(0,*) 'iand i-1'
       ilog2_4=1
    endif
    if(iand(i,z'FFFF0000')/=0) then
       ilog2_4=ilog2_4+16
       i=ishft(i,-16)
       !write(0,*) 'iand ffff' ,i,ilog2_4
    endif
    if(iand(i,z'0000FF00')/=0) then
       ilog2_4=ilog2_4+8
       i=ishft(i,-8)
       !write(0,*) 'iand ff',i,ilog2_4
    endif
    if(iand(i,z'000000F0')/=0) then
       ilog2_4=ilog2_4+4
       i=ishft(i,-4)
       !write(0,*) 'iand f',i,ilog2_4
    endif
    if(iand(i,z'0000000C')/=0) then
       ilog2_4=ilog2_4+2
       i=ishft(i,-2)
       !write(0,*) 'iand c',i,ilog2_4
    endif
    if(iand(i,z'00000002')/=0) then
       ilog2_4=ilog2_4+1
       i=ishft(i,-1)
       !write(0,*) 'iand 2',i,ilog2_4
    endif
  end function ilog2_4
 
  function ilog2_2(i_in)
    implicit none
    integer(kind=2), value :: i_in
    integer(kind=2)::ilog2_2,i
    ilog2_2 = 0_2
    i=i_in
    if(i<=0) return
    if(iand(i,int(i-1,kind=2))/=0) then
       !write(0,*) 'iand i-1'
       ilog2_2 = 1_2
    endif
    if(iand(i,z'FF00')/=0) then
       ilog2_2 = ilog2_2 + 8_2
       i=ishft(i,-8)
       !write(0,*) 'iand ff',i,ilog2_2
    endif
    if(iand(i,z'00F0')/=0) then
       ilog2_2 = ilog2_2 + 4_2
       i=ishft(i,-4)
       !write(0,*) 'iand f',i,ilog2_2
    endif
    if(iand(i,z'000C')/=0) then
       ilog2_2 = ilog2_2 + 2_2
       i=ishft(i,-2)
       !write(0,*) 'iand c',i,ilog2_2
    endif
    if(iand(i,z'0002')/=0) then
       ilog2_2 = ilog2_2 + 1_2
       i=ishft(i,-1)
       !write(0,*) 'iand 2',i,ilog2_2
    endif
  end function ilog2_2
 
  function ilog2_1(i_in)
    implicit none
    integer(kind=1), value :: i_in
    integer(kind=1)::ilog2_1,i
    ilog2_1 = 0_1
    i=i_in
    if(i<=0) return
    if(iand(i,int(i-1,kind=1))/=0) then
       !write(0,*) 'iand i-1'
       ilog2_1 = 1_1
    endif
    if(iand(i,z'F0')/=0) then
       ilog2_1 = ilog2_1 + 4_1
       i=ishft(i,-4)
       !write(0,*) 'iand f',i,ilog2_1
    endif
    if(iand(i,z'0C')/=0) then
       ilog2_1 = ilog2_1 + 2_1
       i=ishft(i,-2)
       !write(0,*) 'iand c',i,ilog2_1
    endif
    if(iand(i,z'02')/=0) then
       ilog2_1 = ilog2_1 + 1_1
       i=ishft(i,-1)
       !write(0,*) 'iand 2',i,ilog2_1
    endif
  end function ilog2_1
end module intmath