PROGRAM EratosteneP
!--------------------------------------------------------------------------
! 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 completamente vettoriale (parallela).
! NOTA. Rispetto alla versione sequenziale, il ciclo DO e' stato sostituito
!   dal costrutto FORALL.
!--------------------------------------------------------------------------
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
!-- Estrai i numeri primi
  FORALL (I=2:N/2) ! Per tutti gli interi fino ad N/2...
    crivello(2*I:N:I)=.FALSE.  ! ... togli i loro multipli dal crivello
  END FORALL
!-- Stampa i primi
  WRITE(*,*) "I primi sono:"
  WRITE(*,*) PACK((/(I,I=2,N)/), crivello)
  STOP
END PROGRAM EratosteneP
