C File: istogram.for
C Scopo: soluzione al problema 4 del compito di esame di
C        Fondamenti di Informatica del 14/10/2000

      PROGRAM Istogramma

      IMPLICIT NONE 
      INTEGER DIM
      PARAMETER (DIM=5)
      INTEGER Vet(DIM), Mat(DIM,DIM), I, J

      WRITE(*,*) 'Immetti ', DIM, ' interi'
      READ(*,*) (Vet(I), I=1,DIM)

      CALL CalcolaIstogramma(Vet, Mat, DIM)

      WRITE(*,*) 'Istogramma:'

      DO 10 I = 1, DIM
	WRITE (*,100) (Mat(I,J), J=1,DIM)
 10   CONTINUE

 100  FORMAT (1X,1000I1)

      STOP
      END

C Subroutine che risolve l'esercizio proposto

C ALGORITMO:
C   per ogni riga i della matrice
C   ripeti se l'i-esimo elemento del vettore e` <= 0
C          allora poni Altezza pari a 0
C          altrimenti se l'i-esimo elemento del vettore e` >= dimensione
C                     allora poni Altezza pari alla dimensione del vettore
C                     altrimenti poni Altezza pari all'i-esimo el. del vettore
C          poni i primi Altezza elementi della riga i della matrice pari a 1
C          poni i rimanenti elementi della riga i della matrice pari a 0

      SUBROUTINE CalcolaIstogramma (V, M, D)
      IMPLICIT NONE
      INTEGER D, V(D), M(D,D)

      INTEGER I, J, Altezza

      DO 10 I = 1, D
        IF (V(I) .LE. 0) THEN
          Altezza = 0
        ELSE IF (V(I) .GE. D) THEN
          Altezza = D
        ELSE
          Altezza = V(I)
        ENDIF

        DO 20 J = 1, Altezza
          M(I,J) = 1
 20     CONTINUE

        DO 30 J = Altezza+1, D
          M(I,J) = 0
 30     CONTINUE
 10   CONTINUE

      RETURN
      END
