F90: Programa de estatística básica

Este código foi desenvolvido pelos alunos Ana Carolina. Essia Cassia, Fabiana Pereira, Gabriela Isabel, Jéssica Santos, Jurandi Prazeres, Otávio Neto, Roberto Joaquiim e Rogerio Oliveira durante a disciplina Processamento de Dados (UFBA 2008.2). Data da apresentação: 25/11/2008.

PROGRAM Estatistica
  IMPLICIT NONE
  LOGICAL::L
  CHARACTER (LEN=300)::Caminho, caminho2
  INTEGER:: i, n
  REAL::AUX
  REAL, DIMENSION (:), ALLOCATABLE :: v
  WRITE(*,*)"QUANTOS NUMEROS TEM O SEU BANCO DE DADOS?"
  READ(*,*) n
  ALLOCATE (v(1:n))
  WRITE (*,*) "DIGITE O CAMINHO DO SEU BANCO DE DADOS,", &
    " CASO JÁ O TENHA DIGITADO EM FORMATO "".TXT"", ", &
    "Exemplo:C:\Meus documentos\entrada.txt, ",&
    "CASO CONTRÁRIO DIGITE ""NAO""."
  READ (*,*) Caminho
  IF (Caminho/="nao")THEN
    OPEN (UNIT=10, FILE=Caminho)
    READ (10,*)(v(i), i=1,n)
    CLOSE (10)
  ELSE   
    WRITE (*,*) "Digite seu banco de dados"   
    READ (*,*)(v(i), i=1,n)
  END IF
  DO
    L=.False.
    DO i=1,(n-1)
      IF (v(i)>v(i+1)) THEN
        AUX=v(i)
        v(i)=v(i+1)
        v(i+1)=AUX
        L=.true.
      END IF
    END DO
    IF(.not.L) THEN
      EXIT 
    END IF
  END DO
  CALL MenuPrincipal(v)
  DEALLOCATE(v)
CONTAINS
  SUBROUTINE MenuPrincipal(VetorDeEntrada)
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada
    INTEGER :: C
    DO
      WRITE (*,*) "Escolha uma opção:"
      WRITE (*,*) "1- Moda"
      WRITE (*,*) "2- Média"
      WRITE (*,*) "3- Mediana"
      WRITE (*,*) "4- Variância"
      WRITE (*,*) "5- Desvio Padrão"
      WRITE (*,*) "6- Coeficiente de Variação"            
      WRITE (*,*) "7- Frequência"
      WRITE (*,*) "8- Amplitude Total"
      WRITE (*,*) "9- Tudo"
      WRITE (*,*) "10- Sair"
      READ (*,*) C
      IF (c/=10) THEN
        WRITE (*,*) "Para salvar o output,",&
          "abra o bloco de notas e salve um arquivo em branco com nome desejado,",&
          "em seguida digite o nome do caminho onde salvou o arquivo",&
          "Exemplo:C:\Meus documentos\saida.txt"
        READ (*,*) caminho2
        OPEN (UNIT=11, FILE=caminho2, ACCESS="APPEND")
      END IF
      SELECT CASE (C)
        CASE (1)
          CALL Moda (VetorDeEntrada)
        CASE (2)
          WRITE (*,*) "A média é ", &
          Media(VetorDeEntrada)
          WRITE (11,*) "A média é ", &
          Media(VetorDeEntrada)
        CASE (3)
          WRITE (*,*) "A mediana é ", &
          Mediana(VetorDeEntrada)
          WRITE (11,*) "A mediana é ", &
          Mediana(VetorDeEntrada)      
        CASE (4)
          WRITE (*,*) "A variância é ", &
          Variancia(VetorDeEntrada)
          WRITE (11,*) "A variância é ", &
          Variancia(VetorDeEntrada)    
        CASE (5)
          WRITE (*,*) "O desvio padrão é ", &
          DesvioPadrao(VetorDeEntrada)
          WRITE (11,*) "O desvio padrão é ", &
          DesvioPadrao(VetorDeEntrada)        
        CASE (6)
          WRITE (*,*) "O coeficiente de variação é ", &
          CoeficienteDeVariacao(VetorDeEntrada)
          WRITE (11,*) "O coeficiente de variação é ", &
          CoeficienteDeVariacao(VetorDeEntrada) 
        CASE (7)
          CALL Frequencia (v)
        CASE (8)
          WRITE (*,*) "A Amplitude Total é: ", &
          Amplitude(VetorDeEntrada)
          WRITE (11,*) "A Amplitude Total é: ", &
          Amplitude(VetorDeEntrada)       
        CASE (9)
          CALL Moda (VetorDeEntrada)
          WRITE (*,*) "A média é ", &
          Media(VetorDeEntrada)
          WRITE (11,*) "A média é ", &
          Media(VetorDeEntrada)
          WRITE (*,*) "A mediana é ", &
          Mediana(VetorDeEntrada)
          WRITE (11,*) "A mediana é ", &
          Mediana(VetorDeEntrada)
          CALL Frequencia (v)
          WRITE (*,*) "A variância é ", &
          Variancia(VetorDeEntrada)
          WRITE (11,*) "A variância é ", &
          Variancia(VetorDeEntrada)
          WRITE (*,*) "O desvio padrão é ", &
          DesvioPadrao(VetorDeEntrada)
          WRITE (11,*) "O desvio padrão é ", &
          DesvioPadrao(VetorDeEntrada)
          WRITE (*,*) "O coeficiente de variação é ", &
          CoeficienteDeVariacao(VetorDeEntrada)
          WRITE (11,*) "O coeficiente de variação é ", &
          CoeficienteDeVariacao(VetorDeEntrada)                       
          WRITE (*,*) "A Amplitude Total é: ", &
          Amplitude(VetorDeEntrada)
          WRITE (11,*) "A Amplitude Total é: ", &
          Amplitude(VetorDeEntrada)         
        CASE (10)
          STOP "Programa encerrado."
      END SELECT
      IF (c/=10) THEN
        CLOSE (11)
      END IF
    END DO
  END SUBROUTINE MenuPrincipal
  SUBROUTINE Moda(Vetor)
    IMPLICIT NONE
    INTEGER::i=0,K=1,CONT,quant_max=1
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: Vetor
    REAL::M(2,n)
    DO i = 1, n
      M(2,i) = 1
    END DO
    CONT=1
    i=1
    DO
      IF (Vetor(CONT)==Vetor(CONT+1)) THEN
        IF (i==1) THEN
          M(1,i) = Vetor(CONT)
          M(2,i) = M(2,i)+1
          i=i+1
        ELSE
          IF (M(1,i-1)==Vetor(CONT)) THEN
            M(2,i-1)=M(2,i-1)+1
          ELSE
            M(1,i)=Vetor(CONT)
            M(2,i)=M(2,i)+1
            i = i+1
          END IF
        END IF
      END IF
      CONT=CONT+1
      IF (CONT>=n) THEN
        EXIT
      END IF
    END DO
    DO
      IF(M(2,K)>quant_max) THEN
        quant_max = M(2,K)
      END IF
      K = K+1
      IF (K>=i) THEN
        EXIT
      END IF
    END DO
    K=1
    WRITE(*,*)"A moda é :"
    WRITE(11,*)"A moda é :"
    IF (quant_max==1) THEN
      DO
        WRITE(*,*)"->",Vetor(K)
        WRITE(11,*)"->",Vetor(K)
        K = K+1
        IF (K>n) THEN
          EXIT
        END IF
      END DO			
    ELSE
      DO
        IF(M(2,K)==quant_max) THEN
          WRITE(*,*)"->",M(1,K)
          WRITE(11,*)"->",M(1,K)
        END IF
        K = K+1
        IF (K>=i) THEN
          EXIT
        END IF
      END DO			
    END IF
  END SUBROUTINE
  REAL FUNCTION Media(VetorDeEntrada)
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada
    REAL:: Soma       
    Soma = 0
    DO i=1,SIZE(VetorDeEntrada)
      Soma = Soma + VetorDeEntrada(i)
    END DO 
    Media = Soma / (SIZE(VetorDeEntrada) * 1.0)
  END FUNCTION Media
  REAL FUNCTION Variancia(VetorDeEntrada)
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada
    REAL, DIMENSION (:), ALLOCATABLE :: VetorSomatorio
    REAL :: MediaDosElementos
    INTEGER::Soma
    ALLOCATE (VetorSomatorio(1:n))       
    MediaDosElementos = Media(VetorDeEntrada)
    DO i=1,SIZE(VetorDeEntrada)
      VetorSomatorio(i) = (VetorDeEntrada(i)-MediaDosElementos)**2
    END DO   
    Soma = 0
    DO i=1,SIZE(VetorDeEntrada)
      Soma = Soma + VetorSomatorio(i)
    END DO   
    Variancia = Soma / (SIZE(VetorDeEntrada) * 1.0)       
    DEALLOCATE(VetorSomatorio)
  END FUNCTION Variancia
  REAL FUNCTION DesvioPadrao(VetorDeEntrada)
    IMPLICIT NONE
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada    
    DesvioPadrao = SQRT (Variancia(VetorDeEntrada))     
  END FUNCTION DesvioPadrao
  REAL FUNCTION CoeficienteDeVariacao(VetorDeEntrada)
    IMPLICIT NONE
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada 
    CoeficienteDeVariacao = (DesvioPadrao(VetorDeEntrada)*1.0)  / &
      (Media(VetorDeEntrada)*1.0)      
  END FUNCTION CoeficienteDeVariacao
  SUBROUTINE Frequencia(V)
    IMPLICIT NONE
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: V    
    INTEGER::i,f 
    i=1
    Do
      f=1
      Do                    
        If (i/=n .and. V(i)==V(i+1)) then
          f=f+1
          i=i+1
        Else
          Write (*,*) "A frequência de", V(i),"=", f
          Write (11,*) "A frequência de", V(i),"=", f
          i=i+1
          EXIT
        End If               
      End Do                  
      If (i>=n) then
        If (i==n.and. V(i)/=V(i-1)) then      
          Write (*,*) "A frequência de", V(i),"=", 1
          Write (11,*) "A frequência de", V(i),"=", 1
        End if
        exit
      End if
    End Do
  END SUBROUTINE Frequencia 
  REAL FUNCTION Amplitude(VetorDeEntrada)
    IMPLICIT NONE
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada
    Amplitude=(VetorDeEntrada(n)-VetorDeEntrada(1))
  END FUNCTION Amplitude
  REAL FUNCTION Mediana(VetorDeEntrada)
    REAL, DIMENSION (:), ALLOCATABLE, INTENT(in) :: VetorDeEntrada    
    IF (MOD(N,2)/= 0) THEN
      Mediana= VetorDeEntrada((N+1)/2)
    ELSE
      Mediana=(VetorDeEntrada(N/2)+VetorDeEntrada((N+2)/2))/(2*1.0)
    END IF
  END FUNCTION Mediana
END PROGRAM Estatistica