F90: Gravando/lendo dados em/de um arquivos
From AdonaiMedrado.Pro.Br
Revision as of 01:32, 11 November 2008 by Adonaimedrado (Talk | contribs) (New page: <code lang="fortran"> !Possibilidades do comando OPEN: !UNIT = número único que irá representar o arquivo (deve ser único). !FILE = nome do arquivo. !ACCESS = modo e acesso (append, di...)
!Possibilidades do comando OPEN: !UNIT = número único que irá representar o arquivo (deve ser único). !FILE = nome do arquivo. !ACCESS = modo e 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