MODULE yksikot
  IMPLICIT NONE
  REAL, DIMENSION(6), PARAMETER :: &
      matkat = (/ &
        0.01, &             ! sentit
        0.0254, &           ! tuumat
        0.3048, &           ! jalat
        0.9144, &           ! jaardit
        1e3, &              ! kilometrit
        1609.34 /)          ! mailit
CONTAINS
  RECURSIVE FUNCTION muunna_r(x, alkup, kohde) RESULT(tulos)
    IMPLICIT NONE
    REAL, INTENT(IN) :: x
    CHARACTER(LEN=*), INTENT(IN) :: alkup, kohde
    REAL :: tulos
    SELECT CASE (alkup)
      CASE ('sentti', 'cm')
        tulos = muunna_r(matkat(1)*x, 'metri', kohde)
      CASE ('tuuma', 'in')
        tulos = muunna_r(matkat(2)*x, 'metri', kohde)
      CASE ('jalka', 'ft')
        tulos = muunna_r(matkat(3)*x, 'metri', kohde)
      CASE ('jaardi', 'yd')
        tulos = muunna_r(matkat(4)*x, 'metri', kohde)
      CASE ('kilometri', 'km')
        tulos = muunna_r(matkat(5)*x, 'metri', kohde)
      CASE ('maili', 'mile')
        tulos = muunna_r(matkat(6)*x, 'metri', kohde)
      CASE ('metri', 'm')
        SELECT CASE (kohde)
          CASE ('metri', 'm');      tulos = x
          CASE ('sentti', 'cm');    tulos = x/matkat(1)
          CASE ('tuuma', 'in');     tulos = x/matkat(2)
          CASE ('jalka', 'ft');     tulos = x/matkat(3)
          CASE ('jaardi', 'yd');    tulos = x/matkat(4)
          CASE ('kilometri', 'km'); tulos = x/matkat(5)
          CASE ('maili', 'mile');   tulos = x/matkat(6)
          CASE DEFAULT;             tulos = -HUGE(tulos)
        END SELECT
      CASE DEFAULT
        tulos = -HUGE(tulos)
    END SELECT
  END FUNCTION muunna_r
END MODULE yksikot

PROGRAM muunnostesti
  USE yksikot
  IMPLICIT NONE
  REAL :: luku
  CHARACTER(LEN=10) :: yks1, yks2
  WRITE (*,'(A)') 'Anna arvo sekä alkuperäinen ja&
      & haluttu yksikkö:'
  READ (*, *) luku, yks1, yks2
  WRITE (*,'(A,G12.6)') 'Tulos: ', muunna_r(luku,yks1,yks2)
END PROGRAM muunnostesti