PROGRAM EratosteneS
!--------------------------------------------------------------------------
! Crivello di Eratostene per la ricerca dei numeri primi.
! Per ogni numero inizialmente presente nel crivello, ne elimina i
!   multipli. Alla fine della ricerca, il crivello contiene i soli primi.
! Versione sequenziale con alcune istruzioni vettoriali.
! NOTA. Il ciclo DO indica che si tratta di un programma sequenziale.
!--------------------------------------------------------------------------
IMPLICIT NONE
  INTEGER :: I    & ! intero di servizio
           , N      ! limite di ricerca
!   Insiemi rappresentati mediante funzione caratteristica binaria:
!   l'indice del vettore corrisponde al numero, il valore ne indica la
!   presenza
  LOGICAL,ALLOCATABLE,DIMENSION(:):: crivello  ! insieme di ricerca

  WRITE(*,*) "Dammi il limite di ricerca dei numeri primi: "
  READ(*,*) N
!-- Alloca ed inizializza il vettore
  ALLOCATE (crivello(2:N))
  crivello = .TRUE.            ! Riempi il crivello
!   Assegnazione vettoriale: uno scalare e' conforme a qualunque array
!-- Estrai i numeri primi
  DO I=2,N/2                     ! Per tutti gli interi fino ad N/2...
    IF (.NOT.crivello(I))  CYCLE ! ... ancora presenti nel crivello...
!     L'istruzione CYCLE interrompe l'iterazione corrente
    crivello(2*I:N:I)=.FALSE.    ! ... togli tutti i loro multipli
!     Sezione di vettore con passo (stride): estrae gli elementi di
!     crivello fra 2*I ed N che distano I posizioni fra loro.
  END DO
!-- Stampa i primi
  WRITE(*,*) "I primi sono:"
!   Tra tutti gli interi, stampa solo i primi
  WRITE(*,*) PACK((/(I,I=2,N)/), crivello)
!   PACK: f. intrinseca vettoriale, estrae gli elementi del primo argom.
!   che corrispondono al valore vero del secondo argomento (maschera).
!   E' richiesta la conformita' degli argomenti.
  STOP
END PROGRAM EratosteneS
