Raízes - Fortran [Outros]

Raízes - Fortran

Publicado por Rastaplaca (última atualização em 28/10/2015)

[ Hits: 3.431 ]

Download raiz.f90

2 0

Denuncie Favoritos Indicar
Olá, mais um programa pra vocês. Qualque coisa meu contato está no script, juntamente com os comentários. Bom proveito para todos. Testei e não vi erro algum, caso encontrem, por favor me avisem.
Esconder código-fonte
module var_geral
   implicit none
   real(8)::start
   real(8)::finish
   real(8)::a
   real(8)::b
   real(8)::c
   real(8)::tol
   real(8)::ra
   real(8)::rn
   real(8)::aux
   real(8)::n
   real(8)::cont
   character::sn
end module

module var_bissecao
   implicit none
   type type_bisseccao
      real(8)::resultado_a
      real(8)::resultado_b
      real(8)::tempo_bissecao
      real(8)::iteracoes_bissecao
   end type
   type(type_bisseccao)::resultado_bissecao
   logical::val_bissecao=.false.
end module

module var_cordas
   implicit none
   type type_cordas
      real(8)::tempo_cordas
      real(8)::result_cordas
      real(8)::iteracoes_cordas
   end type
   type(type_cordas)::resultado_cordas
   logical::val_cordas=.false.
end module

module var_newton
   implicit none
   type type_newton
      real(8)::tempo_newton
      real(8)::result_newton
      real(8)::iteracoes_newton
   end type
   type(type_newton)::resultado_newton
   logical::val_newton=.false.
   logical::teste_newton=.false.
end module

module var_secante
   implicit none
   type type_secante
      real(8)::tempo_secante
      real(8)::result_secante
      real(8)::iteracoes_secante
   end type
   type(type_secante)::resultado_secante
   real(8)::ra2   
   logical::val_secante=.false.
end module

module var_grafico 
   implicit none
   real(8)::valorx
   real(8)::valory
   real(8)::xmin
   real(8)::xmax   
   real(8)::aux1
   real(8)::aux2
   character::chat
   character(1000)::dat
   character(1000)::eps
   character(1000)::pdf
   character(1000)::plt
   character(1000)::xlabel
   character(1000)::ylabel
   character(1000)::title
   character(1000)::file_name
   character(1000)::comandos
   character(1000)::formato_usuario1
   character(1000)::formato_usuario2
   integer::divisoes
   integer::i
end module

program raizes
   implicit none
   integer::menu
   character(1000)::comando_remover
   
   write(*,'(a,/)')""
   print*,"===================================="   
   print*,"PROGRAMA PARA CALCULO DE RAIZES DE UMA FUNCAO"
   print*,"===================================="
   menu=1
   do while (menu/=0)
      write(*,'(a,/)')""
      print*,"===================================="
      print*,"         MENU PRINCIPAL"
      print*,"===================================="
      write(*,'(a,/)')""
      
      print*,"1) Metodo Bissecao"
      print*,"2) Metodo Cordas"
      print*,"3) Metodo Newton"
      print*,"4) Metodo Secante"
      print*,"5) Comparacao entre os resultados"
      print*,"6) Grafico"      
      print*,"0) Sair"      
      read*,menu
      
      do while ((menu<0).or.(menu>6))
         print*,"Erro: Opcao desconhecida!"
         print*,"Tente novamente"
         read*,menu
      end do
      
      if (menu /= 0) then
         select case (menu)
            case(1)
               call bissecao
            case(2)
               call cordas
            case(3)
               call newton
            case (4)
               call secante
            case (5)
               call comparacao
            case default
               call grafico2d
         end select
      end if
   end do
   comando_remover='rm var_bissecao.mod'
   call system(trim(comando_remover))
   comando_remover='rm var_cordas.mod'
   call system(trim(comando_remover))
   comando_remover='rm var_geral.mod'
   call system(trim(comando_remover))
   comando_remover='rm var_grafico.mod'
   call system(trim(comando_remover))
   comando_remover='rm var_newton.mod'
   call system(trim(comando_remover))
   comando_remover='rm var_secante.mod'
   call system(trim(comando_remover))
end program

subroutine bissecao
   use var_bissecao
   use var_geral
   implicit none
   real(8)::f
   write (*,'(a,/)') ""
   print*,"================================"
   print*, "   METODO BISSECAO"
   print*,"================================"
   write (*,'(a,/)') ""   
   call entrada_dados
   val_bissecao=.true.
   cont=0.0d0
   call cpu_time(start)
   do while ((((b-a)/2.0d0)>tol).and.(cont<n))
      ra=(a+b)/2.0d0
      if((f(a)*f(ra))<0.0d0) then
         b=ra
      else
         a=ra
      end if
      cont=cont+1
   end do
   call cpu_time(finish)
   
   if (((b-a)/2.0d0)>tol) then
      write(*,'(a,/)')""
      print*,"ATENCAO: Tolerancia nao atingida!"
      print*,"MOTIVO: Numero maximo de iteracoes atingido."
      write(*,'(a,/)')""
      print*,"RESULTADOS:"
      print*,"Raiz:               ",a,"---",b
      print*,"Tempo total:        ",finish-start,"segundos"
      if (cont<=2000000) then
         print*,"Numero de iteracoes:",int(cont)
      else
         print*,"Numero de iteracoes:",cont
      end if
      print*,"Erro relativo(b-a): ",b-a
      print*,"Erro absoluto:      ",((b-a)/2.0d0)
      resultado_bissecao%resultado_a=a
      resultado_bissecao%resultado_b=b
      resultado_bissecao%tempo_bissecao=finish-start
      resultado_bissecao%iteracoes_bissecao=cont
   else
      write(*,'(a,/)')""
      print*,"RESULTADOS:"
      print*,"Raiz:               ",a,"---",b
      print*,"Tempo total:        ",finish-start,"segundos"
      if (cont<=2000000) then
         print*,"Numero de iteracoes:",int(cont)
      else
         print*,"Numero de iteracoes:",cont
      end if
      print*,"Erro relativo(b-a): ",b-a
      print*,"Erro absoluto:      ",((b-a)/2.0d0)
      resultado_bissecao%resultado_a=a
      resultado_bissecao%resultado_b=b
      resultado_bissecao%tempo_bissecao=finish-start
      resultado_bissecao%iteracoes_bissecao=cont
   end if
end subroutine

subroutine cordas
   use var_geral
   use var_cordas
   implicit none
   real(8)::f,f2
   write (*,'(a,/)') ""
   print*,"================================"
   print*, "   METODO CORDAS"
   print*,"================================"
   write (*,'(a,/)') ""   
   call entrada_dados
   val_cordas=.true.
   call cpu_time(start)
   if((f(a)*f2(a))>0.0d0) then
      rn=b
      c=a
   else
      rn=a
      c=b
   end if   
   ra=c
   cont=1.0d0
   aux=rn-ra   
   if (aux<0.0d0) then
      aux=-aux
   end if
   if(rn<0.0d0) then
      rn=-rn
   end if
   
   do while ((aux/rn>tol).and.(cont<n))
      ra=rn
      rn=ra-f(ra)/(f(ra)-f(c))*(ra-c)
      cont=cont+1
      aux=rn-ra
      
      if (aux<0.0d0) then
         aux=-aux
      end if
      if (rn<0.0d0) then
         rn=-rn
      end if
   end do
   call cpu_time(finish)
   
   if ((aux/rn>tol).and.cont==n) then
      write(*,'(a,/)')""
      print*,"ATENCAO: Tolerancia nao atingida!"
      print*,"MOTIVO: Numero maximo de iteracoes atingido."
      write(*,'(a,/)')""
      print*,"RESULTADOS:"
      print*,"Raiz:               ",rn
      print*,"Tempo total:        ",finish-start,"segundos"
      if (cont<=2000000) then
         print*,"Numero de iteracoes:",int(cont)
      else
         print*,"Numero de iteracoes:",cont
      end if
      print*,"Erro absoluto:      ",(aux/rn)
      resultado_cordas%result_cordas=rn
      resultado_cordas%tempo_cordas=finish-start
      resultado_cordas%iteracoes_cordas=cont
   else
      write(*,'(a,/)')""
      print*,"RESULTADOS:"
      print*,"Raiz:               ",rn
      print*,"Tempo total:        ",finish-start,"segundos"
      if (cont<=2000000) then
         print*,"Numero de iteracoes:",int(cont)
      else
         print*,"Numero de iteracoes:",cont
      end if
      print*,"Erro absoluto:      ",(aux/rn)
      resultado_cordas%result_cordas=rn
      resultado_cordas%tempo_cordas=finish-start
      resultado_cordas%iteracoes_cordas=cont
   end if      
end subroutine

subroutine newton
   use var_newton
   use var_geral
   implicit none
   real(8)::f,f1,f2
   write (*,'(a,/)') ""
   print*,"================================"
   print*, "   METODO NEWTON"
   print*,"================================"
   write (*,'(a,/)') ""   
   ra=0.0d0
   cont=0.0d0
   teste_newton=.true.
   call entrada_dados 
   teste_newton=.false.
   if ((f(a)*f2(a))<0.0d0) then
      write(*,'(a,/)')""
      print*,"Erro: Convergencia nao garantida!"
      print*,"Retornando ao menu principal!"
   else
      call cpu_time(start)
      val_newton=.true.
      rn=a
      cont=1.0d0
      aux=rn-ra
      if(aux<0.0d0) then
         aux=-aux
      end if
      if(rn<0.0d0) then
         rn=-rn
      end if
      do while (((aux/rn)>tol).and.(cont<n))
         ra=rn
         rn=ra-f(ra)/f1(ra)
         cont=cont+1.0d0
         aux=rn-ra
         if (aux<0.0d0) then
            aux=-aux
         end if
         if (rn<0.0d0) then
            rn=-rn
         end if
      end do
      call cpu_time(finish)
      if ((aux/rn>tol).and.cont==n) then
         write(*,'(a,/)')""
         print*,"ATENCAO: Tolerancia nao atingida!"
         print*,"MOTIVO: Numero maximo de iteracoes atingido."
         write(*,'(a,/)')""
         print*,"RESULTADOS:"
         print*,"Raiz:               ",rn
         print*,"Tempo total:        ",finish-start,"segundos"
         if (cont<=2000000) then
            print*,"Numero de iteracoes:",int(cont)
         else
            print*,"Numero de iteracoes:",cont
         end if
         print*,"Erro absoluto:      ",aux/rn
         resultado_newton%result_newton=rn
         resultado_newton%tempo_newton=finish-start
         resultado_newton%iteracoes_newton=cont
      else
         write(*,'(a,/)')""
         print*,"RESULTADOS:"
         print*,"Raiz:               ",rn
         print*,"Tempo total:        ",finish-start,"segundos"
         if (cont<=2000000) then
            print*,"Numero de iteracoes:",int(cont)
         else
            print*,"Numero de iteracoes:",cont
         end if
         print*,"Erro absoluto:      ",aux/rn
         resultado_newton%result_newton=rn
         resultado_newton%tempo_newton=finish-start
         resultado_newton%iteracoes_newton=cont
      end if
   end if
  
end subroutine

subroutine secante
   use var_geral
   use var_secante
   implicit none
   real(8)::f,f2
   cont=0.0d0
   write (*,'(a,/)') ""
   print*,"================================"
   print*, "   METODO SECANTE"
   print*,"================================"
   write (*,'(a,/)') ""   
   call entrada_dados
   if((f(a)*f2(a))<0.0d0) then
      write(*,'(a,/)')""
      print*,"Erro: Convergencia nao garantida!"
      print*,"Retornando ao menu principal!"
   else
      call entrada_dados
      call cpu_time(start)
      val_secante=.true.
      ra2=a
      ra=b
      cont=1.0d0
      aux=rn-ra
      
      if(aux<0.0d0) then
         aux=-aux
      end if
      if(rn<0.0d0) then
         rn=-rn
      end if
      
      rn=ra-f(ra)*(ra2-ra)/(f(ra2)-f(ra))
      ra2=ra
      ra=rn
      cont=cont+1.0d0
      
      do while (((aux/rn)>tol).and.(cont<n))
         rn=ra-f(ra)*(ra2-ra)/(f(ra2)-f(ra))
         ra2=ra
         ra=rn
         cont=cont+1.0d0
         aux=rn-ra
         
         if (aux<0.0d0) then
            aux=-aux
         end if
         if (rn<0.0d0) then
            rn=-rn
         end if
      end do
      call cpu_time(finish)
      if ((aux/rn>tol).and.(cont==n)) then
         write(*,'(a,/)')""
         print*,"ATENCAO: Tolerancia nao atingida!"
         print*,"MOTIVO: Numero maximo de iteracoes atingido."
         write(*,'(a,/)')""
         print*,"RESULTADOS:"
         print*,"Raiz:               ",rn
         print*,"Tempo total:        ",finish-start,"segundos"
         if (cont<=2000000) then
            print*,"Numero de iteracoes:",int(cont)
         else
            print*,"Numero de iteracoes:",cont
         end if
         print*,"Erro absoluto:      ",aux/rn
         resultado_secante%result_secante=rn
         resultado_secante%iteracoes_secante=cont
      else
         write(*,'(a,/)')""
         print*,"RESULTADOS:"
         print*,"Raiz:",rn
         print*,"Tempo total:        ",finish-start,"segundos"
         if (cont<=2000000) then
            print*,"Numero de iteracoes:",int(cont)
         else
            print*,"Numero de iteracoes:",cont
         end if
         print*,"Erro absoluto:      ",aux/rn
         resultado_secante%result_secante=rn
         resultado_secante%tempo_secante=finish-start
         resultado_secante%iteracoes_secante=cont
      end if
   end if   
end subroutine

subroutine entrada_dados
   use var_geral
   use var_bissecao
   use var_cordas
   use var_newton
   use var_secante
   implicit none
   
   write(*,'(a,/)')""
   print*,"Deseja usar os valores ja digitados?[s/n]"
   read*,sn
   
   do while ((sn/='s').and.(sn/='n'))
      write(*,'(a,/)')""
      print*,"ERRO: Opcao desconhecida!"
      print*,"Tente novamente."
      read*,sn
   end do
   
   if (sn=='n') then
      print*,"Digite o valor inicial"
      read*,a
     if (teste_newton .eqv. .false.) then
         print*,"Digite o valor final"
         read*,b
      end if
      print*,"Digite a tolerancia"
      read*,tol
      print*,"Digite o numero maximo de iteracoes"
      read*,n
   else
      aux=0.0d0
      if (val_bissecao .eqv. .false.) then
         aux=aux+1.0d0
      end if
      if (val_cordas .eqv. .false.) then
         aux=aux+1.0d0
      end if
      if (val_newton .eqv. .false.) then
         aux=aux+1.0d0
      end if
      if (val_secante .eqv. .false.) then
         aux=aux+1.0d0
      end if
      
      if (aux==4.0d0) then
         print*,"ERRO: Valores de entradas desconhecidos!"
         print*,"Digite o valor inicial"
         read*,a
         if(teste_newton .eqv. .false.) then
            print*,"Digite o valor final"
            read*,b
         end if
         print*,"Digite a tolerancia"
         read*,tol
         print*,"Digite o numero maximo de iteracoes"
         read*,n
       else  
         print*,"Valores carregados com sucesso!"        
      end if
   end if   
end subroutine

subroutine grafico2d
   use var_grafico
   implicit none
   real(8)::f
   valorx=0.0d0
   valory=0.0d0
   xmin=0.0d0
   xmax=0.0d0
   divisoes=0
   aux1=0.0d0
   aux2=0.0d0

   print*,"Digite o nome do arquivo"
   read*,file_name
 
   dat=trim(file_name)//'.dat'
   
   eps=trim(file_name)//'.eps'
   
   pdf=trim(file_name)//'.pdf'
   
   plt=trim(file_name)//'.plt'
   
   write(*,'(a,/)')""
   print*,"Usar configuracoes padroes?[s/n]"
   read*,chat
   do while((chat/='n').and.(chat/='s'))
      print*,"ERRO! Opcao desconhecida!"
      print*,"Digite novamente"
      read*,chat
   end do
   
   if (chat=='s') then
      title='ENTRE AQUI COM O TITULO PADRAO DO GRAFICO'
      xlabel='ENTRE AQUI COM O NOME PADRAO DO X'
      ylabel='ENTRE AQUI COM O NOME PADRAO DO Y'      
      
      xmax=10.0d0
      xmin=5.0d0
      divisoes=100
      
   else
      
      write(*,'(a,/)')""
      print*,"Digite o titulo do grafico"
      read*,title
      print*,"Digite o nome dos valores x"
      read*,xlabel
      print*,"Digite o nome dos valores y"
      read*,ylabel
      
      open(2,file=trim(dat),status='unknown')
      
      write(*,'(a,/)')""
      print*,"Digite o xmin e xmax respectivamente."
      read*,xmin,xmax
      
      do while(xmax<xmin)
         print*,"ERRO! xmax menor do que xmin"
         print*,"Tente novamente!"
         
         write(*,'(a,/)')""
         print*,"Digite o xmin e xmax respectivamente."
         read*,xmin,xmax
      end do

      print*,"Digite o numero de pontos do grafico.(No de pontos. 0<n<2,000,000)"
      read*,divisoes
      
      do while (divisoes<0)
         print*,"ERRO! O numero de pontos so pode ser positivo!"
         print*,"Tente novamente"
         read*,divisoes
      end do
      
   end if
   
   aux1=xmax-xmin
   aux1=aux1/divisoes
   aux2=xmin
   
   open(2,file=dat,status='unknown')
   do i=1,divisoes,1
      valory=f(aux2)
      write(2,*) aux2,valory
      aux2=aux2+aux1      
   end do
   close(2)
   open(2,file=plt,status='unknown')
   write(2,*) 'set encoding iso_8859_15'
   write(2,*) 'set term postscript enhanced solid color "TimesNewRoman" 22'
   write(2,*) 'set output "',trim(eps),'"'
   write(2,*) 'set title  "',trim(title),'"'
   write(2,*) 'set xlabel "',trim(xlabel),'"'
   write(2,*) 'set ylabel "',trim(ylabel),'"'
   write(2,*) 'set xrange [',xmin,':',xmax,']'
   write(2,*) 'plot "', trim(dat),'" u 1:2 notitle ""w p ps 1.5 pt 7 lc 1 , \'
   write(2,*) '     "', trim(dat),'" u 1:2 notitle ""w l lw 3 lt 1'      
   close(2)
   
   comandos='gnuplot '//trim(plt)
   call system (comandos)
   comandos='ps2pdf '//trim(eps)//' '//trim(pdf)
   call system (comandos)
   write(*,'(a,/)')""
   print*,"Grafico feito com sucesso!"
   print*,"Arquivo de saida: PDF"

   print*,"Deseja excluir os arquivos criado durante a producao do grafico?[s/n]"
   read*,chat
   do while((chat/='s').and.(chat/='n'))
      print*,"ERRO! Opcao desconhecida!"
      print*,"Tente novamente."
      read*,chat
   end do
   
   if (chat=='s') then
            
      write(*,'(a,/)') ""
      print*,"1) Informar arquivos manualmente"
      print*,"2) Todos, exceto o .pdf"
      print*,"0) Cancelar"
      read*,i
      
      do while((i<0).and.(i>2))
         print*,"ERRO! Opcao desconhecida!"
         print*,"Tente novamente"
         read*,i
      end do
      
      if (i/=0) then
         select case (i)
            case(1)
               chat='s'
               do while(chat=='s')
                  print*,"Arquivos atuais:"
                  comandos='ls -l'
                  call system(comandos)
                  write(*,'(a,/)') ""
                  print*,"Qual arquivo deseja excluir?"
                  read*,formato_usuario1
                  comandos='rm '//trim(formato_usuario1)
                  call system (comandos)
                  print*,"Deseja excluir mais um arquivo?[s/n]"
                  read*,chat
                     do while((chat/='s').and.(chat/='n'))
                        print*,"ERRO! Opcao desconhecida!"
                        print*,"Tente novamente."
                        read*,chat
                     end do
               end do
            case default
               comandos='rm '//trim(eps)
               call system(comandos)
               comandos='rm '//trim(dat)
               call system(comandos)
               comandos='rm '//trim(plt)
               call system(comandos)
         end select
       end if
   end if
end subroutine

subroutine comparacao
   use var_bissecao
   use var_cordas
   use var_geral
   use var_grafico
   use var_newton
   use var_secante
   implicit none
   
   write (*,'(a,/)') ""
   print*,"================================"
   print*, "   COMPARACAO DE VALORES"
   print*,"================================"
   write (*,'(a,/)') ""
   print*,"Metodo     Valor                      Tempo                      Iteracoes"                               
   if (val_cordas .eqv. .false.) then
      print*,"Cordas     None                      None                      None"
   else
      print*,"Cordas  ",resultado_cordas%result_cordas,resultado_cordas%tempo_cordas, &
      resultado_cordas%iteracoes_cordas
   end if
   
   if (val_newton .eqv. .false.) then
      print*,"Newton     None                      None                      None"
   else
      print*,"Newton  ", resultado_newton%result_newton,resultado_newton%tempo_newton, &
      resultado_newton%iteracoes_newton
   end if
   
   if (val_secante .eqv. .false.) then
      print*,"Secante    None                      None                      None"
   else
      print*,"Secante ", resultado_secante%result_secante, resultado_secante%tempo_secante, &
      resultado_secante%iteracoes_secante
   end if
  if (val_bissecao .eqv. .false.) then
      print*,"Bissecao    None                      None                      None"
   else
      print*,"Bissecao(",resultado_bissecao%resultado_a,&
      resultado_bissecao%resultado_b,")",resultado_bissecao%tempo_bissecao,&
      resultado_bissecao%iteracoes_bissecao
   end if
   
end subroutine 
real(8) function f(x)
   implicit none
   real(8)::x  
   f=(x**3)-(3*x)-1
end function

real(8) function f1(x)
   implicit none
   real(8)::x
   f1=(3*(x**2))-3
end function

real(8) function f2(x)
   implicit none
   real(8)::x
   f2=6*x
end function
Scripts recomendados
Bubble Sort em Scilab
MoonScript - Agenda telefônica semifuncional em 101 linhas
Adicionar proxy no Internet Explorer na inicialização
Verifica se o link caiu e manda aviso por email - MIkrotik v5.*
Tranposta da matriz em Haskell
Comentários
Nenhum comentário foi encontrado.