F90: Gravando/lendo dados em/de um arquivos

From AdonaiMedrado.Pro.Br
Jump to: navigation, search
!Possibilidades do comando OPEN:
!UNIT = número único que irá representar o arquivo (deve ser único).
!FILE = nome do arquivo.
!ACCESS = modo de acesso (append, direct ou sequential)
!STATUS = tipo do arquivo (new, old ou scratch).
PROGRAM aula
        CHARACTER(LEN=*), PARAMETER :: NOME_DO_ARQUIVO = "agenda.txt"
        CALL ExibirMenuPrincipal()
CONTAINS
	SUBROUTINE ExibirMenu(Opcoes,Selecao)
		IMPLICIT NONE
		CHARACTER(LEN=20), DIMENSION(:), INTENT(in) :: opcoes
		INTEGER :: i, e
		INTEGER, INTENT(out) :: selecao
		DO i=1,Size(opcoes)
			WRITE (*,*) Opcoes(i)
		END DO
		DO
			READ(*,*,IOstat=e) Selecao
			IF (e>0 .OR. Selecao<0 .OR. Selecao>Size(Opcoes)) THEN
				WRITE (*,*) "Opção inválida."
			ELSE
				EXIt
			END IF
		END DO
	END SUBROUTINE 
	SUBROUTINE ExibirMenuPrincipal()
		IMPLICIT NONE
		CHARACTER(LEN=20), DIMENSION(1:4) :: o
		INTEGER :: s
		o(1) = "1- Incluir entrada"
		o(2) = "2- Listar entradas"
                o(3) = "3- Pesquisar entrada"
		o(4) = "4- Sair"
                DO
                     CALL ExibirMenu(o,s)
                     SELECT CASE (s)
                          CASE (1)
                              CALL IncluirEntrada()
                          CASE (2) 
                              CALL ListarEntradas()
                          CASE (3) 
                              CALL PesquisarEntrada()
                          CASE (4)
                              STOP "Programa encerrado"
                     END SELECT
               END DO
	END SUBROUTINE ExibirMenuPrincipal
	SUBROUTINE IncluirEntrada()
		IMPLICIT NONE
		CHARACTER(LEN=20) :: nome
		CHARACTER(LEN=10) :: telefone
		WRITE (*,*) "Nome:"
		READ (*,*) nome
		WRITE (*,*) "Telefone:"
		READ (*,*) telefone    
		OPEN(unit = 10, access="append", file=NOME_DO_ARQUIVO)
		WRITE (10,"(A20,A10)") nome, telefone
		CLOSE(10)
	END SUBROUTINE IncluirEntrada
        SUBROUTINE ListarEntradas()
                IMPLICIT NONE
		CHARACTER(LEN=20) :: nome
		CHARACTER(LEN=10) :: telefone
                INTEGER :: s, i
                i = 0
                OPEN(UNIT = 10, access="SEQUENTIAL", FILE=NOME_DO_ARQUIVO)
                DO
                    i = i + 1      
                    READ (10,"(A20,A10)",IOstat=s) nome, telefone
                    IF (s/=0) EXIT
                    WRITE (*,"(I3.3,A20,A10)") i, nome, telefone      
               END DO
               IF (i==0) WRITE (*,*) "=> Nenhum elemento encontrado."
               CLOSE(10)
        END SUBROUTINE
        SUBROUTINE PesquisarEntrada()
            IMPLICIT NONE
            CHARACTER(LEN=20) :: nome
	    CHARACTER(LEN=10) :: telefone
            CHARACTER(LEN=20) :: nome_procurado
            INTEGER :: i,s
            WRITE (*,*) "Qual o nome que deseja pesquisar?"
            READ (*,*) nome_procurado
            i = 0
            OPEN(UNIT = 10, FILE=NOME_DO_ARQUIVO)
            DO
                i = i + 1      
                READ (10,"(A20,A10)",IOstat=s) nome, telefone
                IF (s/=0) EXIT
                IF (nome(1:LEN(TRIM(nome_procurado))) == TRIM(nome_procurado)) THEN
                    WRITE (*,"(I3.3,A20,A10)") i, nome, telefone
                END IF
            END DO
            IF (i==1) WRITE (*,*) "=> Nenhum elemento encontrado."
            CLOSE(10)
      END SUBROUTINE PesquisarEntrada
END PROGRAM aula