MODULE listamoduuli
  IMPLICIT NONE

  TYPE alkiotyyppi
    INTEGER :: avain, lkm
  END TYPE alkiotyyppi

  TYPE listatyyppi
    TYPE(alkiotyyppi) :: alkio
    TYPE(listatyyppi), POINTER :: seuraava
  END TYPE listatyyppi
CONTAINS
  SUBROUTINE lisaa(lista, luku)
    ! Lisätään kokonaisluku listaan, siten että alkiot pysyvät
    ! avaimen mukaan kasvavassa järjestyksessä.
    IMPLICIT NONE
    TYPE(listatyyppi), POINTER :: lista
    INTEGER :: luku
    TYPE(listatyyppi), POINTER :: edellinen, uusi, nykyinen

    nykyinen => lista
    NULLIFY(edellinen)

    DO WHILE( ASSOCIATED(nykyinen) )
      IF ( luku > nykyinen % alkio % avain  ) THEN
        ! Jos lisättävä luku on suurempi kuin listan
        ! nykyalkion avain  mennään listassa eteenpäin
        edellinen => nykyinen
        nykyinen => nykyinen % seuraava
      ELSE IF ( nykyinen % alkio % avain == luku ) THEN
        ! Listassa on jo tämä arvo
        nykyinen % alkio % lkm = nykyinen % alkio % lkm + 1
        EXIT
      ELSE 
        ! Oikea paikka löytyi. Lisätään listaan uusi alkio
        ALLOCATE( uusi )
        IF ( ASSOCIATED(edellinen) ) THEN
          edellinen % seuraava => uusi
        ELSE
          lista => uusi
        END IF
        uusi % alkio % avain = luku
        uusi % alkio % lkm = 1
        uusi % seuraava => nykyinen
        EXIT
      END IF
    END DO
    ! Jos lista tuli käytyä kokonaisuudessaan läpi, uusi 
    ! arvo kuuluu listan loppuun. Jos listaa ei alunperin 
    ! ollut olemassa, luodaan se.
    IF ( .NOT. ASSOCIATED(nykyinen) ) THEN
      IF ( ASSOCIATED(edellinen) ) THEN
        ALLOCATE(uusi)
        edellinen % seuraava => uusi
      ELSE
        ALLOCATE( lista )
        uusi => lista
      END IF
      uusi % alkio % avain = luku
      uusi % alkio % lkm = 1
      NULLIFY( uusi % seuraava )
    END IF
  END SUBROUTINE lisaa
END MODULE listamoduuli

PROGRAM listatesti
  USE listamoduuli
  IMPLICIT NONE
  TYPE(listatyyppi), POINTER :: lista
  INTEGER :: i,n
  REAL :: x

  NULLIFY(lista)

  DO i = 1,5
!    CALL RANDOM_NUMBER(x)
!    n = 10 * x
    WRITE (*,*) 'Anna n: '
    READ (*,*) n
    WRITE( *,* ) 'Lisää: ', n
    CALL lisaa(lista,n)
  END DO

  WRITE(*,*) 'Listan sisältö:'
  DO WHILE( ASSOCIATED(lista) )
    WRITE(*,*) 'Alkio: ',lista % alkio % avain, &
               ' Lukumäärä: ',lista % alkio % lkm
    lista => lista % seuraava
  END DO
END PROGRAM listatesti