MODULE muotoilu

  IMPLICIT NONE

  INTERFACE OPERATOR(*)
    MODULE PROCEDURE toista_mjono, toista_mjono_2
  END INTERFACE
  INTERFACE OPERATOR(.fmt.)
    MODULE PROCEDURE minimileveyskoodi
  END INTERFACE
  INTERFACE ASSIGNMENT(=)
    MODULE PROCEDURE mjono_kokonaisluku
  END INTERFACE

CONTAINS

  FUNCTION toista_mjono(kertaa, mjono) RESULT(uusi_mjono)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: kertaa
    CHARACTER(LEN=*), INTENT(IN) :: mjono
    CHARACTER(LEN=kertaa*LEN(mjono)) :: uusi_mjono
    uusi_mjono = REPEAT(mjono,kertaa)
  END FUNCTION toista_mjono

  FUNCTION toista_mjono_2(mjono,kertaa) RESULT(uusi_mjono)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: kertaa
    CHARACTER(LEN=*), INTENT(IN) :: mjono
    CHARACTER(LEN=kertaa*LEN(mjono)) :: uusi_mjono
    uusi_mjono = REPEAT(mjono,kertaa)
  END FUNCTION toista_mjono_2

  FUNCTION minimileveyskoodi(n) RESULT(mjono)
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: n
    CHARACTER(LEN=3) :: mjono
    INTEGER :: pituus
    pituus = desimaalit(n)
    IF (n < 0) pituus = pituus + 1
    WRITE (mjono, '(I3)') pituus
    mjono = 'I' // TRIM(ADJUSTL(mjono))
  CONTAINS
    FUNCTION desimaalit(i) RESULT(desim)
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: i
      INTEGER :: desim, apu
      INTRINSIC ABS
      desim = 1
      apu = ABS(i)
      DO WHILE (apu >= 10)
        apu = apu/10
        desim = desim + 1
      END DO
    END FUNCTION desimaalit
  END FUNCTION minimileveyskoodi

  SUBROUTINE mjono_kokonaisluku(mjono, n)
    IMPLICIT NONE
    CHARACTER(LEN=*), INTENT(OUT) :: mjono
    INTEGER, INTENT(IN) :: n
    CHARACTER(LEN=RANGE(n)+2) :: apu
    WRITE (apu,'(' // .fmt. n // ')') n
    mjono = ADJUSTL(apu)
  END SUBROUTINE mjono_kokonaisluku

END MODULE muotoilu

PROGRAM muotoilutesti
  USE muotoilu
  INTEGER :: m = 1996
  CHARACTER(LEN=10) :: formaatti

  WRITE (*,'(A)') 4*'Hurraa! '
  WRITE (*,'(A)') 3*'Hei! '*2

  formaatti = '(A,' // .fmt. m // ',A)'
  WRITE (*,'(A)') 'Muotoilukoodi: ' // formaatti
  WRITE (*, formaatti) 'Luku on ', m, '.'

  m = -100000*m
  formaatti = '(A,' // .fmt. m // ',A)'
  WRITE (*,'(A)') 'Muotoilukoodi: ' // formaatti
  WRITE (*, formaatti) 'Luku on ', m, '.'
END PROGRAM muotoilutesti