PROGRAM Listino3
!-------------------------------------------------------------------------
! Ricerca del prezzo di un articolo in un listino.
! Versione con subroutine interna.
!-------------------------------------------------------------------------
!--- Dichiarazioni globali, visibili alla procedura interna
  IMPLICIT NONE
  TYPE :: Articolo
    CHARACTER(LEN=5) :: codice
    INTEGER :: prezzo
  END TYPE Articolo
  INTEGER,PARAMETER :: nmax=100
  TYPE(Articolo),DIMENSION(nmax) :: listino  ! vettore di tipo Articolo
  INTEGER :: i,nelem
  CHARACTER(LEN=5) :: cod

!--- Caricamento del listino
  WRITE(*,*) "Quanti articoli? (massimo", nmax, ") : "
  READ(*,*) nelem
  WRITE(*,*) "Dammi di seguito codice e prezzo: "
  READ(*,*) (listino(i)%codice,listino(i)%prezzo, i=1,nelem)
!--- Interrogazione iterata
  DO
    WRITE(*,*) "Codice articolo? ('' per terminare) : "
    READ(*,*) cod
    IF (cod=='') EXIT            ! codice nullo per terminare
    CALL Ricerca(cod,listino,nelem)
!     Chiamata di sottoprogramma
  END DO
  STOP

!   Il programma principale termina qui.
!   CONTAINS introduce la parte di codice con le "procedure interne",
!   cioe' definite nel programma principale.
CONTAINS
!-------------------------------------------------------------------------
SUBROUTINE Ricerca(cod,listino,nelem)
! Ricerca dell'articolo nel listino e stampa, dato il codice.
!-------------------------------------------------------------------------
  CHARACTER(LEN=*),INTENT(IN) :: cod
!   L'asterisco indica che l'argomento fittizio ha "lunghezza presunta",
!   che corrispondera' a quella dell'argomento effettivo.
  INTEGER,         INTENT(IN) :: nelem
  TYPE(Articolo),DIMENSION(nelem),INTENT(IN) :: listino
!   L'argomento vettore cosi' dichiarato e' di "forma esplicita".
!   L'attributo INTENT indica lo "scopo" dell'argomento; puo' valere:
!    IN     valore definito in ingresso, non si puo' modificare
!    OUT    valore indefinito in ingresso, sara' assegnato dalla proc.
!    IN OUT valore definito in ingresso, si puo' modificare
!   Le dichiarazioni precedenti definiscono l'"interfaccia esplicita"
!   della Subroutine: il suo nome ed il numero e tipo degli argomenti.
!   Gli argomenti sono sempre passati per indirizzo.

!--- Dichiarazioni locali, proprie della procedura
  LOGICAL :: trovato
  INTEGER :: i
  trovato = .FALSE.
  DO i=1,nelem                                ! scandisci listino
    IF (listino(i)%codice == cod) THEN        ! controlla l'i-esimo elem.
      WRITE(*,*) "Prezzo:", listino(i)%prezzo ! codice trovato
      trovato = .TRUE.
      EXIT
    END IF
  END DO
  IF (.NOT.trovato) WRITE(*,*) "Codice inesistente!"
  RETURN
!   Questa istruzione termina l'esecuzione della procedura
END SUBROUTINE Ricerca
END PROGRAM Listino3
!  Qui termina l'"unita' di programma" chiamata "programma principale".
!  Ogni unita' di programma viene compilata in modo a se' stante.
