PROGRAM bittioperaatiot
  IMPLICIT NONE
  INTEGER, PARAMETER :: &
      kok_luku = SELECTED_INT_KIND(9), &
      bit_len = 8
  INTEGER(KIND=kok_luku), DIMENSION(4) :: luvut
  INTEGER(KIND=kok_luku) :: koodi
  INTEGER :: i
  WRITE (*,'(A,I3)') 'Syötä neljä kokonaislukua väliltä &
      &0 ... ', 2**bit_len-1
  READ (*,*) luvut
  DO i = 1, SIZE(luvut)
    WRITE (*,'(A,I1,":",7X,A)') 'Data ', i, bitit(luvut(i))
  END DO
  WRITE (*,'(A,A)') 'Pakattu data: ', bitit(pakkaa(luvut))
CONTAINS
  FUNCTION bitit(n)
    IMPLICIT NONE
    INTEGER(KIND=kok_luku), INTENT(IN) :: n
    CHARACTER(LEN=4*bit_len) :: bitit
    INTEGER :: i, lkm
    bitit = ' '
    lkm = MIN(LEN(bitit), BIT_SIZE(n))
    DO i = 0, lkm-1
      IF(BTEST(n,i)) THEN
        bitit(lkm-i:lkm-i) = '1'
      ELSE
        bitit(lkm-i:lkm-i) = '0'
      END IF
    END DO
  END FUNCTION bitit

  FUNCTION pakkaa(taulu)
    IMPLICIT NONE
    INTEGER, DIMENSION(:), INTENT(IN) :: taulu
    INTEGER(KIND=kok_luku) :: pakkaa
    INTEGER :: i, paikka
    pakkaa = 0
    DO i = 1, SIZE(taulu)
      paikka = bit_len*(i-1)
      IF ((paikka + bit_len) > BIT_SIZE(pakkaa)) RETURN
      CALL MVBITS(taulu(i), 0, bit_len, pakkaa, paikka)
    END DO
  END FUNCTION pakkaa
END PROGRAM bittioperaatiot