! 2進数を10進数と16進数に変換するプログラム
! 2015/04/26 梅内紫芳

program base 

  implicit none 
  integer  n, i, j, kai, k, loop
  integer,allocatable :: x(:)
  integer,allocatable :: s(:)
  character(20),allocatable :: l(:)

! 桁数の入力を促す
  write(*,*) ' Enter number of digit : '
  read(*,*) n
  allocate( x(n) )

! 各桁の値を配列要素に入力する
  do i = 1, n
    write(*,*) ' Enter item(", i, "): '
    read(*,*) x(i)
  enddo
  write(*,*) ' base02 --> '
  do i = 1, n
    write(*,fmt='(I1)',advance='no') x(i)
  enddo
  write(*,*)

! 10進数へ変換(ホーナー法)
  kai = 0
  do i = 1, n        
    kai = kai * 2 + x(i)  
  enddo
  write(*,*) ' base10 --> '
  write(*,*) kai  

! 16進数へ変換 
  if ( mod(n, 4) /= 0 ) then              ! 2進数の桁数nが4の倍数か否かで   
    allocate( s(n/4 + 1) )                ! 配列領域の動的割付を場合分け
    allocate( l(n/4 + 1) )     
  else 
    allocate( s(n/4) )
    allocate( l(n/4) )
  endif

  s(:) = 0

  if ( mod(n, 4) /= 0 ) then              ! 2進数の桁数nが4の倍数ではないとき
    do i = 1, mod(n, 4)                   ! 1番目の桁について16進数へ変換
      s(1) = s(1) * 2 + x(i)
    enddo
  endif

  if ( mod(n, 4) == 0 ) then
    loop = n/4
  else
    loop = n/4 + 1
  endif

  do j = 1, n/4                           ! jは16進数の桁
    k = 4 * j - 3 + mod(n, 4)
    if ( mod(n, 4) == 0 ) then            ! 2進数の桁数が4の倍数のとき
      do i = k, k + 3                     ! j桁目中の4桁の2進数を16進数へ変換
        s(j) = s(j) * 2 + x(i) 
      enddo
    else                                  ! 2進数の桁数が4の倍数でないとき
      do i = k, k + 3                     ! 2番目以降の桁について16進数へ変換    
        s(j + 1) = s(j + 1) * 2 + x(i)
      enddo
    endif       
  enddo 
  
  write(*,*) ' base16 --> '

 
  do j = 1, loop 
    write(l(j),'(I2)') s(j)               ! s(j)をintegerからcharacter:lへ変換
    if ( l(j) == '10' ) then
      l(j) = 'A'  
    elseif ( l(j) == '11' ) then
      l(j) = 'B'
    elseif ( l(j) == '12' ) then
      l(j) = 'C'
    elseif ( l(j) == '13' ) then
      l(j) = 'D'
    elseif ( l(j) == '14' ) then
      l(j) = 'E'
    elseif ( l(j) == '15' ) then
      l(j) = 'F'
    endif
  enddo 

! 計算結果の出力
  if ( mod(n, 4) == 0 ) then            
    do j = 1, n/4                        
      write(*,fmt='(a2)',advance='no') l(j)
    enddo
  else 
    do j = 1, n/4 + 1
      write(*,fmt='(a2)',advance='no') l(j)     
    enddo
  endif
  write(*,*)  

! 配列領域の解放
  deallocate(x, s, l)

end program base
