module n3bits

  implicit none

contains

  subroutine upcase(line)
    character(*), intent(inout):: line
    integer:: i, iac
    do, i = 1, len(line)
      iac = iachar(line(i:i))
      if (iac >= iachar('a') .and. iac <= iachar('z')) then
        line(i:i) = achar(iac - iachar('a') + iachar('A'))
      endif
    enddo
  end subroutine

  subroutine downcase(line)
    character(*), intent(inout):: line
    integer:: i, iac
    do, i = 1, len(line)
      iac = iachar(line(i:i))
      if (iac >= iachar('A') .and. iac <= iachar('Z')) then
        line(i:i) = achar(iac - iachar('A') + iachar('a'))
      endif
    enddo
  end subroutine

  integer function c4pack(string) result(result)
    character(*), intent(in):: string
    integer:: i
    result = 0
    do, i = 1, min(len(string), 4)
      result = ior(result, ishft(ichar(string(i:i)), (4 - i) * 8))
    enddo
  end function

  subroutine atoipack(string, ibuf, ibuflen)
    character(*), intent(in):: string
    integer, intent(out):: ibuf(*)
    integer, intent(in):: ibuflen
    integer:: i, c1, c2
    do, i = 1, ibuflen
      c1 = (i - 1) * 4 + 1
      if (c1 <= len(string)) then
        c2 = min(c1 + 3, len(string))
        ibuf(i) = c4pack(string(c1:c2))
      else
        ibuf(i) = c4pack('    ')
      endif
    enddo
  end subroutine

  subroutine itoaunpack(ibuf, ibuflen, string)
    integer, intent(in):: ibuf(*)
    integer, intent(in):: ibuflen
    character(*), intent(out):: string
    integer:: i, c, word, idx0, idx1
    idx0 = min(ibuflen, (len(string) / 4))
    do, i = 1, idx0
      word = ibuf(i)
      c = 1 + (i - 1) * 4
      string(c:c) = char(iand(255, ishft(word, -24)))
      c = 2 + (i - 1) * 4
      string(c:c) = char(iand(255, ishft(word, -16)))
      c = 3 + (i - 1) * 4
      string(c:c) = char(iand(255, ishft(word, -8)))
      c = 4 + (i - 1) * 4
      string(c:c) = char(iand(255, word))
    enddo
    if (len(string) > (idx0 * 4)) then
      idx1 = idx0 * 4 + 1
      string(idx1: ) = " "
    endif
  end subroutine

  character(4) function c4unpack(i) result(result)
    integer, intent(in):: i
    integer:: j(1)
    j(1) = i
    call itoaunpack(j, 1, result)
  end function

end module