F90: Programa das distribuições de probabilidade

Este programa foi desenvolvido pelos alunos Jéssica Batista, Leonardo Baltazar, Luis Antonio, Talita Souza Costa e Tatiana Felix durante a disciplina Processamento de Dados (UFBA 2008.2). Data da apresentação: 02/12/2008.

PROGRAM ESTATISTICO
  IMPLICIT NONE
  CALL MenuPrincipal ()
CONTAINS
  SUBROUTINE MENUPRINCIPAL ()
    IMPLICIT NONE
    INTEGER :: OPCAO, ERRO
    Write (*,*) "1-BERNOULLI"
    Write (*,*) "2-GEOMETRICA"
    write (*,*) "3-UNIFORME"
    Write (*,*) "4-SAIR"
    DO
      READ (*,*,IOstat=ERRO) OPCAO
      IF (ERRO <=0.AND.OPCAO>=1.AND.OPCAO<=4) THEN
        SELECT CASE (OPCAO)
          CASE (1)
            CALL CALCULARBERNOULLI ()
          CASE (2)
            CALL CALCULARGEOMETRICA ()
          CASE (3)
            CALL CALCULARUNIFORME ()
          CASE (4)
            STOP
        END SELECT
        EXIT
      END IF
    END DO
  END SUBROUTINE MENUPRINCIPAL
  SUBROUTINE CALCULARBERNOULLI ()
    IMPLICIT NONE
    INTEGER :: x, ERRO
    REAL :: p,q,Pr,M,V
    write (*,*) "digite ",0,"para fracasso e ",1,"para sucesso"
    READ (*,*)x
    Write (*,*) "digite a probabilidade de sucesso"
    READ (*,*, IOstat = ERRO) p
    DO
      IF (p<0 .OR. p>1) THEN
        Write (*,*) "probabilidade inválida"
        Write (*,*) "digite a probabilidade de sucesso"
        READ (*,*, IOstat = ERRO) p
      ELSE
        q=1-p
        Pr=((p**x)*(q**(1-x)))
        M=p
        V=p*(q)
        Write (*,*)"a probabilidade de ocorrer",x,"é",Pr
        Write (*,*) "a media e", M
        Write(*,*) "a variancia e ", V
        EXIT
      END IF
    END DO
  END SUBROUTINE CALCULARBERNOULLI
  SUBROUTINE CALCULARGEOMETRICA ()
    IMPLICIT NONE
    INTEGER :: x, ERRO
    REAL :: p,q,Pr,M,V
    Write (*,*) "digite o numero de dias ate a maquina quebrar"
    READ (*,*) x
    Write (*,*) "digite a probabilidade da maquina apresentar defeito"
    READ (*,*, IOstat = ERRO) p
    DO
      IF (p<0 .OR. p>1) THEN
        Write (*,*) "probabilidade inválida"
        Write (*,*) "digite a probabilidade de sucesso"
        READ (*,*, IOstat = ERRO) p
      ELSE
        q=1-p
        Pr=p*q**(x-1)
        M=q/(p*1.0)
        V=q/(p**2)
        Write (*,*) "a probabilidade da maquina interromper no sexto dia e", Pr
        Write (*,*) "a media e", M
        Write(*,*) "a variancia e ", V
        EXIT
      END IF
    END DO
  END SUBROUTINE CALCULARGEOMETRICA
  SUBROUTINE CALCULARUNIFORME ()
    IMPLICIT NONE
    INTEGER :: N,erro,i,k,opcao
    REAL :: Pr,M,V   
    Do
      Write (*,*) " 1 - Fazer problema"
      Write (*,*) " 2 - Listar valores"
      Write(*,*) " 3 - Sair"
      READ (*,*) opcao
      IF (opcao == 1 ) THEN
        Write (*,*) "digite o numero total de elementos"
        READ (*,*) N
        OPEN (unit=10,file="distribuicao.txt",access="append")
        Pr=1/N
        M=(N+1)/2
        V=((N**2)-1)/12
        Write (*,*) "numa rifa de 100 bilhetes a probabilidade de sair o bilhete 25 e", Pr
        Write (*,*) "a media e", M
        Write (*,*) "a variancia e", V
        CLOSE  (10)
      ELSE IF (opcao==2) THEN
        i=0
        OPEN(unit = 10,file="distribuicao.txt",access="sequential")
        DO
          i = i + 1
          READ (10,IOstat=erro) k, m
          IF (erro/=0) EXIT
          Write (*,*) i, k, m
        END DO
        IF (i==0) WRITE (*,*) "=> Nenhum elemento encontrado."
        CLOSE(10)
      ELSE IF (Opcao == 3) THEN
        EXIT
      END IF
    END DO
  END SUBROUTINE CALCULARUNIFORME
END PROGRAM ESTATISTICO