MODULE nousu
  IMPLICIT NONE
  PRIVATE
  PUBLIC :: nousuindeksi
CONTAINS
  FUNCTION nousuindeksi(taulu) RESULT(idx)
    ! Shellsort-algoritmi
    IMPLICIT NONE
    REAL, DIMENSION(:), INTENT(IN) :: taulu
    INTEGER, DIMENSION(SIZE(taulu)) :: idx
    INTEGER :: n, askel, i, j, apuidx
    n = SIZE(taulu)
    idx = (/ (i, i = 1, n) /)
    askel = 1
    DO WHILE (askel <= n)
      askel = 3*askel + 1
    END DO
    DO
      askel = askel/3
      DO i = askel+1, n
        apuidx = idx(i)
        j = i
        DO WHILE (j > askel)
          IF (taulu(idx(j-askel)) <= taulu(apuidx)) EXIT
          idx(j) = idx(j-askel)
          j = j - askel
        END DO
        idx(j) = apuidx
      END DO
      IF (askel == 1) EXIT
    END DO
  END FUNCTION nousuindeksi
END MODULE nousu

PROGRAM lajittelu_testi
  ! Otetaan käyttöön lajittelurutiini:
  USE nousu, ONLY : nousuindeksi
  IMPLICIT NONE
  REAL, DIMENSION(:), ALLOCATABLE :: tiedot
  INTEGER, DIMENSION(:), ALLOCATABLE :: indeksit
  INTEGER :: n, tila

  WRITE (*,'(A)',ADVANCE='NO') 'Anna n>1: '
  READ (*,*) n
  IF (n <= 1) THEN
    STOP 'n <= 1'
  ELSE
    ALLOCATE(tiedot(n), indeksit(n), STAT=tila)
    IF (tila /= 0) THEN
      STOP 'Virhe muistinvarauksessa!'
    END IF
    CALL RANDOM_NUMBER(tiedot)
    WRITE (*,'(A,/,8(F9.5))') 'Data:', tiedot
    indeksit = nousuindeksi(tiedot)
    WRITE (*,'(A,/,8(F9.5))') 'Lajiteltu data:', &
        tiedot(indeksit)
  END IF
END PROGRAM lajittelu_testi