ExercíciosProg3_SemArquivos

Prévia do material em texto

Exercícios de Seleções
 PROGRAM L1EXERC1
c Dados dois valores inteiros A e B, distintos , imprimir o maior.
 INTEGER A B
 PRINT*, 'Digite valores para A e B'
 READ*, A, B
 PRINT*
 IF (A .GT. B) THEN
 PRINT*, A, ' e o maior'
 ELSE
 PRINT*, B, ' e o maior'
 ENDIF
 STOP
 END
 PROGRAM L1EXERC2
c Dados dois valores inteiros A e B, distintos, imprima mensagem
c se forem iguais ou nao
 INTEGER A, B
 PRINT*, 'Digite valores para A e B'
 READ*, A, B
 PRINT*
 IF (A .EQ. B) THEN
 PRINT*, 'A=', A, ' e ', 'B= ',B , ' sao iguais'
 ELSE
 PRINT*, 'A=', A, ' e ', 'B= ',B , ' sao diferentes'
 ENDIF
 STOP
 END
 PROGRAM L1EXERC3
c Dados dois valores inteiros A e B, distintos, imprimir A e B
c ordenados de forma crescente.
 INTEGER A, B, Aux
 PRINT*, 'Digite valores para A e B'
 READ*, A, B
 IF (A .GT. B) THEN
 Aux = A
 A = B
 B = Aux
 ENDIF
 PRINT*
 PRINT*, 'A=', A, ' B= ',B
 STOP
 END
 PROGRAM L1EXERC4
c Dado um valor inteiro A, imprimir se 10 <= A <= 20,
c ou uma mensagem caso contrario.
 INTEGER A
 PRINT*, 'Digite valor para A'
 READ*, A
 PRINT*
 IF ((A .GE. 10) .AND. (A .LE. 20) ) THEN
 PRINT*, A, ' esta no intervalo entre 10 e 20'
 ELSE
 PRINT*, A, ' nao esta no intervalo entre 10 e 20'
 ENDIF
 STOP
 END
 PROGRAM L1EXERC5
c Dados tres valores inteiros A, B e C, distintos, imprimir o maior.
 INTEGER A, B, C
 PRINT*, 'Digite valores para A, B e C'
 READ*, A, B, C
 PRINT*
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 PRINT*
 IF ((A .GT. B) .AND. (A .GT. C)) THEN
 PRINT*, A, ' e o maior'
 ELSE
 IF ((B .GT. A) .AND. (B .GT. C)) THEN
 PRINT*, B, ' e o maior'
 ELSE
 PRINT*, C, ' e o maior'
 ENDIF
 ENDIF
 STOP
 END
 PROGRAM L1EXERC6
c Dados tres valores inteiros A, B e C, distintos, imprimir o menor.
 INTEGER A, B, C
 PRINT*, 'Digite valores para A, B e C'
 READ*, A, B, C
 PRINT*
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 PRINT*
 IF ((A .LT. B) .AND. (A .LT. C)) THEN
 PRINT*, A, ' e o menor'
 ELSE
 IF ((B .LT. A) .AND. (B .LT. C)) THEN
 PRINT*, B, ' e o menor'
 ELSE
 PRINT*, C, ' e o menor'
 ENDIF
 ENDIF
 STOP
 END
 PROGRAM L1EXERC7
c Dados tres valores inteiros A, B e C, distintos,
c imprimir o intermediario.
 INTEGER A, B, C
 PRINT*, 'Digite valores para A, B e C'
 READ*, A, B, C
 PRINT*
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 PRINT*
 IF ((A .GT. B) .AND. (A .LT. C) .OR. (A .GT. C) .AND. (A .LT. B)
 *) THEN
 PRINT*, A, ' e o intermediario'
 ELSE
 IF ((B .GT. A) .AND. (B .LT. C) .OR. (B .GT. C) .AND.
 *(B .LT. A)) THEN
 PRINT*, B, ' e o intermediario'
 ELSE
 PRINT*, C, ' e o intermediario'
 ENDIF
 ENDIF
 STOP
 END
 PROGRAM L1EXERC8
c Dados tres valores inteiros A, B e C, verificar se eles podem ser
c lados de um triangulo e, se forem, imprimir se formam um triangulo
c equilatero,isosceles ou escaleno. Imprimir mensagem se os lados
c nao formam um triangulo.
 INTEGER A, B, C
 PRINT*, 'Digite valores para A, B e C'
 READ*, A, B, C
 PRINT*
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 PRINT*
 IF ((A .GT. B+C) .OR. (B .GT. A+C) .OR. (C .GT. A+B)) THEN
 PRINT*, ' Os valores lidos nao formam lados de um triangulo'
 ELSE
 IF ((A .EQ. B) .AND. (B .EQ. C)) THEN
 PRINT*, ' Os valores lidos formam um triangulo equilatero'
 ELSE
 IF ((A .EQ. B) .OR. (A .EQ. C) .OR. (B .EQ. C)) THEN
 PRINT*, ' Os valores lidos formam um triangulo isosceles'
 ELSE
 PRINT*, ' Os valores lidos formam um triangulo escaleno'
 ENDIF
 ENDIF
 ENDIF
 STOP
 END
 PROGRAM L1EXERC9
c Dados tres valores inteiros A, B e C, distintos, imprimir A, B, C
c ordenados de forma crescente.
 INTEGER A, B, C, Aux
 PRINT*, 'Digite valores para A, B e C'
 READ*, A, B, C
 PRINT*
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 PRINT*
 IF ((A .GT. B) .OR. (A .GT. C)) THEN
 IF (B .LT. C) THEN
 Aux = B
 B = A
 A = Aux
 ELSE
 Aux = C
 C = A
 A = Aux
 ENDIF
 ENDIF
 IF (B .GT. C) THEN
 Aux = B
 B = C
 C = Aux
 ENDIF
 PRINT*
 PRINT*, 'Valores ordenados de forma crescente'
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 STOP
 END
 PROGRAM L1EXERC10
c Dado o nome e o salario bruto de um funcionario, calcular valor
c do desconto e o salario liquido do funcionario. Imprimir o nome,
c salario bruto, valor do desconto e o salario liquido. O calculo do
c valor do desconto sera feito conforme abaixo:
c se o salario bruto <= 500,00 estara isento do desconto
c caso contrario aplicar desconto de 10% sobre o salario bruto.
c valor_do_desconto = salario_bruto * %desc / 100.00
c salario_liquido = salario_bruto - valor_do_desconto
 REAL SalBr, Perc, ValDesc, Saliq
 CHARACTER Espaco*3, Nome*30
 PARAMETER (Espaco=' ')
 PRINT*, 'Digite nome do funcionario'
 READ*, Nome
 PRINT*
 PRINT*, 'Digite valor do salario'
 READ*, SalBr
 IF (SalBr .LE. 500.0) THEN
 Perc = 0
 ELSE
 PERC = 0.1
 ENDIF
 ValDesc= SalBr * Perc
 Saliq = SalBr - ValDesc
 PRINT*
 PRINT*
 PRINT*, 'Nome:', Nome, Espaco, 'Salario:', SalBr
 PRINT*, 'Desconto:', ValDesc, Espaco, 'Salario Liquido:', Saliq
 STOP
 END
 PROGRAM L1EXERC11
c Dado o nome e o salario bruto de um funcionario, calcular o valor
c do desconto e o salario liquido do funcionario. Imprimir o nome,
c salario bruto, valor do desconto e o salario liquido. O calculo do
c valor do desconto sera feito conforme abaixo:
c se o salario bruto <= 500,00 estara isento do desconto
c se o 500,00 < salario bruto <= 1000,00 aplicar desconto de 10%
c sobre o salario bruto
c se o 1000,00 < salario bruto <= 2000,00 aplicar desconto de 15%
c sobre o salario bruto
c caso contrario aplicar desconto de 20% sobre o salario bruto.
 REAL SalBr, Perc, ValDesc, Saliq
 CHARACTER Espaco*3, Nome*20
 PARAMETER (Espaco=' ')
 PRINT*, 'Digite nome do funcionario'
 PRINT*
 READ*, Nome
 PRINT*, 'Digite valor do salario'
 READ*, SalBr
 IF (SalBr .LE. 500.0) THEN
 Perc = 0
 ELSE
 IF (SalBr .LE. 1000.0) THEN
 Perc = 0.1
 ELSE
 IF (SalBr .LE. 2000.0) THEN
 Perc = 0.15
 ELSE
 PERC = 0.2
 ENDIF
 ENDIF
 ENDIF
 ValDesc= SalBr * Perc
 Saliq = SalBr - ValDesc
 PRINT*
 PRINT*, 'Nome:', Nome, Espaco, 'Salario:', SalBr
 PRINT*, ' Desconto:', ValDesc, Espaco, 'Salario Liquido:', Saliq
 STOP
 END
 PROGRAM L1EXERC12
cDado o nome, salário bruto e o estado civil de um funcionario,
c calcular valor do desconto e o salario liquido do funcionario.
c Imprimir nome, salario bruto, valor do desconto e o salario liquido.
c O calculo do valor do desconto sera feito conforme abaixo:
c se o funcionario for casado estara isento do desconto
c se for solteiro aplicar desconto de 10% sobre o salaário bruto
c se for viuvo desconto de 15% sobre o salario bruto
c caso contrario aplicar desconto de 20% sobre o salario bruto.
c estado civil sera assim representado:
c 0 - solteiro 1 - casado 2 - separado 3 - divorciado 4 - viuvo
 REAL SalBr, Perc, ValDesc, Saliq
 INTEGER EstCiv
 CHARACTER Espaco*3, Nome*20
 PARAMETER (Espaco=' ')
 PRINT*, 'Digite nome do funcionario'
 READ*, Nome
 PRINT*
 PRINT*, ' Digite opcao do estado civil do funcionario'
 PRINT*,' 0 - Solteiro'
 PRINT*,' 1 - Casado'
 PRINT*,' 2 - Separado'
 PRINT*,' 3 - Divorciado'
 PRINT*,' 4 - Viuvo'
 READ*, EstCiv
 PRINT*
 PRINT*, 'Digite valor do salario'
 READ*, SalBr
 IF (EstCiv .EQ. 1) THEN
 Perc = 0
 ELSE
 IF (EstCiv .EQ. 0) THEN
 Perc = 0.1
 ELSE
 IF (EstCiv .EQ. 4) THEN
 Perc = 0.15
 ELSE
 PERC = 0.2
 ENDIF
 ENDIF
 ENDIF
 ValDesc= SalBr * Perc
 Saliq = SalBr - ValDesc
 PRINT*
 PRINT*, 'Nome:', Nome, Espaco, 'Salario:', SalBr
 IF (EstCiv .EQ. 0) THEN
 PRINT*, ' Estado civil: Solteiro'
 ELSE
 IF (EstCiv .EQ. 1) THEN
 PRINT*, ' Estado civil: Casado'
 ELSE
 IF (EstCiv .EQ. 2) THEN
 PRINT*, ' Estado civil: Separado'
 ELSE
 IF (EstCiv .EQ. 3) THEN
 PRINT*, ' Estado civil: Divorciado'
 ELSE
 PRINT*, ' Estado civil: Viuvo'
 ENDIF
 ENDIF
 ENDIF
 ENDIF
 PRINT*, ' Desconto:', ValDesc, Espaco, 'Salario Liquido:', Saliq
 STOP
 END
 PROGRAM L1EXERC13
c Dado o nome, salário bruto e o estado civil de um funcionario,
c calcular valor do desconto e o salario liquido do funcionario.
c Imprimir nome, salario bruto, valor do desconto e o salario liquido.
c O calculo do valor do desconto sera feito conforme abaixo:
c se o funcionario for casado estara isento do desconto caso o salario<=500,0
c senao aplicar desconto de 8% sobre o salario bruto
c se for solteiro aplicar desconto de 10% sobre o salario bruto
c se for viuvo desconto de 10% sobre o salario bruto se o salario <= 800,0,
c senao aplicar desconto de 15% sobre o salario bruto
c se for separado ou divorciado aplicar desconto de 15% sobre o salario
c bruto se salario <= 700,00, senao aplicar desconto de 20% sobre o salario bruto.
c 0 - solteiro 1 - casado 2 - separado 3 - divorciado 4 - viuvo
 REAL SalBr, Perc, ValDesc, Saliq
 INTEGER EstCiv
 CHARACTER Espaco*3, Nome*20
 PARAMETER (Espaco=' ')
 PRINT*, 'Digite nome do funcionario'
 READ*, Nome
 PRINT*
 PRINT*, ' Digite opcao do estado civil do funcionario'
 PRINT*,' 0 - Solteiro'
 PRINT*,' 1 - Casado'
 PRINT*,' 2 - Separado'
 PRINT*,' 3 - Divorciado'
 PRINT*,' 4 - Viuvo'
 READ*, EstCiv
 PRINT*
 PRINT*, 'Digite valor do salario'
 READ*, SalBr
 IF (EstCiv .EQ. 1) THEN
 IF (SalBr .LE. 500.0) THEN
 Perc = 0
 ELSE
 Perc = 0.08
 ENDIF
 ELSE
 IF (EstCiv .EQ. 0) THEN
 Perc = 0.1
 ELSE
 IF (EstCiv .EQ. 4) THEN
 IF (SalBr .LE. 800.0) THEN
 Perc = 0.1
 ELSE
 Perc = 0.15
 ENDIF
 ELSE
 IF (SalBr .LE. 700.0) THEN
 Perc = 0.15
 ELSE
 Perc = 0.2
 ENDIF
 ENDIF
 ENDIF
 ENDIF
 ValDesc= SalBr * Perc
 Saliq = SalBr - ValDesc
 PRINT*
 PRINT*, ' Nome:', Nome, Espaco, 'Salario:', SalBr
 IF (EstCiv .EQ. 0) THEN
 PRINT*, ' Estado civil: Solteiro'
 ELSE
 IF (EstCiv .EQ. 1) THEN
 PRINT*, ' Estado civil: Casado'
 ELSE
 IF (EstCiv .EQ. 2) THEN
 PRINT*, ' Estado civil: Separado'
 ELSE
 IF (EstCiv .EQ. 3) THEN
 PRINT*, ' Estado civil: Divorciado'
 ELSE
 PRINT*, ' Estado civil: Viuvo'
 ENDIF
 ENDIF
 ENDIF
 ENDIF
 PRINT*, ' Desconto:', ValDesc, Espaco, 'Salario Liquido:', Saliq
 STOP
 END
Exercícios de Repetições
 Comando DO
 PROGRAM L2EXERC1
c Ler e imprimir 5 valores reais. Calcular e imprimir a
c media aritmetica dos valores lidos.
 REAL Media, Valor, Soma
 INTEGER I
 CHARACTER Espaco*3
 PARAMETER (Espaco=' ')
 Soma = 0
 DO I = 1,5
 PRINT*, 'Digite valor ', I
 READ*, Valor
 Soma = Soma + Valor
 ENDDO
 Media = Soma/5
 PRINT*
 PRINT*, 'Media aritmetica dos valores lidos: ', Media
 STOP
 END
 PROGRAM L2EXERC2
c Ler e imprimir N valores reais. Calcular e imprimir a
c media aritmetica dos valores lidos.
 REAL Media, Valor, Soma
 INTEGER I, N
 PRINT*, 'Digite numero de valores para obtencao da media.'
 READ*, N
 PRINT*
 Soma = 0
 DO I = 1, N
 PRINT*, 'Digite valor ', I
 READ*, Valor
 PRINT*, Valor, 'Valor ', I, ' em ', N
 Soma = Soma + Valor
 ENDDO
 Media = Soma/N
 PRINT*
 PRINT*, 'Media aritmetica dos ', N, ' valores lidos: ', Media
 STOP
 END
 PROGRAM L2EXERC3
c Ler 10 valores inteiros. Imprimir, com mensagem, os valores que
c estao no intervalo entre 1 e 15 , e os valores que estao
c fora do intervalo.
 INTEGER I, Valor
 DO I = 1, 10
 PRINT*, 'Digite valor ', I
 READ*, Valor
 IF ((Valor .GE. 1) .AND. (Valor .LE. 15)) THEN
 PRINT*, Valor, ' esta no intervalo'
 ELSE
 PRINT*, Valor, ' nao esta no intervalo'
 ENDIF
 PRINT*
 ENDDO
 STOP
 END
 PROGRAM L2EXERC4
c Ler N valores inteiros. Imprimir, com mensagem, os valores que
c estao no intervalo entre 1 e 15 , e os valores que estao fora
c do intervalo. Contar quantos valores foram impressos dentro do
c intervalo e quantos foram impressos fora do intervalo.
c No fim imprimir os contadores.
 INTEGER I, Valor, N, Fora
 PRINT*, 'Digite numero de valores para obtencao da media.'
 READ*, N
 PRINT*
 Fora = 0
 DO I = 1, N
 PRINT*, 'Digite valor ', I, ' em ', N
 READ*, Valor
 IF ((Valor .GE. 1) .AND. (Valor .LE. 15)) THEN
 PRINT*, Valor, ' esta no intervalo'
 ELSE
 PRINT*, Valor, ' nao esta no intervalo'
 Fora = Fora + 1
 ENDIF
 PRINT*
 ENDDO
 PRINT*, N - Fora, ' valores lidos no intervalo'
 PRINT*, Fora, ' valores lidos fora do intervalo'
 STOP
 END
 PROGRAM L2EXERC5
c Ler N valores inteiros. Imprimir, commensagem, os valores lidos
c que sao pares , e os valores que nao sao pares. Contar quantos
c valores pares foram impressos e quantos impares tambem.
c No fim imprimir os contadores.
 INTEGER I, Valor, N, Pares, Impares
 PRINT*, 'Digite numero de valores para processar.'
 READ*, N
 PRINT*
 Pares = 0
 Impares = 0
 DO I = 1, N
 PRINT*, 'Digite valor ', I, ' em ', N
 READ*, Valor
 IF (MOD(Valor,2) .EQ. 0) THEN
 PRINT*, Valor, ' e numero par'
 Pares = Pares + 1
 ELSE
 PRINT*, Valor, ' e numero impar'
 Impares = Impares + 1
 ENDIF
 PRINT*
 ENDDO
 PRINT*, Pares, ' valores pares lidos'
 PRINT*, Impares, ' valores impares lidos'
 STOP
 END
 PROGRAM L2EXERC6
c Ler e imprimir K coeficientes de equações do segundo grau.
c Para cada equacao imprima os coeficientes e as raizes reais,
c se houverem. Caso nao haja imprimir mensagem. No fim
c imprimir o numero de equacoes que nao tiveram raizes reais.
 REAL A, B, C, Delta, X1, X2
 INTEGER K, I, SemRaiz
 PRINT*, 'Digite numero de equacoes para processar.'
 READ*, K
 SemRaiz = 0
 DO I = 1, K
 PRINT*
 PRINT*, 'Digite coeficientes da equacao ', I, ' em ', K
 READ*, A, B, C
 PRINT*, 'A=', A, ' B= ',B, 'C= ', C
 Delta = B**2 - 4*A*C
 IF (Delta .GE. 0) THEN
 X1 = (-B + SQRT(Delta))/(2*A)
 X2 = (-B - SQRT(Delta))/(2*A)
 PRINT*, 'X1=', X1, ' X2= ', X2
 ELSE
 PRINT*, 'Nao ha raizes reais para os coeficientes'
 SemRaiz = SemRaiz + 1
 ENDIF
 PRINT*
 ENDDO
 IF (SemRaiz .EQ. 0) THEN
 PRINT*, 'Todas equacoes tiveram raizes reais'
 ELSE
 PRINT*, 'Total de equacoes sem raizes reais: ', SemRaiz
 ENDIF
 STOP
 END
 PROGRAM L2EXERC7
c Ler e imprimir o nome, salario bruto de N funcionarios.
c Calcular o desconto e o salario liquido de todos os funcionarios.
c O desconto sera calculado da seguinte maneira:
c salario bruto <= 100,00 isento
c 100,00 < salario bruto <= 200,00 10%
c 200,00 < salario bruto <= 400,00 20%
c salario bruto > 400,00 25%
c Imprimir : nome, salario bruto, desconto e salario liquido de
c cada funcionario. No fim imprimir total de salario bruto,
c total dos descontos e total do salario liquido. Imprimir tambem
c o numero de funcionarios que nao tiveram desconto e o numero de
c funcionarios que tiveram desconto.
 INTEGER N, I, NFDesc, NFSDesc
 REAL SalBr, Perc, ValDesc, Saliq, TotSB, TotDesc, TotSLiq
 CHARACTER Espaco*3, Nome*20
 PARAMETER (Espaco=' ')
 DATA TotSB, TotDesc, TotSLiq /3*0.0/, NFDesc, NFSDesc/2*0/
 
 PRINT*, 'Digite numero de funcionarios.'
 READ*, N
 DO I = 1, N
 PRINT*
 PRINT*, 'Digite nome do funcionario'
 READ*, Nome
 PRINT*, 'Digite valor do salario'
 READ*, SalBr
 IF (SalBr .LE. 100.0) THEN
 NFSDesc = NFSDesc + 1
 Perc = 0
 ELSE
 NFDesc = NFDesc + 1
 IF (SalBr .LE. 200.0) THEN
 Perc = 0.1
 ELSE
 IF (SalBr .LE. 400.0) THEN
 Perc = 0.2
 ELSE
 PERC = 0.25
 ENDIF
 ENDIF
 ENDIF
 ValDesc= SalBr * Perc
 Saliq = SalBr - ValDesc
 PRINT*
 PRINT*, ' Nome:', Nome, Espaco, 'Salario:', SalBr
 PRINT*, ' Desconto:', ValDesc, Espaco, 'Salario Liquido:', Saliq
 TotSB = TotSB + SalBr
 TotDesc = TotDesc + ValDesc
 TotSLiq = TotSLiq + Saliq
 ENDDO
 PRINT*
 PRINT*, ' Total dos Salarios:', TotSB
 PRINT*, ' Total dos Descontos:', TotDesc
 PRINT*, ' Total Salarioss Liquidos:', TotSLiq
 STOP
 END
 PROGRAM L2EXERC8
c Dados A1, R e N gerar e imprimir uma PA com N termos.
 INTEGER A1, N, Razao, Prox, I
 PRINT*, 'Digite o primeiro termo, razao e num. de termos da PA.'
 READ*, A1, Razao, N
 PRINT*
 PRINT*, 'Razao: ', Razao, ' Num. Termos:', N
 PRINT*
 PRINT*, 'PA gerada:'
 PRINT*, ' ', A1
 Prox = A1
 DO I = 2, N
 Prox = Prox + Razao
 PRINT*, ' ', Prox
 ENDDO
 STOP
 END
 PROGRAM L2EXERC9
c Gerar e imprimir a serie de Fibonacci com K termos.
 INTEGER A, B, Prox, K, I
 PRINT*, 'Digite o num. de termos da serie de Fibonacci.'
 READ*, K
 PRINT*
 PRINT*, ' Num. Termos:', K
 PRINT*
 A = 0
 B = 1
 PRINT*, 'Serie de Fibonacci gerada:'
 PRINT*, ' ', A
 PRINT*, ' ', B
 DO I = 3, K
 Prox = A + B
 PRINT*, ' ', Prox
 A = B
 B = Prox
 ENDDO
 STOP	
 END
 PROGRAM L2EXERC10
c Dados dois inteiros A e B calcular e imprimir C=A*B,
c onde A*B devera ser obtido por somas sucessivas.
 INTEGER A, B, C, I
 PRINT*, 'Digite valores para A e B.'
 READ*, A, B
 PRINT*
 PRINT*, 'A= ', A, ' B=', B
 PRINT*
 C = 0
 DO I = 1, A
 C = C + B
 ENDDO
 PRINT*, 'Produto por somas sucessivas de A * B= ', C
 STOP
 END
 PROGRAM L2EXERC11
c Ler e imprimir um inteiro N. Calcular e imprimir a serie :
c Serie = 1/N + 2/(N-1) + 3/(N-2) + ........ + (N-1)/2 + N
 REAL Soma
 INTEGER I, N
 PRINT*, 'Digite numero de valores para obtencao da serie.'
 READ*, N
 PRINT*
 Soma = 0
 DO I = 1, N
 Soma = Soma + FLOAT(I)/FLOAT(N - I + 1)
 ENDDO
 PRINT*
 PRINT*, 'Somatorio dos elementos da serie para N=', N
 PRINT*, 'Soma=', Soma
 STOP
 END
 PROGRAM L2EXERC12
c Para cada inteiro entre L e M, lidos, imprimir o inteiro que seja
c um numero perfeito. Um numero e perfeito se ele e igual a soma de
c seus divisores - nao considerando o proprio.
 INTEGER L, M, Num , Soma, Metade, Div
 PRINT*, 'Digite valores inicial e final do intervalo.'
 READ*, L, M
 PRINT*
 Soma = 0
 DO Num = L, M
 Metade = Num/2
 Soma = 0
 DO Div = 1, Metade
 IF (MOD(Num,Div) .EQ. 0) THEN
 Soma = Soma + Div
 ENDIF
 ENDDO
 IF (Soma .EQ. Num) THEN
 PRINT*, Num, ' e numero perfeito'
 ENDIF
 ENDDO
 STOP
 END
 PROGRAM L2EXERC13
c Ler e imprimir um inteiro P. Calcular e imprimir fatorial de P.
 INTEGER I, P, Fat
 PRINT*, 'Digite valor para calculo do fatorial.'
 READ*, P
 PRINT*
 Fat = 1
 DO I = 2, P
 Fat = Fat * I
 ENDDO
 PRINT*, 'Fatorial de P=', P, ' e igual a:', Fat
 STOP
 END
 PROGRAM L2EXERC14
c Para 1<=i<=n, i+1<=j<=n+1 e j<=k<=n+i calcular S = somatorio(i*k+j)
c se i*k+j < N + 3. No fim imprimir o valor de S.
 INTEGER I, J, K, N, Soma
 PRINT*, 'Digite valor para calculo do somatorio.'
 READ*, N
 PRINT*
 Soma = 0
 DO I = 1, N
 DO J = I+1, N+1
 DO K = J, N+I
 IF (I*K+J .LT. N+3) THEN
 SOMA = SOMA + (I *K + J)
 ENDIF
 ENDDO
 ENDDO
 ENDDO
 PRINT*, 'Somatorio para N=', N, ' e igual a:', Soma
 STOP
 END
 PROGRAM L2EXERC15
c Ler e imprimir N valores reais. Imprimir o maior valor lido.
 INTEGER I, N
 REAL Valor, Maior
 PRINT*, 'Digite numero de valores para processar.'
 READ*, N
 PRINT*
 PRINT*, 'Digite primeiro valor.'
 READ*, Valor
 PRINT*
 PRINT*, 'Valor 1=', Valor
 Maior = Valor
 DO I = 2, N
 PRINT*, 'Digite proximo valor.'
 READ*, Valor
 PRINT*
 PRINT*, 'Valor ', I, '=', Valor
 IF (Valor .GT. Maior) THEN
 Maior = Valor
 ENDIF
 ENDDO
 PRINT*
 PRINT*, 'Maior valor lido foi:', Maior
 STOP
 END
 PROGRAM L2EXERC16
c Ler e imprimir N valores reais. Imprimir o maior e o menor valor lido.
 INTEGER I, N
 REAL Valor, Maior, Menor
 PRINT*, 'Digite numero de valores para processar.'
 READ*, N
 PRINT*
 PRINT*, 'Digite primeiro valor.'
 READ*, Valor
 PRINT*
 PRINT*, 'Valor 1=', Valor
 Maior = Valor
 Menor = Valor
 DO I = 2, N
 PRINT*
 PRINT*, 'Digite proximo valor.'
 READ*, Valor
 PRINT*
 PRINT*, 'Valor ', I, '=', Valor
 IF (Valor .GT. Maior) THEN
 Maior = Valor
 ELSE
 IF (Valor .LT. Menor) THEN
 Menor = valor
 ENDIF
 ENDIF
 ENDDO
 PRINT*
 PRINT*, 'Maior valor lido foi:', Maior
 PRINT*
 PRINT*, 'Menor valor lido foi:', Menor
 STOP
 END
 PROGRAM L2EXERC17
c Ler e imprimir valores reais que representem a altura de K pessoas.
c Imprimir quais as duas maiores alturas lidas e o numero de pessoas que as possuem.
 REAL Altura, Maior1, Maior2
 INTEGER I, K, NumP1, NumP2
 PRINT*, 'Digite numero de pessoas para processar.'
 READ*, K
 PRINT*
 PRINT*, 'Digite primeira altura.'
 READ*, Altura
 PRINT*
 PRINT*, 'Altura 1=', Altura
 Maior1 = Altura
 NumP1 = 1
 Maior2 = Altura
 NumP2 = 1
 DO I = 2, K
 PRINT*
 PRINT*, 'Digite proxima altura.'
 READ*, Altura
 PRINT*
 PRINT*, 'Altura ', I, '=', Altura
 IF (Altura .GT. Maior1) THEN
 Maior2 = Maior1
 NumP2 = NumP1
 Maior1 = Altura
 NumP1 = 1
 ELSE
 IF (Altura .EQ. Maior1) THEN
 NumP1 = NumP1 + 1
 ELSE
 IF (Altura .GT. Maior2) THEN
 Maior2 = Altura
 NumP2 = 1
 ELSE
 IF (Altura .EQ. Maior2) THEN
 NumP2 = NumP2 + 1
 ENDIF
 ENDIF
 ENDIF
 ENDIF
 ENDDO
 PRINT*
 PRINT*, 'Numero de pessoas:', K
 PRINT*
 PRINT*, 'Primeira maior altura:', Maior1
 PRINT*, 'Numero de pessoas com maior altura:', NumP1
 PRINT*
 PRINT*, 'Segunda maior altura:', Maior2
 PRINT*, 'Numero de pessoas com segunda maior altura:', NumP2
 STOP
 END
 PROGRAM L2EXERC18
c Ler o sexo ( 0 : masculino ; 1 : feminino) e a altura de M pessoas.
c Imprimir a maior e a menor altura; a media da altura das mulheres;
c a menor altura dos homens; o numero total de homens que foram lidos.
 INTEGER I, M, Sexo, TotH, TotF
 REAL Altura, Maior, Menor, MdAltF, MenorH, Soma
 PRINT*, 'Digite numero de pessoas para processar.'
 READ*, M
 Maior = 0.0
 Menor = 3.0
 MenorH = 3.0
 Soma = 0
 TotH = 0
 TotF = 0
 DO I = 1, M
 PRINT*
 PRINT*, 'Digite altura e sexo (0-Masc e 1-Fem).'
 READ*, Altura, Sexo
 PRINT*
 IF (Altura .GT. Maior) THEN
 Maior = Altura
 ELSE
 IF (Altura .LT. Menor) THEN
 Menor = Altura
 ENDIF
 ENDIF
 IF (Sexo .EQ. 0) THEN
 TotH = TotH + 1
 IF (Altura .LT. MenorH) THEN
 MenorH = Altura
 ENDIF
 ELSE
 TotF = TotF + 1
 Soma = Soma + Altura
 ENDIF
 ENDDO
 IF (TotF .NE. 0) THEN
 Media = Soma/TotF
 ENDIF
 PRINT*
 PRINT*, 'Numero de pessoas:', M
 PRINT*
 PRINT*, 'Maior altura:', Maior
 PRINT*, 'Menor altura:', Menor
 PRINT*
 PRINT*, 'Total de homens:', TotH
 PRINT*
 PRINT*, 'Menor altura entre os homens:', MenorH
 PRINT*
 PRINT*, 'Total de mulheres:', TotF
 PRINT*
 PRINT*, 'Media das alturas das mulheres:', Media
 STOP
 END
 PROGRAM L2EXERC19
c Considere uma pesquisa realizada com pessoas com idade entre 25 e 80 anos de idade,
c de uma regiao do pais. Para a pesquisa foram consideradas as seguintes informacoes
c para cada pessoa : sexo, idade, nivel de instrucao e se a pessoa tem ou nao emprego.
c Escreva um programa para :
c Ler o sexo, a idade, o nivel de instrucao e a situacao do emprego de N pessoas.
c Para efetuar a leitura dos dados vamos considerar :
c Sexo : 0 - masculino 1 - feminino
c Idade : inteiro entre 25 e 80
c Nivel de instrucao : 0 - analfabeto 1 - primeiro grau 2 - segundo grau
c 3 - superior 4 - pos graduacao
c Emprego : 0 - nao 1 - sim
c Imprimir as informacoes lidas, e imprimir os seguintes resultados da pesquisa :
c a) o numero de pessoas analfabetas do sexo feminino com idade inferior a 50 anos;
c b) numero de pessoas com primeiro grau com idade entre 25 e 35 anos e sem emprego;
c c) o numero de pessoas do sexo masculino que tem emprego e estao no segundo grau;
c d) o numero de pessoas do sexo feminino com idade superior a 40 anos, que tem
c curso superior e estao desempregadas;
c e) o numero de pessoas do sexo masculino com idade superior a 35 anos, estao
c trabalhando e tem pos graduacao;
c f) o numero total de pessoas do sexo masculino e total de pessoas do sexo feminino
c que foram pesquisadas;
c g) o total de pessoas pesquisadas pelo nivel de instrucao.
 INTEGER I, N, Sexo, Idade, NivIns, Emp, TotA, TotB, TotC, TotD,
 * TotE, TotFH, TotFM, TotG0, TotG1, TotG2, TotG3, TotG4
 DATA TotA, TotB, TotC, TotD, TotE, TotFH, TotFM, TotG0, TotG1,
 * TotG2, TotG3, TotG4/12*0/
 PRINT*, 'Digite numero de pessoas para processar.'
 READ*, N
 DO I = 1, N
 PRINT*
 PRINT*, 'Digite sexo (0-Masc e 1-Fem).'
 READ*, Sexo
 PRINT*, 'Digite idade.'
 READ*, Idade
 PRINT*,'Digite escolaridade(0-Ana 1-PG 2-SG 3-Grad 4-PGrad).'
 READ*, NivEsc
 PRINT*, 'Digite situacao de emprego (0-Nao e 1-Sim).'
 READ*, Emp
 PRINT*
c total de pessoas pesquisadas pelo nivel de instrucao(G).
 IF (NivEsc .EQ. 0) THEN
 TotG1 = TotG1 + 1
 ELSE
 IF (NivEsc .EQ. 1) THEN
 TotG2 = TotG2 + 1
 ELSE
 IF (NivEsc .EQ. 2) THEN
 TotG3 = TotG3 + 1
 ELSE
 IF (NivEsc .EQ. 3) THEN
 TotG4 = TotG4 + 1
 ELSETotG5 = TotG5 + 1
 ENDIF
 ENDIF
 ENDIF
 ENDIF
c numero de pessoas com primeiro grau com idade
c entre 25 e 35 anos e sem emprego (B)
 IF ((NivIns .EQ. 1) .AND. ((Idade .GE. 25) .AND.
 * (Idade .LE. 35)) .AND. (Emp .EQ. 0)) THEN
 TotB = TotB + 1
 ENDIF
 IF (Sexo .EQ. 0) THEN
c pessoas pesquisadas sexo masculino
 TotFH = TotFH + 1
 IF (Emp .EQ. 1) THEN
 IF (NivEsc .EQ. 2) THEN
 TotC = TotC + 1
 ELSE
 IF ((NivEsc .EQ. 4) .AND. (Idade .GT.35)) THEN
 TotE = TotE + 1
 ENDIF
 ENDIF
 ENDIF
 ELSE
c pessoas pesquisadas sexo femenino
 TotFM = TotFM + 1
c o numero de pessoas analfabetas do sexo feminino com idade
c inferior a 50 anos (A)
 IF ((NivEsc .EQ. 0) .AND. (Idade .LT. 50)) THEN
 TotA = TotA + 1
 ELSE
c numero de pessoas do sexo feminino com idade superior a 40
c anos, que tem curso superior e estao desempregadas (D)
 IF ((Idade .GT. 40) .AND. (NivIns .EQ. 3) .AND.
 * (Emp .EQ. 0)) THEN
 TotD = TotD + 1
 ENDIF
 ENDIF
 ENDIF
 ENDDO
 PRINT*
 PRINT*, 'Numero de pessoas:', N
 PRINT*
 PRINT*, 'Pessoas analfabetas sexo fem idade inf 50 anos:',TotA
 PRINT*
 PRINT*, 'Pessoas prim grau idade 25/35 anos sem emprego:', TotB
 PRINT*
 PRINT*, 'Pessoas sexo masculino empregado e segundo grau:', TotC
 PRINT*
 PRINT*, 'Sexo feminino idade sup 40,cur sup e desemp:', TotD
 PRINT*
 PRINT*, 'Sexo masculino idade sup 35 anos, trab e pgrad:', TotE
 PRINT*
 PRINT*, 'Total de homens:', TotFH
 PRINT*
 PRINT*, 'Total de mulheres:', TotFM
 PRINT*
 PRINT*, 'Total de analfabetos:', TotG1
 PRINT*, 'Total de prim Grau:', TotG2
 PRINT*, 'Total de seg Grau:', TotG3
 PRINT*, 'Total de graduados:', TotG4
 PRINT*, 'Total de pos graduados:', TotG5
 STOP
 END
 Comando WHILE
 PROGRAM L3EXERC1
c Ler e imprimir valores reais. Calcular e imprimir a media aritmetica
c dos valores lidos. A entrada termina quando for lido o valor -88 .
 REAL Media, Valor, Soma
 INTEGER NumVal, Flag
 PARAMETER(Flag = -88)
 Soma = 0
 NumVal = 0
 PRINT*, 'Digite valor 1'
 READ*, Valor
 DO WHILE (Valor .NE. Flag)
 NumVal = NumVal + 1
 PRINT*
 PRINT*, 'Valor ', NumVal, ' lido:', Valor
 Soma = Soma + Valor
 PRINT*
 PRINT*, 'Digite proximo valor'
 READ*, Valor
 ENDDO
 Media = Soma/NumVal
 PRINT*
 PRINT*, 'Media aritmetica dos ',NumVal,' valores lidos: ', Media
 STOP
 END
 PROGRAM L3EXERC2
c Ler valores inteiros. Imprimir,com mensagem, os valores lidos que
c sao pares , e os valores que nao sao pares. A entrada termina com
c a leitura do valor -1. Contar quantos valores pares foram impressos
c e quantos impares tambem. No fim imprimir os contadores.
 INTEGER Valor, Pares, Impares, Flag
 PARAMETER(Flag = -1)
 PRINT*, 'Digite valor 1'
 READ*, Valor
 Pares = 0
 Impares = 0
 DO WHILE (Valor .NE. Flag)
 PRINT*
 IF (MOD(Valor,2) .EQ. 0) THEN
 PRINT*, Valor, ' e numero par'
 Pares = Pares + 1
 ELSE
 PRINT*, Valor, ' e numero impar'
 Impares = Impares + 1
 ENDIF
 PRINT*
 PRINT*, 'Digite proximo valor'
 READ*, Valor
 ENDDO
 PRINT*
 PRINT*, Pares, ' valor(es) par(es) lido(s)'
 PRINT*, Impares, ' valor(es) impar(es) lido(s)'
 STOP
 END
 PROGRAM L3EXERC3
c Ler os coeficientes de equacoes do segundo grau (A,B,C).
c Para cada equacao imprima os coeficientes e as raizes reais, se houverem.
c Caso nao haja imprimir mensagem. No fim imprimir o numero de
c equacoes que nao tiveram raizes reais. A entrada termina
c quando for lido o valor 0(zero) para o coeficiente A.
 REAL A, B, C, X1, X2, Delta
 INTEGER SemRaiz
 SemRaiz = 0
 PRINT*, 'Digite coeficientes - A, B, C - da primeira equacao.'
 READ*, A, B, C
 DO WHILE (A .NE. 0)
 PRINT*
 PRINT*, 'A=', A, ' B=', B, ' C=', C
 PRINT*
 Delta = B**2 - 4*A*C
 IF (Delta .GE. 0) THEN
 X1 = (-B + SQRT(Delta))/(2*A)
 X2 = (-B - SQRT(Delta))/(2*A)
 PRINT*, 'X1=', X1, ' X2=', X2
 ELSE
 PRINT*, 'Para coeficientes lidos nao ha raizes reais.'
 SemRaiz = SemRaiz + 1
 ENDIF
 PRINT*
 PRINT*,'A, B, C da proxima equacao (0 para A encerra).'
 READ*, A, B, C
 ENDDO
 PRINT*
 PRINT*, 'Total de equacoes sem raizes reais:', SemRaiz
 STOP
 END
 PROGRAM L3EXERC4
c Dados A1 e R gerar e imprimir uma PA cujo ultimo termo seja menor
c do que 200. Imprimir no fim o numero de termos da PA.
 INTEGER A1, NTermos, Razao, Prox
 PRINT*, 'Digite o primeiro termo e a razao da PA.'
 READ*, A1, Razao
 PRINT*
 NTermos = 0
 Prox = A1
 DO WHILE (Prox .LT. 200)
 PRINT*, ' ', Prox
 NTermos = NTermos + 1
 Prox = Prox + Razao
 ENDDO
 PRINT*
 PRINT*, ' Razao: ', Razao, ' Num. Termos:', NTermos
 STOP
 END
 PROGRAM L3EXERC5
c Dados dois inteiros A e B, positivos e nao nulos, calcular A/B,
c onde A/B devera ser obtido por subtracoes sucessivas.
c No fim imprimir, A, B, o quociente e o resto da divisao.
 INTEGER A, B, Quoc, Resto
 PRINT*, 'Digite valores para A e B.'
 READ*, A, B
 Quoc = 0
 Resto = A
 DO WHILE (Resto .GE. B)
 Resto = Resto - B
 Quoc = Quoc + 1
 ENDDO
 PRINT*
 PRINT*, ' Dividendo: ', A, ' Divisor:', B
 PRINT*, ' Quociente: ', Quoc, ' Resto:', Resto
 STOP
 END
 PROGRAM L3EXERC6
c Para cada inteiro entre Inicio e Fim, lidos, imprimir o inteiro
c que seja um numero primo.
 INTEGER Num, Div, Metade, Inicio, Fim
 Logical Primo
 PRINT*, 'Digite limites do intervalo.'
 READ*, Inicio, Fim
 DO Num = Inicio, Fim
 Div = 2
 Metade = Num/2
 Primo = .TRUE.
 DO WHILE ( ( Div .LE. Metade) .AND. (Primo) )
 IF (MOD(Num, Div) .EQ. 0) THEN
 Primo = .FALSE.
 ELSE
 Div = Div + 1
 ENDIF
 ENDDO
 IF (Primo) THEN
 PRINT*
 PRINT*, Num, ' e numero primo.'
 ENDIF
 ENDDO
 END
 PROGRAM L3EXERC7
c Gerar e imprimir a serie de Fibonacci cujo ultimo termo seja
c menor do que Ultimo.
 INTEGER Ultimo, Prox, A, B
 PRINT*, 'Digite o valor limite da serie de Fibonacci (>2).'
 READ*, Ultimo
 PRINT*
 A = 0
 B = 1
 PRINT*, ' ', A
 PRINT*, ' ', B
 Prox = A + B
 DO WHILE (Prox .LT. Ultimo)
 PRINT*, ' ', Prox
 A = B
 B = Prox
 Prox = A + B
 ENDDO
 STOP
 END
 PROGRAM L3EXERC8
c Para inteiros variando de Inicio a Fim,imprimir os inteiros que
c sao iguais a soma dos cubos de seus digitos.ex:153 =1**3+5**3+3**3
 INTEGER Num, Inicio, Fim, Soma, Valor
 PRINT*, 'Digite limites do intervalo.'
 READ*, Inicio, Fim
 DO Num = Inicio, Fim
 Soma = 0
 Valor = Num
 DO WHILE ( Valor .GE. 10 )
 Soma = Soma + MOD(Valor,10)**3
 Valor = Valor/10
 ENDDO
 Soma = Soma + Valor**3
 IF (Soma .EQ. Num) THEN
 PRINT*
 PRINT*, Num, ' satisfaz a propriedade estabelecida.'
 ENDIF
 ENDDO
 END
 
 PROGRAM L3EXERC9
c Ler e imprimir valores inteiros. A leitura termina com a leitura
c do valor -1. No fim imprimir, com mensagem, o maior valor lido.
 INTEGER Valor, Maior, Flag
 PARAMETER(Flag = -1)
 PRINT*, 'Digite primeiro valor.'
 READ*, Valor
 Maior = Valor
 DO WHILE (Valor .NE. Flag)
 PRINT*
 PRINT*, 'Valor lido:', Valor
 IF (Valor .GT. Maior) THEN
 Maior = Valor
 ENDIF
 PRINT*
 PRINT*, 'Digite proximo valor (-1 encerra).'
 READ*, Valor
 ENDDO
 PRINT*
 PRINT*, 'Maior valor lido foi:', Maior
 STOP
 END
Exercícios de Agregados Homogêneos
 PROGRAM L4EXERC1
c Ler e imprimir um conjunto com N elementos inteiros.
c Imprimir o maior elemento do conjunto. Imprimir tambem a posição.
 INTEGER N, ConjInt(50), MaxElem, Posicao, I
 PARAMETER (MaxElem=50)
 
c sera lido o num de elementos do conjunto
 PRINT*, ‘Digite numero de elementos do conjunto (Max:50)’
 READ*, N
 IF (N .GT. MaxElem) THEN
 PRINT*,'Numero maximo de elementos previsto: ',MaxElem
 STOP
 ENDIF
 PRINT*
 PRINT*, ‘Digite N elementos para o conjunto.’
 READ*, (ConjInt(I), I = 1, N)
 PRINT*, ' Elementos do conjunto lidos apos digitacao.'
 WRITE(*,30) (ConjInt(I), I = 1, N)
 30 FORMAT(50(I4,2X))
 Posicao = 1
 DO I = 2, N
 IF (ConjInt(I) .GT. ConjInt(Posicao)) THEN
 Posicao = I
 ENDIF
 ENDDO
 PRINT*
 PRINT*, 'Maior elemento:', ConjInt(Posicao)
 PRINT*, 'Posicao no conjunto:', Posicao
 STOP
 END
 PROGRAM L3EXERC2
c Ler e imprimir um conjunto com elementos reais.
c A leitura termina com o valor -1.Imprimir o menor elemento do
c conjunto, sua posicao e o numero de elementos processados.
 REAL ConjReal(20), ValorLido, Flag
 INTEGER NElem, I, Posicao
 PARAMETER(Flag = -1)
c Ler conjunto com valores inteiros ate valor lido for -1
 NElem = 0
 PRINT*, ‘Digite o primeiro valor do conjunto’.
 READ*, ValorLido
 DO WHILE (ValorLido .NE. Flag)
 NElem = NElem + 1
c Defender posicao considerada com respeito ao tamanho do conjunto (20)
 IF ( NElem .GT. 20) THEN
 PRINT*,'O numero de elementos deve ser <= a 20.
 * Programa sera encerrado.'
 STOP
 ENDIF
 ConjReal(NElem) = ValorLido
 PRINT*, ‘Digite proximo valor do conjunto’.
 READ*, ValorLido
 ENDDO
 PRINT*
 PRINT*, 'Numero de elementos do conjunto:', NElem
 PRINT*
c Imprimir conjunto com NElem valores
 WRITE(*,15) (ConjReal(I), I = 1, NElem)
 15 FORMAT( 20( F6.2, 2X ) )
 Posicao = 1
 DO I = 2, NElem
 IF (ConjReal(I) .LT. ConjReal(Posicao)) THEN
 Posicao = I
 ENDIF
 ENDDO
 PRINT*
 PRINT*, 'Menor elemento:', ConjReal(Posicao)
 PRINT*, 'Posicao no conjunto:', Posicao
 STOP
 END
 PROGRAM L4EXERC3
c Gerar e imprimir a serie de Fibonacci com K termos.
 INTEGER Fib(50), K, I, MaxElem
 PARAMETER(MaxElem = 50)
 PRINT*, ‘Digite o numero de elementos da serie.’
 READ*, K
 IF (K .GT. MaxElem) THEN
 PRINT*,'Numero maximo de elementos previsto: ',MaxElem
 STOP
 ENDIF
 PRINT*, 'Numero de elementos do conjunto:', K
 PRINT*
 Fib(1) = 0
 Fib(2) = 1
 DO I = 3, K
 Fib(I) = Fib(I-1) + Fib(I-2)
 ENDDO
 PRINT*, 'Serie de Fibonacci gerada:'
 WRITE(*,11)(Fib(I), I = 1, K)
 11 FORMAT(10(I5, 2X))
 STOP
 END
 PROGRAM L4EXERC4
c Gerar e imprimir a serie de Fibonacci cujo ultimo termo seja
c menor do que 100.
 INTEGER Fib(50), N, MaxElem, I
 PARAMETER( MaxElem = 50)
 Fib(1) = 0
 Fib(2) = 1
 N = 2
 DO WHILE (Fib(N) .LT. 100)
 N = N + 1
 IF (N .GT. MaxElem) THEN
 PRINT*,'Numeros maximo de elementos previsto: ',MaxElem
 STOP
 ENDIF
 Fib(N) = Fib(N-1) + Fib(N-2)
 ENDDO
c descartar ultima posicao que contera valor > ou = a 100 
 N = N - 1
 PRINT*, 'Serie de Fibonacci gerada:'
 WRITE(*,11)(Fib(I), I = 1, N)
 11 FORMAT(5(I3, 2X))
 STOP
 END
 PROGRAM L4EXERC5
c Ler e imprimir um conjunto de P valores inteiros. A seguir ler 5
c valores inteiros, um a um ,e imprimir com mensagem se o valor lido
c pertence ou nao ao conjunto.
 INTEGER P, Conj (20), I, J, ValorLido
 LOGICAL Pertence
 PRINT*, ‘Digite o numero de elementos do conjunto.(Max:20)’
 READ*, P
 IF ( P .GT. 20) THEN
 PRINT*, 'O numero de elementos deve ser menor ou igual a 20.'
 PRINT*, 'Programa sera encerrado.'
 STOP
 ENDIF
 PRINT*, 'Numero de elementos do conjunto:', P
 PRINT*
c Ler conjunto com P valores inteiros
 READ*, (Conj(I), I = 1, P)
 PRINT*, 'Conjunto lido apos digitação.'
 WRITE(*,12) (Conj(I), I = 1, P)
 12 FORMAT( 20( I4, 2X ) )
c ler 5 valores e verificar se ocorrem no conjunto
 DO J = 1, 5
 PRINT*, ‘Digite valor para verificar ocorrencia.’
 READ*, ValorLido
c verificar se valor ocorre no conjunto
 I = 1
 Pertence = .FALSE.
 DO WHILE ( (I .LE. P) .AND. (.NOT. Pertence) )
 IF (ValorLido .EQ. Conj(I)) THEN
 Pertence = .TRUE.
 ELSE
 I = I + 1
 ENDIF
 ENDDO
 PRINT*
 IF (Pertence) THEN
 PRINT*, ValorLido, ' pertence ao conjunto.'
 ELSE
 PRINT*, ValorLido, ' nao pertence ao conjunto.'
 ENDIF
 ENDDO
 STOP
 END
 PROGRAM L4EXERC6
c Dados dois conjuntos A e B com M e N elementos respect/,
c ordenados de forma crescente,gerar e imprimir um conjunto C,
c ordenado de forma crescente, que sera obtido intercalando-se
c os elementos de A com B sem repeticao de elementos.
 INTEGER A(20), B(20), C(40), M, N, K, I, J, MaxElem
 PARAMETER (MaxElem = 20)
 PRINT*, ‘Digite o numero de elementos dos conjuntos A e B (Max:20).’
 READ*, M, N
c Defender valores lidos com respeito ao tamanho do conjunto (20)
 IF ( (M .GT. MaxElem) .OR. (N .GT. MaxElem)) THEN
 PRINT*,'O numero de elementos deve ser menor ou igual a 20'
 PRINT*, 'Programa sera encerrado.'
 STOP
 ENDIF
 PRINT*, 'Numero de elementos do conjunto A:', M
 PRINT*
 PRINT*, 'Numero de elementos do conjunto B:', N
 PRINT*PRINT*, ‘Digite os ‘ , M, ‘ elementos do conjunto A.’
 READ*, (A(I), I = 1, M)
 PRINT*, ‘Digite os ‘ , N, ‘ elementos do conjunto B.’
 READ*, (B(I), I = 1, N)
 PRINT*, 'Conjunto A lido.'
 WRITE(*,12) (A(I), I = 1, M)
 PRINT*
 PRINT*, 'Conjunto B lido.'
 WRITE(*,12) (B(I), I = 1, N)
 12 FORMAT( 12( I4, 2X ) )
c gerar conjunto C intercalando elementos de A com B
 I = 1
 J = 1
 K = 0
 DO WHILE ((I .LE. M) .AND. (J .LE. N))
 K = K + 1
 IF (A(I) .EQ. B(J)) THEN
 C(K) = A(I)
 I = I + 1
 J = J + 1
 ELSE
 IF (A(I) .LT. B(J)) THEN
 C(K) = A(I)
 I = I + 1
 ELSE
 C(K) = B(J)
 J = J + 1
 ENDIF
 ENDIF
 ENDDO
 DO WHILE (I .LE. M)
 K = K + 1
 C(K) = A(I)
 I = I + 1
 ENDDO
 DO WHILE (J .LE. N)
 K = K + 1
 C(K) = B(J)
 J = J + 1
 ENDDO
 
 PRINT*
 PRINT*, 'Conjunto C gerado pela intercalacao de A com B.'
 WRITE(*,12) (C(I), I = 1, K)
 STOP
 END
 PROGRAM L4EXERC7
c Ler e imprimir um conjunto com W elementos reais. Ordenar os
c elementos do conjunto em ordem crescente e imprimir o conjunto ordenado.
 REAL Conj(20), Aux
 INTEGER W, Tam, I, MaxElem
 LOGICAL Ordenado
 PARAMETER(MaxElem = 20)
 PRINT*, ‘Digite o numero de elementos do conjunto (Max:20).’
 READ*, W
 IF (W .GT. MaxElem) THEN
 PRINT*,'Numeros maximo de elementos previsto: ',MaxElem
 STOP
 ENDIF
 PRINT*, 'Numero de elementos do conjunto:', W
 PRINT*
 PRINT*, ‘Digite os ‘ ,W, ‘ elementos do conjunto.’
 READ*, (Conj(I), I = 1, W)
 PRINT*, 'Conjunto lido.'
 WRITE(*,12)(Conj(I), I = 1, W)
 12 FORMAT(20(F6.2, 2X))
c Ordenar elementos do conjunto
 Tam = W
 Ordenado = .FALSE.
 DO WHILE ((Tam .GT. 1) .AND. (.NOT. Ordenado))
 Ordenado = .TRUE.
 DO I = 1, Tam-1
 IF ( Conj(I) .GT. Conj(I+1) ) THEN
 Aux = Conj(I)
 Conj(I) = Conj(I+1)
 Conj(I+1) = Aux
 Ordenado = .FALSE.
 ENDIF
 ENDDO
 Tam = Tam - 1
 ENDDO
c Imprimir conjunto ordenado
 PRINT*
 PRINT*, 'Conjunto ordenado de forma crescente'
 WRITE(*,12) (Conj(I), I = 1, W)
 CLOSE (7)
 STOP
 END
 Program L4EXERC8
c Ler e imprimir dois conjuntos ConjA e ConjB com M e N elementos respec.
c Gerar e imprimir os seguintes conjuntos:UNIAO=A U B INTER=A^B 
 DIFER = A - B .
 INTEGER ConjA(20), ConjB(20), AuniB(20), AinterB(20),AdifB(20),
 * NElemA, NElemB, NAuB, NAiB, NAdB, I, MaxElem
 LOGICAL Pertence
 PARAMETER( MaxElem = 20)
 DATA NAuB, NAiB, NAdB/3*0/
 PRINT*, ‘Digite o numero de elementos de ConjA e ConjB (Max:20).’
 READ*, NElemA, NElemB
c Defender valores lidos com respeito ao tamanho do conjunto (20)
 IF ( (NElemA .GT. MaxElem) .OR. (NElemB .GT. MaxElem)) THEN
 PRINT*,'O numero de elementos deve ser <= ', MaxElem
 PRINT*, 'Programa sera encerrado.'
 STOP
 ENDIF
 PRINT*, 'Numero de elementos do conjunto A:', NElemA
 PRINT*
 PRINT*, 'Numero de elementos do conjunto B:', NElemB
 PRINT*
 READ*, (ConjA(I), I = 1, NElemA)
 READ*, (ConjB(I), I = 1, NElemB)
 PRINT*, 'Conjunto A lido apos digitacao.'
 WRITE(*,20) (ConjA(I), I = 1, NElemA)
 PRINT*
 PRINT*, 'Conjunto B lido apos digitacao.'
 WRITE(*,5) (ConjB(I), I = 1, NElemB)
 5 FORMAT( 20( I4, 2X ) )
c uniao de conjuntos (ConjA, NElemA, ConjB, NElemC, AuniB,
c NAuB);
c ConjA esta contido na uniao
 DO I= 1, NElemA
 AuniB(I) = ConjA(I)
 ENDDO
 NAuB = NElemA
c elementos de ConjB que nao Pertencem a ConjA
 DO I = 1, NElemB
 Pertence = .FALSE.
 J = 1
 DO WHILE ((J .LE. NElemA) .AND. ( .NOT. Pertence))
 IF (ConjB(I) .EQ. ConjA(J)) THEN
 Pertence = .TRUE.
 ELSE
 J = J + 1
 ENDIF
 ENDDO
 IF (.NOT. Pertence) THEN
 NAuB = NAuB + 1
 AuniB(NAuB) = ConjB(I)
 ENDIF
 ENDDO
c intersecao de conjuntos (ConjA, NElemA, ConjB, NElemB,
c AinterB, NAiB)
 DO I = 1, NElemA
 Pertence = .FALSE.
 J = 1
 DO WHILE ((J .LE. NElemB) .AND. ( .NOT. Pertence))
 IF (ConjA(I) .EQ. ConjB(J)) THEN
 Pertence = .TRUE.
 ELSE
 J = J + 1
 ENDIF
 ENDDO
 IF (Pertence) THEN
 NAiB = NAiB + 1
 AinterB(NAiB) = ConjA(I)
 ENDIF
 ENDDO
c diferenca de conjuntos (ConjA, NElemA, ConjB, NElemB,
c AdifB, NAdB);
 DO I = 1, NElemA
 Pertence = .FALSE.
 J = 1
 DO WHILE ((J .LE. NElembB) .AND. ( .NOT. Pertence))
 IF (ConjA(I) .EQ. ConjB(J)) THEN
 Pertence = .TRUE.
 ELSE
 J = J + 1
 ENDIF
 ENDDO
 IF (.NOT. Pertence) THEN
 NAdB = NAdB + 1
 AdifB(NAdB) = ConjA(I)
 ENDIF
 ENDDO
c imprimir conjunto AuniB com NAuB elementos
 PRINT*
 PRINT*, 'Elementos do Conjunto AvB'
 WRITE(*,25) (AuniB(I), I = 1, NAuB)
c imprimir conjunto AinterB com NAiB elementos;
 PRINT*
 PRINT*, 'Elementos do Conjunto A inter B'
 WRITE(*,25) (AinterB(I), I = 1, NAiB)
c imprimir conjunto AdifB com NAdB elementos;
 PRINT*
 PRINT*, 'Elementos do Conjunto A-B'
 WRITE(*,25) (AdifB(I), I = 1, NAdB)
 25 FORMAT(3X, 10(I4, 2X ) )
 STOP
 END
 
 PROGRAM L4EXERC9
c C Ler e imprimir a matricula, o nome (TabAluno(Matricula,Nome))
c e a nota de uma prova de uma turma (TabProva(Aluno)),
c com no maximo, 30 alunos. Calcular, armazenar e imprimir a media
c aritmetica da prova. A seguir imprimir matricula, nome e a nota dos
c alunos cuja nota seja maior ou igual a media da prova.
 CHARACTER Matric*5, Nome*30, TabAlunos(30,2)*30
 REAL Nota, Media, TabProva(31), Soma
 INTEGER Mat, Alunos, MaxAlu, I
 PARAMETER (MaxAlu = 30)
 DATA Mat, Alunos/2*0/
 
 PRINT*, 'Digite primeira matricula.'
 READ(*,10) Matric
 10 FORMAT(A5) 
 DO WHILE (Matric .NE. ‘00000’)
 PRINT*,’Digite nome nas primeiras 20 pos e nota nas 5 proxs.’
 READ(*, 20) Nome, Nota
 20 FORMAT(A30, F5.2)
 Mat = Mat + 1
 IF (Mat .GT. MaxAlu) THEN
 PRINT*,' Num de alunos ultrapassa ', MaxAlu
 PRINT*,' Programa sera encerrado.'
 STOP
 ENDIF
 TabAlunos(Mat,1) = Matric
 TabAlunos(Mat,2) = Nome
c as variaveis Mat e Alunos representam um mesmo aluno
 Alunos = Alunos + 1
 TabProva(Alunos) = NotaPRINT*, 'Digite proxima matricula (00000-encerra).'
 READ(*,10) Matric
 ENDDO
 PRINT*
 PRINT*,' Informacoes dos alunos após digitacao.'
 DO I = 1, Mat
 PRINT*
 WRITE(*,40) TabAlunos(I,1), TabAlunos(I,2), TabProva(I)
 40 FORMAT(5X, A5, 2x, A30, 2X, F5.2)
 ENDDO
c calcular media da prova
 Soma = 0
 DO I = 1, Alunos
 Soma = Soma + TabProva(I)
 ENDDO
 Media = Soma/Alunos
 TabProva(Alunos+1) = Media
 PRINT*
 PRINT*,' Total de Provas/Alunos:', Alunos
 PRINT*
 WRITE(*,50) TabProva(Alunos+1)
 50 FORMAT(3X, 'Media da prova:', F5.2)
 PRINT*
c imprimir dados dos alunos com nota >= a media da prova
 PRINT*, ' Alunos com nota >= a media da prova.'
 DO I = 1, Alunos
 IF (TabProva(I) .GE. TabProva(Alunos+1)) THEN
 PRINT*
 WRITE(*,40) TabAlunos(I,1), TabAlunos(I,2), TabProva(I)
 ENDIF
 ENDDO
 STOP
 END
 
PROGRAM L4EXERC10
c Ler e imprimir um conjunto de valores reais que representam as alturas de várias 
c pessoas. Encontrar e imprimir as duas maiores alturas lidas e imprima quantas 
c pessoas cada uma dessas alturas. O conjunto devera ser varrido uma unica vez.
 REAL Conj(20), Maior1, Maior2, ValorLido
 INTEGER TotM1, TotM2, I, MaxElem, NElem
 PARAMETER(MaxElem = 20)
 
 NElem = 0
 PRINT*, 'Digite primeiro valor do conjunto.'
 READ*,	 ValorLido
 DO WHILE (ValorLido .NE. -5555)
 NElem = NElem + 1
 IF (NElem .GT. MaxElem) THEN
 PRINT*,' Num de valores lidos ultrapassa ', MaxElem
 PRINT*,' Programa sera encerrado.'
 STOP
 ENDIF
 Conj(NElem) = ValorLido
 PRINT*, 'Digite proximo valor do conjunto (-55555-encerra).'
 READ*, ValorLido
 ENDDO
 PRINT*, 'Numero de elementos do conjunto:', NElem
 PRINT*
 PRINT*, 'Conjunto lido apos digitacao.'
 WRITE(*,15) (Conj(I), I = 1, NElem)
 15 FORMAT (3X, 10(F5.2, 2X))
 PRINT*
 Maior1 = Conj(1)
 TotM1 = 1
 Maior2 = Conj(1)
 TotM2 = 1
 DO I = 2, NElem
 IF (Conj(I) .GT. Maior1) THEN
 Maior2 = Maior1
 TotM2 = TotM1
 Maior1 = Conj(I)
 TotM1 = 1
 ELSE
 IF (Conj(I) .EQ. Maior1) THEN
 TotM1 = TotM1 + 1
 ELSE
 IF (Conj(I) .GT. Maior2) THEN
 Maior2 = Conj(I)
 TotM2 = 1
 ELSE
 IF (Conj(I) .EQ. Maior2) THEN
 TotM2 = TotM2 + 1
 ENDIF
 ENDIF
 ENDIF
 ENDIF
 ENDDO
 PRINT*, ' Maior valor do conjunto:', Maior1
 PRINT*, 'Total de valor(es) lido(s):', TotM1
 PRINT*
 PRINT*, ' Segundo maior valor:', Maior2
 PRINT*, 'Total de valor(es) lido(s):', TotM2
 STOP
 END
 PROGRAM L4EXERC11
c Ler e imprimir as matrizes : A mxn, B pxq e C rxs.
c Calcular e imprimir : EXP = A + B * (C * A)T
 INTEGER A(10,10), B(10,10), C(10,10), CxA(10,10), TCxA(10,10),
 * BxTCxA(10,10), Exp(10,10), M, N, P, Q, R, S, Lin, Col,
 * K, MaxInd
 PARAMETER (MaxInd = 10)
 PRINT*, ‘Digite numero de linhas e colunas matriz A(Max:10).’
 READ*, M, N
 IF (( M.GT.MaxInd) .OR. ( N.GT.MaxInd)) THEN
 PRINT*,'Dimensao da matriz invalida. Programa sera cancelado.'
 STOP
 ENDIF
 PRINT*, ‘Digite elementos da matriz A(linha por linha).’
 DO Lin = 1, M
 READ*, (A(Lin, Col), Col = 1, N)
 ENDDO
c ler e defender dimensao da matriz B
 PRINT*, ‘Digite numero de linhas e colunas matriz B(Max:10).’
 READ*, P, Q
 IF (( P.GT.MaxInd) .OR. ( Q.GT.MaxInd)) THEN
 PRINT*,'Dimensao da matriz invalida. Programa sera cancelado.'
 STOP
 ENDIF
 PRINT*, ‘Digite elementos da matriz B(linha por linha).’
 DO Lin = 1, P
 READ*, (B(Lin, Col), Col = 1, Q)
 ENDDO
c ler e defender dimensao da matriz C
 PRINT*, ‘Digite numero de linhas e colunas matriz C(Max:10).’
 READ*, R, S
 IF (( R.GT.MaxInd) .OR. ( S.GT.MaxInd)) THEN
 PRINT*,'Dimensao da matriz invalida. Programa sera cancelado.'
 STOP
 ENDIF
 PRINT*, ‘Digite elementos da matriz C(linha por linha).’
 DO Lin = 1, R
 READ*, (C(Lin, Col), Col = 1, S)
 ENDDO
 PRINT*, 'Linhas e colunas da matriz A:', M, N
 PRINT*, 'Linhas e colunas da matriz B:', P, Q
 PRINT*, 'Linhas e colunas da matriz C:', R, S
 PRINT*
 PRINT*, ' MATRIZ A'
 DO Lin = 1, M
 WRITE(*,15) (A(Lin, Col), Col = 1, N)
 ENDDO
 PRINT*
 PRINT*, ' MATRIZ B'
 DO Lin = 1, P
 WRITE(*,15) (B(Lin, Col), Col = 1, Q)
 ENDDO
 PRINT*
 PRINT*, ' MATRIZ C'
 DO Lin = 1, R
 WRITE(*,15) (C(Lin, Col), Col = 1, S)
 ENDDO
 5 FORMAT(2I2)
 10 FORMAT(10I4)
 15 FORMAT (10(I5, 2X))
 
c Calcular C x A, se s = m ( CxA rxn)
 IF (S .NE. M) THEN
 PRINT*, 'Dimensao de C e A incompativeis para operacao.'
 PRINT*, 'Programa cancelado.'
 STOP
 ENDIF
 DO Lin = 1, R
 DO Col = 1, N
 CxA(Lin,Col) = 0
 DO K = 1, M
 CxA(Lin,Col) = CxA(Lin,Col) + C(Lin,K)*A(K,Col)
 ENDDO
 ENDDO
 ENDDO
 PRINT*
 PRINT*, ' MATRIZ CxA'
 DO Lin = 1, R
 WRITE(*,15) (CxA(Lin, Col), Col = 1, N)
 ENDDO
 
c transposta de CxA (TCxA nxr)
 DO Lin = 1, R
 DO Col = 1, N
 TCxA(Lin,Col) = CxA(Col,Lin)
 ENDDO
 ENDDO
 PRINT*, ' MATRIZ TCXA'
 DO Lin = 1, N
 WRITE(*,15) (TCxA(Lin, Col), Col = 1, R)
 ENDDO
 
c Calcular B * (C * A)T (B*TCxA pxr)
 IF (Q .NE. N) THEN
 PRINT*, 'Dimensao de B e TCxA incompativeis para operacao.'
 PRINT*, 'Programa cancelado.'
 STOP
 ENDIF
 DO Lin = 1, P
 DO Col = 1, R
 BxTCxA(Lin,Col) = 0
 DO K = 1, N
 BxTCxA(Lin,Col) = BxTCxA(Lin,Col) + B(Lin,K)*TCxA(K,Col)
 ENDDO
 ENDDO
 ENDDO
 PRINT*
 PRINT*, ' MATRIZ BxTCXA'
 DO Lin = 1, P
 WRITE(*,15) (BxTCxA(Lin, Col), Col = 1, R)
 ENDDO
 
c calcular Exp = A + BxTCxA (Exp mxn)
 IF ((M .NE. P) .OR. (N .NE. R)) THEN
 PRINT*, 'Dimensao de A e BxTCxA incompativeis para operacao.'
 PRINT*, 'Programa cancelado.'
 ENDIF
 DO Lin = 1, M
 DO Col = 1, N
 Exp(Lin,Col) = A(Lin,Col) + BxTCxA(Lin,Col)
 ENDDO
 ENDDO
 PRINT*
 PRINT*, ' EXP = A + B * (C * A)T'
 DO Lin = 1, M
 WRITE(*,15) (Exp(Lin, Col), Col = 1, N)
 ENDDO
 STOP
 END
 PROGRAM L4EXERC12
c Ler e imprimir uma matriz de reais nxn. A seguir:
c imprimir a soma dos elementos da linha Linha;
c imprimir o maior elemento da coluna Coluna;
ccalcular e imprimir o produto dos elementos da diagonal principal;
c imprimir a soma dos elementos da diagonal secundaria;
c imprimir os elementos que estao acima da diagonal principal;
 REAL MatReal (20,20), SomaLinha, MaiorCol, ProdDP, SomaDS
 INTEGER Lin, Col, N, MaxInd, Linha, Coluna
 PARAMETER (MaxInd = 20)
c ler e defender dimensao da matriz
 PRINT*, ‘Digite a dimensao da matriz quadrada(Max:20).’
 READ*, N
 IF (N .GT. MaxInd) THEN
 PRINT*,'Dimensao da matriz invalida. Programa sera cancelado.'
 STOP
 ENDIF
 PRINT*, ‘Digite elementos da matriz(linha por linha).’
 DO Lin = 1, N
 READ*, (MatReal(Lin, Col), Col = 1, N)
 ENDDO
 PRINT*, 'Linhas e colunas da matriz nxn:', N
 PRINT*
 PRINT*, ' Matriz Lida'
 DO Lin = 1, N
 WRITE(*,15) (MatReal(Lin, Col), Col = 1, N)
 ENDDO
15 FORMAT (20(F5.2, 2X))
 
c imprimir a soma dos elementos da linha Linha;
 READ*, Linha
 SomaLinha = 0
 DO Col = 1, N
 SomaLinha = SomaLinha + MatReal(Linha,Col)
 ENDDO
 PRINT*
 WRITE(*,20) Linha, SomaLinha
 20 FORMAT(' Soma do elementos da linha ', I2, ' :', F7.2)
c imprimir o maior elemento da coluna Coluna;
 READ*, Coluna
 MaiorCol = MatReal(1,Coluna)
 DO Lin = 1, N
 IF (MatReal(Lin,Coluna) .GT. MaiorCol) THEN
 MaiorCol = MatReal(Lin,Coluna)
 ENDIF
 ENDDO
 PRINT*
 WRITE(*,25) Coluna, MaiorCol
 25 FORMAT(' Maior elemento da coluna ',I2, ':', F5.2)
c imprimir o produto dos elementos da diagonal principal;
 ProdDP = 1
 DO Lin = 1, N
 ProdDP = ProdDP * MatReal(Lin,Lin)
 ENDDO
 PRINT*
 WRITE(*,30) ProdDP
 30 FORMAT(' Produto dos elementos da diag. princ:', F7.2)
c imprimir a soma dos elementos da diagonal secundaria;
 SomaDs = 0
 DO Lin = 1, N
 SomaDS = SomaDS + MatReal(Lin,N-Lin+1)
 ENDDO
 PRINT*
 WRITE(*,35) SomaDS
 35 FORMAT(' Soma dos elementos da diag. sec.:', F7.2)
c imprimir os elementos que estao acima da diagonal principal;
 PRINT*
 PRINT*,' Elementos acima da diagonal principal'
 DO Lin = 1, N-1
 DO Col = Lin+1, N
 Write(*,40) Lin, Col, MatReal(Lin,Col)
 40 FORMAT(10X, '(',I2,',',I2,')', 5x, F5.2)
 ENDDO
 ENDDO
c imprimir os elementos que estao abaixo da diagonal principal;
 PRINT*
 PRINT*,' Elementos abaixo da diagonal principal'
 DO Lin = 2, N
 DO Col = 1, Lin-1
 Write(*,40) Lin, Col, MatReal(Lin,Col)
 ENDDO
 ENDDO
 STOP
 END
 PROGRAM L4EXERC13
c Ler e imprimir a matricula, o nome (TabAluno(Mat,Nome))
c e a nota de tres prova de uma turma, com no maximo, 30 alunos.
c Calcular e armazenar em TabNotas(Aluno, Nota) a media aritmetica
c de cada aluno e de cada prova. Imprimir matricula, nome, as notas
c e as medias dos alunos, e a media das provas da turma.
 CHARACTER Matric*5, Nome*30, TabAlunos(31,2)*30
 REAL TabNotas(31,4), Notas(3), MedAluno, MedProva, Soma
 INTEGER Alunos, MaxAlu, I, J
 PARAMETER (MaxAlu = 30)
 DATA Alunos/0/
 
 PRINT*, ‘Digite a mtricula do primeiro aluno.’
 READ(*,10) Matric
 10 FORMAT(A5)
 DO WHILE (Matric .NE. ‘00000’)
 PRINT*, ‘Digite nome nas 30 primeiras pos e as 3 notas
 c cada uma delas ocupando 5 posicoes.’
 READ(*, 20) Nome, (Notas(I), I = 1, 3)
 20 FORMAT(A30, 3F5.2)
 Alunos = Alunos + 1
 IF (Alunos .GT. MaxAlu) THEN
 PRINT*,' Num de alunos ultrapassa ', MaxAlu
 PRINT*,' Programa sera encerrado.'
 STOP
 ENDIF
 TabAlunos(Alunos,1) = Matric
 TabAlunos(Alunos,2) = Nome
 DO J = 1, 3
 TabNotas(Alunos,J) = Notas(J)
 ENDDO
 PRINT*, ‘Digite a mtricula do proximo aluno(00000-encerra).’
 READ(*,10) Matric
 ENDDO
 TabAlunos(Alunos+1,1) = ' '
 TabAlunos(Alunos+1,2) = 'Medias das provas e geral '
 PRINT*
 PRINT*,'Numero de alunos da turma:', Alunos
 PRINT*
 PRINT*,' Informacoes dos alunos lidas do teclado.'
 DO I = 1, Alunos
 PRINT*
 WRITE(*,40) TabAlunos(I,1), TabAlunos(I,2),
 * (TabNotas(I,J),J=1,3)
FORMAT(5X, A5, 2x, A30, 2X, 3(F5.2, 2X)) 
 ENDDO
c calcular media dos alunos e armazenar na tabela de notas
 DO I = 1, Alunos
 Soma = 0
 DO J = 1, 3
 Soma = Soma + TabNotas(I,J)
 ENDDO
 MedAluno = Soma/3
 TabNotas(I,4) = MedAluno
 ENDDO
c calcular medias das provas e armazenar na tabela de notas
 DO J = 1, 4
 Soma = 0
 DO I = 1, Alunos
 Soma = Soma + TabNotas(I,J)
 ENDDO
 MedProva = Soma/Alunos
 TabNotas(Alunos+1,J) = MedProva
 ENDDO
c a saida tera o seguinte formato (layout)
c Tabela de alunos: notas e medias
c Mat Nome do aluno Nota1 Nota2 Nota3 Media
cxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx.xx xx.xx xx.xx xx.xx
 PRINT*
 PRINT*
 WRITE(*,50)
 50 FORMAT(22X, 'Tabela de alunos: notas e medias')
 PRINT*
 WRITE(*,60)
 60 FORMAT(' Mat Nome do aluno Nota1 Nota2 No
 *ta3 Media')
 DO I = 1, Alunos+1
 WRITE(*,70) TabAlunos(I,1), TabAlunos(I,2),
 * (TabNotas(I,J), J = 1, 4)
 70 FORMAT(A5, 2X, A30, 2X, 4(F5.2, 2X))
 ENDDO
 STOP
 END
 PROGRAM L4EXERC14
c Ler e imprimir a matricula, o nome (TabAluno(Turma, Mat, Nome))
c e a nota de tres prova de duas turmas, cada turma com no maximo
c 30 alunos. A leitura dos dados de uma turma termina quando for
c lida a matricula 00000. 
c A leitura dos dados termina quando for lida a matricula $$$$$.
c Calcular e armazenar no agregado TabNotas(Turma, Aluno, Nota):
c a media aritmetica de cada aluno;
c a media aritmetica de cada prova de cada turma;
c a media aritmetica de cada turma.
c Imprimir as tabelas TabAluno e TabNotas, turma por turma,
c com mensagens apropriadas. 
 CHARACTER Matric*5, Nome*30, TabAlunos(2,31,2)*30
 REAL TabNotas(2,31,4), Notas(3), MedAluno, MedProva, Soma
 INTEGER Alunos, MaxAlu, I, J, AluTurma(2)
 PARAMETER (MaxAlu = 30)
 READ(*,20) Matric, Nome, (Notas(I), I = 1, 3) 
 20 FORMAT(A5, A30, 3F5.2)
 DO WHILE (Matric .NE. '$$$$$')
 Turma = Turma + 1
 Alunos = 0
 DO WHILE ((Matric .NE. '00000')
 Alunos = Alunos + 1
 IF (Alunos .GT. MaxAlu) THEN
 PRINT*,' Num de alunos ultrapassa ', MaxAlu
 PRINT*,' Programa sera encerrado.'
 STOP
 ENDIF
 TabAlunos(Turma,Alunos,1) = Matric
 TabAlunos(Turma,Alunos,2) = Nome
 DO J = 1, 3
 TabNotas(Turma,Alunos,J) = Notas(J)
 ENDDO
 AluTurma(Turma) = Alunos
 PRINT*, ‘Digite matricula 00000 para encerrar turma.’
 READ(*,20) Matric, Nome, (Notas(I),I = 1, 3)
 ENDDO 
 PRINT*, ‘Digite matricula $$$$$ para encerrar digitacao.’
 READ(*,20) Matric, Nome, (Notas(I), I = 1, 3)
 ENDDO
 TabAlunos(Turma,Alunos+1,1) = ' '
 TabAlunos(Turma,Alunos+1,2) = 'Medias das provas e geral '
 DO K = 1, Turma
 PRINT*
 PRINT*,' Numero de alunos da turma ', K, ':',AluTurma(K)
 PRINT*
 PRINT*,' Informacoes dos alunos lidas do arquivo.'
 DO I = 1, AluTurma(K)
 PRINT*
 WRITE(*,40) TabAlunos(K,I,1), TabAlunos(K,I,2),
 * (TabNotas(K,I,J),J=1,3)
 40 FORMAT(5X, A5, 2x, A30, 2X, 3(F5.2, 2X))
 ENDDO
 PRINT*
 ENDDO
c calcular media dos alunos e armazenar na tabela de notas
 DO K = 1, Turma
 DO I = 1, AluTurma(K)
 Soma = 0
 DO J = 1, 3
 Soma = Soma + TabNotas(K,I,J)
 ENDDO
 MedAluno = Soma/3
 TabNotas(K,I,4) = MedAluno
 ENDDO
 ENDDO
c calcular medias das provas e armazenar na tabela de notas
 DO K = 1, Turma
 DO J = 1, 4
 Soma = 0
 DO I = 1, AluTurma(K)
 Soma = Soma + TabNotas(K,I,J)
 ENDDO
 MedProva = Soma/AluTurma(K)
 TabNotas(K,AluTurma(K)+1,J) = MedProva
 ENDDO
 ENDDO
c a saida tera o seguinte formato (layout)
c Tabela de alunos: notas e medias
c Turma x
c Mat Nome do aluno Nota1 Nota2 Nota3 Media
cxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx xx.xx xx.xx xx.xx xx.xx
 PRINT*
 PRINT*
 WRITE(*,50)
 50 FORMAT(22X, 'Tabela de alunos: notas e medias')
 DO K = 1, Turma
 PRINT*
 WRITE(*,60) K
 60 FORMAT(32X,'Turma ', I2)
 PRINT*
 WRITE(*,70)
 70 FORMAT(' Mat Nome do aluno Nota1 Nota2
 * Nota3 Media')
 DO I = 1, AluTurma(K)+1
 WRITE(*,80) TabAlunos(K,I,1), TabAlunos(K,I,2),
 * (TabNotas(K,I,J), J = 1, 4)
 80 FORMAT(A5, 2X, A30, 2X, 4(F5.2, 2X))
 ENDDO
 ENDDO
 STOP
 END
Exercícios de Subprogramas
 PROGRAM L5EXERC1
c Ler e imprimir um conjunto de inteiros. A leitura termina
c quando encontrado o flag = -77. Imprimir o conjunto lido
c e o numero de componentes. Ordenar os elementos do conjunto em ordem
c crescente. A seguir ler 5 valores inteiros, um a um,
c e verifique se o valor ocorre ou nao no conjunto. Imprimir os
c valores lidos com mensagens se ocorrem ou nao no conjunto e,
c caso ocorra, qual sua posicao.
 INTEGER NElem, Conj(30)
 CHARACTER Mensa*30
 CALL LerConj(Conj, NElem)
 PRINT*, 'Numero de elementos no conjunto:', NElem
 PRINT*
 Mensa = 'Conjunto lido do arquivo'
 CALL ImpConj(Conj, NElem,Mensa)
c ordenar conjunto
 CALL OrdConj(Conj,NElem)
 Mensa = 'Conjunto ordenado de forma crescente'
 CALL ImpConj(Conj, NElem, Mensa)
c consultar elementos no conjunto
 CALL ConsConj(Conj, NElem)
 STOP
 END
 SUBROUTINE LerConj(PConj, PNElem)
 INTEGER PNElem, PConj(30), MaxElem, ValorLido, Flag
 PARAMETER(MaxElem = 30, Flag = -77)
c Ler conjunto com valores inteiros ate valor lido for -1
 PNElem = 0
 PRINT*, ‘Digite o primeiro valor do conjunto.’
 READ* ,ValorLido
 DO WHILE (ValorLido .NE. Flag)
 PNElem = PNElem + 1
c Defender posicao considerada com respeito ao tamanho do conjunto (30)
 IF ( PNElem .GT. MaxElem) THEN
 PRINT*,'O numero de elementos deve ser <= a 30.
 * Programa sera encerrado.'
 STOP
 ENDIF
 PConj(PNElem) = ValorLido
 PRINT*, ‘Digite o proximo valor do conjunto (-77 encerra).’
 READ*,ValorLido
 ENDDO
 RETURN
 END
 SUBROUTINE ImpConj(PConj, PNElem, Mensag)
 INTEGER PNElem, PConj(30), I
 CHARACTER Mensag*30
 PRINT*
 PRINT*, Mensag
 WRITE(*,12) (PConj(I), I = 1, PNElem)
 12 FORMAT( 10( I4, 2X ) )
 PRINT*
 RETURN
 END
 SUBROUTINE OrdConj(C, N)
 INTEGER N, C(30), Tam, I
 LOGICAL Ordenado
 Ordenado = .FALSE.
 Tam = N
 DO WHILE ((Tam .GT. 1) .AND. (.NOT. Ordenado))
 Ordenado = .TRUE.
 DO I = 1, Tam - 1
 IF (C(I) .GT. C(I+1)) THEN
 CALL Trocar(C(I), C(I+1))
 Ordenado = .FALSE.
 ENDIF
 ENDDO
 Tam = Tam - 1
 ENDDO
 RETURN
 END
 SUBROUTINE Trocar(A, B)
 INTEGER A ,B, AUX
 AUX = A
 A = B
 B = Aux
 RETURN
 END
 SUBROUTINE ConsConj(C, N)
 INTEGER N, C(30), ValorLido, Posicao, Pos
c ler 5 valores e verificar se ocorrem no conjunto e em qual posicao
 DO J = 1, 5
 PRINT*, ‘Digite valor ‘, J , ‘ para verificar ocorrencia.’
 READ*, ValorLido
 Pos = Posicao(ValorLido, C, N)
 PRINT*
 IF ( Pos .NE. 0) THEN
 PRINT*, ValorLido, ' pertence ao conjunto,',' na posicao
 *', Pos
 ELSE
 PRINT*, ValorLido, ' nao pertence ao conjunto.'
 ENDIF
 ENDDO
 STOP
 END
 INTEGER FUNCTION Posicao(Valor, Conj, N)
 INTEGER Valor, N, Conj(30), Meio, Inicio, Fim, Pos
c busca em conjunto ordenado: pesquisa binaria
 Pos = 0
 Inicio = 1
 Fim = N
 DO WHILE ((Inicio .LE. Fim) .AND. (Pos .EQ. 0))
 Meio = (Inicio + Fim)/2
 IF (Valor .EQ. Conj(Meio)) THEN
 Pos = Meio
 ELSE
 IF (Valor .GT. Conj(Meio)) THEN
 Inicio = Meio + 1
 ELSE
 Fim = Meio - 1
 ENDIF
 ENDIF
 ENDDO
 Posicao = Pos
 RETURN
 END
 PROGRAM L5EXERC2
c Ler e imprimir as matrizes : A mxn, B pxq e C rxs.
c Calcular e imprimir : EXP = A + B * (C * A)T
 INTEGER A(10,10), B(10,10), C(10,10), CxA(10,10), TCxA(10,10),
 * BxTCxA(10,10), Exp(10,10), M, N, P, Q, R, S, LCxA, CCxA,
 * LBxT, CBxT
 CHARACTER Mensa1*20, Mensa2*30
 CALL LerMat(A, M, N)
 CALL LerMat(B, P, Q)
 CALL LerMat(C, R, S)
 Mensa1 = 'Linhas e colunas da '
 Mensa2 = 'Matriz A'
 CALL ImpMat(A, M, N, Mensa1, Mensa2)
 Mensa2 = 'Matriz B'
 CALL ImpMat(B, P, Q, Mensa1, Mensa2)
 Mensa2 = 'Matriz C'
 CALL ImpMat(C, R, S, Mensa1, Mensa2)
 CALL MultMat(C, R, S, A, M, N, CxA, LCxA, CCxA)
 Mensa2 = 'Matriz CxA'
 CALL ImpMat(CxA, LCxA, CCxA, Mensa1, Mensa2)
 CALL Transp(CxA, LCxA, CCxA, TCxA)
 Mensa2 = 'Matriz Transposta de CxA'
 CALL ImpMat(TCxA, CCxA, LCxA, Mensa1, Mensa2)
c Calcular B * (C * A)T (BxTCxA pxr)
 CALL MultMat(B, P, Q, TCxA, CCxA, LCxA, BxTCxA, LBxT, CBxT)
 Mensa2 = 'Matriz B x TCXA'
 CALL ImpMat(BxTCxA, LBxT, CBxT, Mensa1, Mensa2)
 
c calcular Exp = A + BxTCxA (Exp mxn)
 CALl SomaMat(A, M, N, BxTCxA, LBxT, CBxT, Exp)
 Mensa2 = ' Matrix EXP = A + B *