MODULE sukupuu
  IMPLICIT NONE
  TYPE perheosoitin
     TYPE (perhe), POINTER :: p
  END TYPE perheosoitin
  TYPE perhe
     CHARACTER (LEN=30) :: nimi
     CHARACTER (LEN=10) :: synt_aika
     CHARACTER (LEN=30) :: puoliso
     CHARACTER (LEN=10) :: puol_synt_aika
     INTEGER :: lapsia
     TYPE (perheosoitin), POINTER :: lapset(:)
  END TYPE perhe
CONTAINS
  RECURSIVE FUNCTION lue() RESULT (mina)
    ! Tämä funktio lukee perheen tiedot ja kutsuu 
    ! lukufunktiota rekursiivisesti kaikille lapsille. 
    ! Funktio palauttaa osoittimen perheeseen. 
    IMPLICIT NONE
    TYPE(perhe), POINTER :: mina
    INTEGER :: i

    ALLOCATE(mina)
    WRITE (*,'(A)',advance='no') 'Anna nimi: '
    READ (*,'(A)') mina%nimi
    WRITE (*,'(A)',advance='no') 'Anna syntymäaika: '
    READ (*,'(A)') mina%synt_aika
    WRITE (*,'(A)',advance='no') 'Anna puolison nimi: '
    READ (*,'(A)') mina%puoliso
    WRITE (*,'(A)',advance='no') 'Anna puolison syntymäaika: '
    READ (*,'(A)') mina%puol_synt_aika
    WRITE (*,'(A)',advance='no') 'Anna lasten lukumäärä: '
    READ (*,*) mina%lapsia
    ALLOCATE (mina%lapset(mina%lapsia))
    DO i = 1, mina%lapsia
       WRITE (*,*) mina%nimi, ' : lapsi numero ', i
       mina%lapset(i)%p => lue()
    END DO
  END FUNCTION lue

  RECURSIVE SUBROUTINE tulosta(mina, polvi)
    ! Tämä aliohjelma tulostaa sisennetyn sukupuun rekursiivisesti
    IMPLICIT NONE
    TYPE(perhe), POINTER :: mina
    INTEGER, INTENT(IN) :: polvi ! Sukupolven numero
    INTEGER :: i

    WRITE(*,'(5A)',advance='no') REPEAT(' ',4*polvi), &
         TRIM(mina%nimi), ' (', TRIM(mina%synt_aika) ,')'
    IF (LEN_TRIM(mina%puoliso) > 0) THEN
       WRITE (*,'(5A)') ' & ', TRIM(mina%puoliso), ' (', &
            TRIM(mina%puol_synt_aika), ')'
    ELSE
       WRITE (*,*)
    END IF
    DO i = 1, mina%lapsia
       CALL tulosta(mina%lapset(i)%p, polvi+1)
    END DO
  END SUBROUTINE tulosta

  RECURSIVE SUBROUTINE etsi(mina, nimi)
    ! Tämä aliohjelma etsii merkkijonoa 'nimi' sukupuusta 
    ! ja tulostaa löydetyt henkilöt
    IMPLICIT NONE
    TYPE(perhe), POINTER :: mina
    CHARACTER(LEN=*), INTENT(IN) :: nimi
    INTEGER :: i

    IF (INDEX(mina%nimi, nimi) > 0) THEN
       WRITE (*,'(4A)') TRIM(mina%nimi), &
           ' (', TRIM(mina%synt_aika) ,')'
    END IF
    IF (INDEX(mina%puoliso, nimi) > 0) THEN
       WRITE (*,'(4A)') TRIM(mina%puoliso), &
           ' (', TRIM(mina%puol_synt_aika) ,')'
    END IF
    DO i = 1, mina%lapsia
       CALL etsi(mina%lapset(i)%p, nimi)
    END DO
  END SUBROUTINE etsi

END MODULE sukupuu