F77: Calculo da área de qualquer polígono plano

From AdonaiMedrado.Pro.Br
Revision as of 02:18, 9 December 2008 by Adonaimedrado (Talk | contribs) (New page: Este programa foi desenvolvido pelos alunos Carlos Mateus João Abreu e Matheus Azaro durante a disciplina Processamento de Dados (UFBA 2008.2). Data da apresentação: 27/11/2008. == pol...)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search

Este programa foi desenvolvido pelos alunos Carlos Mateus João Abreu e Matheus Azaro durante a disciplina Processamento de Dados (UFBA 2008.2). Data da apresentação: 27/11/2008.

poligrav.f

!      poligrav.f
       program PoliGrav
       implicit none
 
       integer contador, quantidadeV, i
       real x(100), y(100)
       character arquivo*40, Poligono*40
 
       contador = 100
 
       write (*,200)
 
       write(*,*) 'Digite o nome do arquivo para gravação ',
     k            'ou <ENTER> para encerrar:'
 
       read (*,201) arquivo
 
          if (arquivo.eq.' ') then
 
             write (*,*) '<Fim>'
 
             stop
 
          else
 
             open  (unit=13,access='sequential',err=1000,file=arquivo)
 
         end if
 
       do while (contador.eq.100)
 
          write (*,*) 'Descrição do poligono ou <ENTER> para encerrar:'
 
          read (*,201) Poligono
 
                if (Poligono.eq.' ') then
 
                   write(*,*) '<Fim>'
 
                   close (unit=13, status='keep')
 
                   stop
 
                end if
 
1111      write(*,*) 'Quantidade de vértices <3 a 100>:'
 
          read (*,*) quantidadeV
 
          if (quantidadeV.lt.3 .or. quantidadeV.gt.100) then
 
             go to 1111
 
          end if
 
          do i = 1, quantidadeV
 
             write(*,*) ' Coordenadas do vértice', i,':'
 
             read (*,*) x(i), y(i)
 
          end do
 
          write(13,202) Poligono, quantidadeV, (x(i), y(i),
     k                  i = 1, quantidadeV)
 
       end do
 
200    format ( 'Universidade Federal da Bahia',/,
     k          'MAT045 Programação Cientifica',/,
     k          'Departamento de Ciência da Computação',/,
     k          'Aluno: Matheus, Carlos, Matheus',//,
     k          'Criar um arquivo para gravação dos vértices.',// )
 
201    format ( A40 )
 
202    format ( A40, I4, 100(2F12.4) )
 
1000   write (*,*) 'Erro na abertura de abertura do arquivo.'
 
       end

policalc.f

!      policalc.f
       program PoliCalc
       implicit none
 
       integer quantidadeV, i,contador
       real x(100), y(100), areaV, area
       character arquivo*40, Poligono*40
 
       contador = 100
 
       write (*,200)
 
       write(*,*) 'Digite o nome do arquivo para cálculo ',
     k            'ou <ENTER> para encerrar:'
 
       read (*,201) arquivo
 
          if (arquivo.eq.' ') then
 
             write (*,*) '<Fim>'
 
             stop
 
          else
 
             open (unit=13,access='sequential',err=1000,file=arquivo)
 
          end if
 
       do while(contador.eq.100)
 
          read (13,202, end=1001) Poligono, quantidadeV, (x(i), y(i),
     k                            i = 1, quantidadeV)
 
          area = 0
 
          do i = 1, quantidadeV-1
 
             areaV = ( x(i)*y(i+1) - x(i+1)*y(i) ) / 2
 
             area = area + areaV
 
          end do
 
             areaV = ( x(quantidadeV)*y(1) - x(1)*y(quantidadeV) ) / 2
 
             area = area + areaV
 
          write (*,206)
 
          write (*,203) Poligono, x(1), y(1)
 
          write (*,205) ABS(area), x(2), y(2)
 
          do i = 3, quantidadeV
 
             write(*,204) i, x(i), y(i)
 
          end do
 
       end do
 
200    format ( 'Universidade Federal da Bahia',/,
     k          'MAT045 Programação Cientifica',/,
     k          'Departamento de Ciência da Computação',/,
     k          'Alunos: Matheus, Carlos, João',//,
     k          'Ler um arquivo para cálculo das áreas de poligonos',//)
 
201    format ( A40 )
 
202    format ( A40, I4, 100(2F12.4) )
 
203    format ( 'Poligono: ', A40,4X,'1', 2F12.4 )
 
204    format ( 52X, I3, 100(2F12.4) )
 
205    format ( 4X, 'Area: ', F12.4, 32X, '2', 2F12.4 )
 
206    format (  )
 
1000   write (*,*) 'Erro na abertura de abertura do arquivo.'
 
1001   close (unit=13, status='keep')
 
          write (*,*) '<Fim>'
 
          stop
 
       end program policalc