Adonaimedrado: New page: Este programa foi desenvolvido pelos alunos Alberto Rocha da Silva, Calos Alberto, Rafael Santos da Costa e Ruy Pereira durante a disciplina Processamento de Dados (UFBA 2008.2). Data da a...

2008-11-30T20:56:07Z

New page: Este programa foi desenvolvido pelos alunos Alberto Rocha da Silva, Calos Alberto, Rafael Santos da Costa e Ruy Pereira durante a disciplina Processamento de Dados (UFBA 2008.2). Data da a...

New page

Este programa foi desenvolvido pelos alunos Alberto Rocha da Silva, Calos Alberto, Rafael Santos da Costa e Ruy Pereira durante a disciplina Processamento de Dados (UFBA 2008.2). Data da apresentação: 27/11/2008.

<code lang="fortran">
PROGRAM paepg
IMPLICIT NONE
CALL MenuPrincipal()
CONTAINS
SUBROUTINE MenuPrincipal()
IMPLICIT NONE
INTEGER :: opcao, erro
Write (*,*) "1 Verificar se a serie e uma PA ou PG"
Write (*,*) "2 Calculo da razao da PA"
Write (*,*) "3 Calculo do ultimo termo da PA"
Write (*,*) "4 Calculo da quantidade de termos da PA"
Write (*,*) "5 Calculo da soma dos termos da PA"
Write (*,*) "6 Calculo da razao da PG"
Write (*,*) "7 Calculo do termo qualquer da PG"
Write (*,*) "8 Calculo do termo medio da PG"
Write (*,*) "9 Calculo da soma da PG finita"
Write (*,*) "10 Calculo da soma da pg infinita"
Write (*,*) "11 Calculo do produto da PG finita"
Write (*,*) "12 Sair"
DO
Read (*,*) opcao
IF (opcao>= 1 .AND. Opcao<=12) THEN
SELECT CASE (Opcao)
CASE (1)
CALL Verificaraserie()
CASE (2)
CALL Calculararazao()
CASE (3)
CALL Calcularultimotermo()
CASE (4)
CALL Calcularquantidadedetermos()
CASE (5)
CALL Calcularasomadostermos()
CASE (6)
CALL Calcularrazaopg()
CASE (7)
CALL Calculartermoqualquerdapg()
CASE (8)
CALL Calculartermomediodapg()
CASE (9)
CALL Calcularsomapgfinita()
CASE (10)
CALL Calcularsomapginfinita()
CASE (11)
CALL Calcularprodutopgfinita()
CASE (12)
RETURN
END SELECT
EXIT
END IF
END DO
END SUBROUTINE MenuPrincipal
SUBROUTINE Verificaraserie()
IMPLICIT NONE
REAL :: a,b,c,r
WRITE (*,*) "Digite o 1,2 e 3 termos de sua serie"
READ (*,*) a,b,c
IF (b-a==0 .AND. c-b==0) THEN
WRITE(*,*) "A serie e uma PA constante"
End IF
IF (b-a<0 .AND. b-a==c-b) THEN
WRITE(*,*) "A serie e uma PA decrescente"
END IF
IF (b-a>0 .AND. b-a==c-b) THEN
WRITE(*,*) "A serie é uma PA crescente"
END IF
IF (b/a==1 .AND. b/a==c/b) THEN
WRITE(*,*) "A serie e uma PG constante"
END IF
IF (b/a<0 .AND. b/a==c/b) THEN
WRITE(*,*) "A serie e uma PG oscilante"
END IF
IF (b/a == c/b) THEN
r=(b/a)
END IF
IF ((a>0 .AND. r>1) .OR. (a<0 .AND. r>0 .AND. r<1)) THEN
WRITE(*,*) "A serie e uma PG crescente"
END IF
IF (b/a == c/b) THEN
r= (b/a)
END IF
IF ((a<0 .AND. r>1) .OR. (a>0 .AND. r>0 .AND. r<1)) THEN
WRITE(*,*) "A serie e uma PG decrescente"
END IF
IF (b-a/=c-b .AND. b/a /= c/b) THEN
WRITE(*,*) "A serie nao e PA e nao e PG"
END IF
END SUBROUTINE verificaraserie
SUBROUTINE Calculararazao()
IMPLICIT NONE
REAL :: a,b
WRITE (*,*) "Digite o 1 e o 2 termo da PA"
READ (*,*) a,b
WRITE (*,*) "A razao e:",b-a
END SUBROUTINE Calculararazao
SUBROUTINE Calcularultimotermo()
IMPLICIT NONE
REAL :: a,b
INTEGER :: n
WRITE (*,*) "Digite o 1 e o 2 termo da PA"
READ (*,*) a,b
WRITE (*,*) "Digite a quantidade de termos da PA"
READ (*,*) n
WRITE(*,*) "O ultimo termo da PA e:",a+(n-1)*(b-a)
END SUBROUTINE Calcularultimotermo
SUBROUTINE Calcularquantidadedetermos()
IMPLICIT NONE
REAL :: a,b,c,Q
WRITE (*,*) "Digite o 1 e o ultimo termo da PA"
READ (*,*) a,b
WRITE (*,*) "Digite a razao da PA"
READ (*,*) c
Q = ((b-a)/c)+1
IF (Q <= 0) THEN
WRITE(*,*) "Os dados nao sao coerentes"
ELSE
WRITE (*,*) "A quantidade de termos da PA e:",Q
END IF
END SUBROUTINE calcularquantidadedetermos
SUBROUTINE Calcularasomadostermos()
IMPLICIT NONE
REAL :: a,b
INTEGER :: n
WRITE (*,*) "Digite o 1 e o ultimo termo da PA"
READ (*,*) a,b
WRITE (*,*) "Digite a quantidade de termos da PA"
READ (*,*) n
WRITE(*,*) "A soma dos termos da PA e:",(a+b)*n/2
END SUBROUTINE Calcularasomadostermos
SUBROUTINE Calcularrazaopg()
implicit none
real :: a1,an,q
integer :: n, ERRO
do
write(*,*) "Digite o primeiro termo da P.G"
read(*,*,IOstat=ERRO) a1
write(*,*) "Digite um termo sucessor n do termo digitado"
read(*,*,IOstat=ERRO) an
if(a1==0 .or. an==0 .or. a1*an<=0) then
write(*,*) "Numeros invalidos (a1 e an devem ser diferentes de zero e devem ter o mesmo sinal)"
else
exit
end if
end do
do
write(*,*) "Informe o quanto o termo n sucede o primeiro termo"
read(*,*,IOstat=ERRO) n
if(n<=0) THEN
write(*,*) "Numero Invalido(n>0)"
else
exit
end if
end do
q= ((an/a1)**(1/(n*1.0)))
write(*,*) "A razao e",q
END SUBROUTINE Calcularrazaopg
SUBROUTINE Calculartermoqualquerdapg()
real :: a1, an, q, n
do
write (*,*) "Digite o primeiro termo da P.G."
read (*,*) a1
if (a1 == 0) then
write(*,*) "O numero e invalido"
else
exit
end if
end do
do
write (*,*) "Digite a razao"
read (*,*) q
if (q == 1 .or. q <= 0) then
write (*,*) "O numero e invalido"
else
exit
end if
end do
do
write (*,*) "Digite o numero do termo desejado"
read (*,*) n
if (n <= 1) then
write (*,*) "O numero e invalido"
else
exit
end if
end do
an = a1*q**(n-1)
write (*,*) "O termo e igual a",an
END SUBROUTINE Calculartermoqualquerdapg
SUBROUTINE Calculartermomediodapg()
real:: a1, an, T
do
write(*,*) "digite o primeiro termo"
read(*,*) a1
write(*,*) "digite o ultimo termo"
read(*,*) an
if(a1==0 .or. an==0 .or. a1*an<=0) then
write(*,*) "Numeros invalidos"
else
exit
end if
end do
T=(a1*an)**(0.5)
write(*,*) "O termo medio e",T
END SUBROUTINE Calculartermomediodapg
SUBROUTINE Calcularsomapgfinita()
IMPLICIT NONE
real:: Sn, a1, q
integer :: n
do
write(*,*) "digite o termo inicial da P.G."
read(*,*) a1
if (a1==0) then
write(*,*) "Numero invalido"
else
exit
end if
end do
do
write(*,*) "Digite a razao"
read(*,*) q
if(q<=0 .or. q==1) then
write(*,*)"O numero e invalido"
else
exit
end if
end do
do
write(*,*) "Digite o numero de termos da P,G."
read(*,*) n
if(n<=1) then
write(*,*) "Numero invalido"
else
exit
end if
end do
Sn=(a1*(q**n-1))/(q-1)
write(*,*) "A soma dos termos da P.G. e",Sn
END SUBROUTINE Calcularsomapgfinita
SUBROUTINE Calcularsomapginfinita()
IMPLICIT NONE
real :: a1, Sn, q
do
write(*,*) "digite o primeiro termo"
read(*,*) a1
if(a1==0) then
write(*,*) "Numero invalido"
else
exit
end if
end do
do
write(*,*) "Digite a razao"
read(*,*) q
if(q<=0 .or. q>=1) then
write(*,*) "Numero invalido, A razao deve estar entre ]0,1["
else
exit
end if
end do
Sn=a1/(1-q)
write(*,*) "A soma desta P.G. e",Sn
END SUBROUTINE Calcularsomapginfinita
SUBROUTINE Calcularprodutopgfinita()
real:: a1, q, Pn
integer:: n, ERRO
do
write(*,*) "Digite o primeiro termo da P.G."
read(*,*) a1
if(a1==0) then
write(*,*) "Numero invalido"
else
exit
end if
end do
do
write(*,*) "Digite a razao"
read(*,*) q
if(q==1 .or. q<=0) then
write(*,*) "Numero invalido"
else
exit
end if
end do
do
write(*,*) "Digite o numero de termos da P.G."
read(*,*,IOstat=ERRO) n
if(n<=0 .or. n==1) then
write(*,*) "Numero invalido"
else
exit
end if
end do
Pn=(a1**n)*(q**((n*(n-1))/2))
write(*,*) "O produto dos", n,"termos da P.G. e",Pn
END SUBROUTINE Calcularprodutopgfinita
END PROGRAM paepg
</code>

F90: Programa de PA e PG - Revision history

Adonaimedrado: New page: Este programa foi desenvolvido pelos alunos Alberto Rocha da Silva, Calos Alberto, Rafael Santos da Costa e Ruy Pereira durante a disciplina Processamento de Dados (UFBA 2008.2). Data da a...