MODULE libr

CONTAINS

   FUNCTION combvet(a,b,n)
      IMPLICIT NONE
!     Allocazione automatica: nessun controllo
      INTEGER, INTENT(IN) :: n
      REAL(8), DIMENSION(n), INTENT(IN) :: a, b
      REAL(8), DIMENSION(n) :: combvet
!
      INTEGER :: i
!
      DO i = 1, n
         IF ( a(i) > b(i) ) THEN
            combvet(i) = a(i)
         ELSE
            combvet(i) = b(i)
         END IF
      END DO
!
      RETURN
   END FUNCTION combvet
!
   FUNCTION combvetp(a,b,n,f)
      IMPLICIT NONE
!     Allocazione dinamica con sinonimo
      INTEGER, INTENT(IN) :: n
      INTEGER, INTENT(OUT) :: f
      REAL(8), DIMENSION(n), INTENT(IN) :: a, b
      REAL(8), DIMENSION(:), POINTER :: combvetp
!
      INTEGER :: i, st
!
      ALLOCATE(combvetp(n), STAT=st)
      IF ( st /= 0 ) THEN
         PRINT*,"In COMBVETP errore allocazione risultato"
         f = -1
         RETURN
      END IF 
      f = 1
      DO i = 1, n
         IF ( a(i) > b(i) ) THEN
            combvetp(i) = a(i)
         ELSE
            combvetp(i) = b(i)
         END IF
      END DO
!
      RETURN
   END FUNCTION combvetp
!
   FUNCTION combveta(a,b,n,f)
      IMPLICIT NONE
!     Allocazione dinamica stile Fortran 2003
      INTEGER, INTENT(IN) :: n
      INTEGER, INTENT(OUT) :: f
      REAL(8), DIMENSION(n), INTENT(IN) :: a, b
      REAL(8), DIMENSION(:), ALLOCATABLE :: combveta
!
      INTEGER :: i, st
!
      ALLOCATE(combveta(n), STAT=st)
      IF ( st /= 0 ) THEN
         PRINT*,"In COMBVETA errore allocazione risultato"
         f = -1
         RETURN
      END IF 
!
      f = 1
      DO i = 1, n
         IF ( a(i) > b(i) ) THEN
            combveta(i) = a(i)
         ELSE
            combveta(i) = b(i)
         END IF
      END DO
!
      RETURN
   END FUNCTION combveta
END MODULE libr

PROGRAM combina
   USE libr
   IMPLICIT NONE
   INTEGER, PARAMETER :: LunVet=1000
   REAL(8), DIMENSION(LunVet) :: a, b, c
   REAL(8) :: v, w
   INTEGER :: i, st
!
   PRINT*,"Valore elementi di A(:) e B(:):"
   READ*,v, w
   
   DO i = 1, LunVet
      a(i) = v * SIN(i*6.29D0/1000.)
      b(i) = w * COS(i*6.29D0/1000.)
   END DO
   
   c = combvet(a, b, 1000)
   
   WRITE(*,"(/,A)") "Allocazione automatica: C(1:10) = "
   WRITE(*,*) c(1:10)

   c = combvetp(a, b, 1000, st)
   
   IF ( st > 0 ) THEN
      WRITE(*,"(/,A)") "Allocazione con sinonimo: C(1:10) = "
      WRITE(*,*) c(1:10)
   END IF
   
   c = combveta(a, b, 1000,st)
   
   IF ( st > 0 ) THEN
      WRITE(*,"(/,A)") "Allocazione dinamica: C(1:10) = "
      WRITE(*,*) c(1:10)
   END IF
   
   STOP
END PROGRAM combina