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 (*,...)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search
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