F90: Menu do máximo, mínimo e média aritmética
From AdonaiMedrado.Pro.Br
Revision as of 04:26, 4 October 2008 by Adonaimedrado (Talk | contribs) (New page: <code lang="fortran"> PROGRAM aula IMPLICIT NONE CALL MenuPrincipal() CONTAINS SUBROUTINE MenuPrincipal() IMPLICIT NONE INTEGER :: Opcao, Erro WRITE (*,*) "1- Máximo" WRITE (*,...)
PROGRAM aula IMPLICIT NONE CALL MenuPrincipal() CONTAINS SUBROUTINE MenuPrincipal() IMPLICIT NONE INTEGER :: Opcao, Erro WRITE (*,*) "1- Máximo" WRITE (*,*) "2- Mínimo" WRITE (*,*) "3- Média" WRITE (*,*) "4- Sair" DO READ (*,*,IOstat=Erro) Opcao IF (Erro <= 0 .AND. Opcao >= 1 .AND. Opcao <=4) THEN SELECT CASE (Opcao) CASE (1) CALL CalcularMaximo() CASE (2) CALL CalcularMinimo() CASE (3) CALL CalcularMedia() CASE (4) RETURN END SELECT EXIT END IF END DO END SUBROUTINE MenuPrincipal SUBROUTINE CalcularMaximo() IMPLICIT NONE INTEGER :: Numero, Maximo, Erro LOGICAL :: MaximoAtribuido = .FALSE. WRITE (*,*) "Digite uma sequencia de números inteiros." WRITE (*,*) "Digite um valor não inteiro (exemplo: ""fim"") para finalizar." DO READ(*,*,IOstat=Erro) Numero IF (Erro > 0) THEN EXIT END IF IF (Numero>Maximo .OR. .NOT. MaximoAtribuido) THEN Maximo = Numero MaximoAtribuido = .TRUE. END IF END DO IF (MaximoAtribuido) THEN WRITE (*,*) "Número máximo: ", Maximo END IF END SUBROUTINE CalcularMaximo SUBROUTINE CalcularMinimo() IMPLICIT NONE INTEGER :: Numero, Minimo, Erro LOGICAL :: MinimoAtribuido = .FALSE. WRITE (*,*) "Digite uma sequencia de números inteiros." WRITE (*,*) "Digite um valor não inteiro (exemplo: ""fim"") para finalizar." DO READ(*,*,IOstat=Erro) Numero IF (Erro > 0) THEN EXIT END IF IF (Numero<Minimo .OR. .NOT. MinimoAtribuido) THEN Minimo = Numero MinimoAtribuido = .TRUE. END IF END DO IF (MinimoAtribuido) THEN WRITE (*,*) "Número mínimo: ", Minimo END IF END SUBROUTINE CalcularMinimo SUBROUTINE CalcularMedia() IMPLICIT NONE REAL :: Numero, Soma = 0 INTEGER :: Erro, Quantidade = 0 WRITE (*,*) "Digite uma sequencia de números reais." WRITE (*,*) "Digite um valor não real (exemplo: ""fim"") para finalizar." DO READ(*,*,IOstat=Erro) Numero IF (Erro > 0) THEN EXIT END IF Soma = Soma + Numero Quantidade = Quantidade + 1 END DO IF (Quantidade>0) THEN WRITE (*,*) "Média: ", Soma/Quantidade END IF END SUBROUTINE CalcularMedia END PROGRAM aula