Então, está aí minha contribuição pra vocês.  As instruções estão no arquivo.  

No código-fonte, aqui em baixo, colocarei somente o programa, mas no arquivo disponibilizado encontra-se todas as informações que achei que poderiam ser úteis, junto com a descrição completa do mesmo.

• Download Integral.f90
• Enviar nova versão

Esconder código-fonte

module geral 
   implicit none   
   real(8)::a
   real(8)::b
   real(8)::aux
   real(8)::aux2
   real(8)::aux3
   real(8)::resul
   real(8)::h
   character::sn
   integer::i
   integer(8)::iteracoes
end module

module var_retangulo 
   implicit none
   real(8)::result_met1=0.0d0
   real(8)::result_met2=0.0d0
   real(8)::result_met3=0.0d0
   integer::val_ret=0
end module

module var_trapezio 
   implicit none 
   real(8)::result_trap=0.0d0
   integer::val_trap=0
end module

module var_simpson 
   implicit none   
   real(8)::result_simp=0.0d0
   integer::val_simp=0
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 integrais 
   implicit none
   
   integer::menu
   integer::val_rm
   real(8)::f,x
   character::wl
   character::gp
   character(1000)::comando1
   
   val_rm=0
   
   write(*,'(a,/)')""
   print*,"============================================"
   print*,"PROGRAMA PARA CALCULO DE INTEGRAIS PROPRIAS"
   print*,"============================================"
   write(*,'(a,/)')""
   write(*,'(a,/)')"" 
   print*,"Usando Windows/Linux?[w/l]" 
   read*,wl 
   
   do while ((wl/='w').and.(wl/='l')) 
      print*,"ERRO: Opcao invalida!"
      print*,"Tente novamente."
      read*,wl
   end do
   
   menu=1
   if (wl=='l') then 
      do while (menu/=0)
         print*,"============================================"
         print*,"               MENU PRINCIPAL"
         print*,"============================================"
   
         write(*,'(a,/)')""
         print*,"1) Regra do Ponto Medio ou dos retangulos "
         print*,"2) Regra Trapezoidal"
         print*,"3) Regra de Simpson"
         print*,"4) Comparacao de resultados"
         print*,"5) Grafico"
         print*,"0) Sair"
         read*,menu
         
         do while ((menu<0).or.(menu>5))
            print*,"ERRO: Opcao Desconhecida!"
            print*,"Tente Novamente."
            read*, menu
         end do
         
         if (menu/=0) then
            select case (menu)
               case(1)
                  call  retangulo
               case(2)
                  call trapezio
               case(3)
                  call simpson
               case(4)
                  call comparacao
               case default
                  call grafico2d(val_rm) 
            end select
         end if
      end do
      if (val_rm==1) then 
         comando1='rm geral.mod' 
         call system (comando1) 
         comando1='rm var_retangulo.mod' 
         call system (comando1)
         comando1='rm var_trapezio.mod'
         call system (comando1)
         comando1='rm var_simpson.mod'
         call system (comando1)
         comando1='rm var_grafico.mod'
         call system (comando1)
      end if
        else
         do while (menu/=0) 
            print*,"============================================"
            print*,"               MENU PRINCIPAL"
            print*,"============================================"
   
            write(*,'(a,/)')""
            print*,"1) Regra do Ponto Medio ou dos retangulos "
            print*,"2) Regra Trapezoidal"
            print*,"3) Regra de Simpson"
            print*,"4) Comparacao de resultados"
            print*,"0) Sair"
            read*,menu
            
         do while ((menu<0).or.(menu>4))
            print*,"ERRO: Opcao Desconhecida!"
            print*,"Tente Novamente."
            read*, menu
         end do
         
         if(menu/=0) then
            select case (menu)
               case(1)
                  call  retangulo
               case(2)
                  call trapezio
               case(3)
                  call simpson
               case default
                  call comparacao
            end select
         end if
      end do
   end if
end program

subroutine retangulo
   use var_retangulo
   implicit none
   
   call chamada
   val_ret=1
   call metodo1
   call metodo2
   call metodo3
end subroutine

subroutine trapezio
   use geral
   use var_trapezio
   implicit none
   real(8)::f
   call chamada
   val_trap=1   
   
   h=(b-a)/ DFLOAT(iteracoes)
   aux=a+h
   resul=0.0d0
   
   do i=1,iteracoes-1,1
      resul=resul+f(aux)
      aux=aux+h
   end do
   
   resul=resul*2.0d0
   resul=resul+f(a)
   resul=resul+f(b)
   resul=resul*h
   resul=resul/2.0d0
   
   print*,"Resultado metodo dos Trapezios",resul
   result_trap=resul
end subroutine

subroutine simpson
   use var_simpson
   use geral
   implicit none
   real(8)::f
   call chamada
   val_simp=1
   
   aux=a
   aux2=0.0d0
   aux3=0.0d0
   
   if(mod(iteracoes,2)/=0) then
      write (*,'(A,/)') ""
      print*,"ERRO"
      print*,"Nao e possivel calcular com um numero de integracoes impares, por favor escolha um numero par."
      write (*,'(A,/)') ""
   else
      h=(b-a)/ DFLOAT(iteracoes)
      
      do i=1,iteracoes-1
         aux=aux+h
         if (mod(i,2)==0) then
            aux2=aux2+f(aux)
         else
            aux3=aux3+f(aux)
         end if
      end do
      
      aux2=aux2*2
      aux3=aux3*4
      resul=f(a)+f(b)
      resul=resul+aux2+aux3
      resul=resul*h
      resul=resul/3
      
      print*,"O resultado do método de Simpson é:",resul
      result_simp=resul
   end if      
end subroutine

subroutine comparacao
   use var_retangulo
   use var_simpson
   use var_trapezio
   implicit none
   write(*,'(a,/)')""
   print*,"=========================================="
   print*,"              COMPARACOES"
   print*,"=========================================="
   write(*,'(a,/)')""
   print*,"METODO     ######################### VALOR"
   if (val_trap==0) then
      write(*,'(a,/)')""
      print*,"Trapezio   #########################  NONE"
   else
      write(*,'(a,/)')""
      print*,"Trapezio   #########################", result_trap         
   end if
   
   if (val_simp==0) then
      write(*,'(a,/)')""
      print*,"Simpson    #########################  NONE"
   else
      write(*,'(a,/)')""
      print*,"Simpson    #########################", result_simp         
   end if
   
   if (val_ret==0) then
      write(*,'(a,/)')""
      print*,"Retangulos #########################  NONE"
   else
      write(*,'(a,/)')""
      print*,"Retangulos #########################   -----"
      print*,"         h*SUM(f(Xi))    ###########",result_met1
      print*,"       h*SUM(f(Xi+1))    ###########",result_met1
      print*,"h*SUM((f(Xi)+f(Xi+1)/2)) ###########",result_met1         
   end if
end subroutine 

subroutine grafico2d(val_rm)
   use var_grafico
   implicit none
   real(8)::f
   integer::val_rm
   valorx=0.0d0
   valory=0.0d0
   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
      
      val_rm=1      
      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
   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
subroutine chamada
   use geral
   use var_retangulo
   use var_simpson
   use var_trapezio
   implicit none
   
   aux=0.0d0
   if (val_ret==0) then
      aux=aux+1.0d0
   end if
   if (val_trap==0) then
      aux=aux+1.0d0
   end if
   if (val_simp==0) then
      aux=aux+1.0d0
   end if
   
   write(*,'(a,/)')""
   print*,"Deseja usar os valores já digitados?[s/n]"
   read*,sn
   
   do while((sn/='n').and.(sn/='s'))
      print*,"ERRO! Opcao desconhecida!"
      print*,"Digite novamente"
      read*,sn
   end do
      
   if((sn=='s').and.(aux==3.0d0)) then
      write(*,'(a,/)')""
      print*,"ERRO: Valores de entrada desconhecidos!"
   end if
   
   if((sn=='n').or.(aux==3.0d0)) then
      print*,"Digite o intervalo a (min) e b (max), respectivamente"
      read*,a
      read*,b
      print*,"Digite a número de integrações"
      read*,iteracoes
   end if
end subroutine

subroutine metodo1
   use geral
   use var_retangulo
   implicit none
   real(8)::f
   
   h=(b-a)/ DFLOAT(iteracoes)
   aux=a
   resul=f(a)
   do i=1,iteracoes-1,1
      aux=aux+h
      resul=resul+f(aux)      
   end do
   resul=resul*h
   
   print*,"Resultado metodo dos trapezios h*SUM(f(Xi)):",resul
   result_met1=resul
end subroutine

subroutine metodo2
   use geral
   use var_retangulo
   implicit none
   real(8)::f
   
   h=(b-a)/ DFLOAT(iteracoes)
   aux=a
   resul=f(a)
   do i=1,iteracoes,1
      aux=aux+h
      resul=resul+f(aux)      
   end do
   resul=resul*h
   
   print*,"Resultado metodo dos trapezios h*SUM(f(Xi+1)):",resul
   result_met2=resul
end subroutine

subroutine metodo3
   use geral
   use var_retangulo
   implicit none
   real(8)::f
   
   h=(b-a)/ DFLOAT(iteracoes)
   aux=a
   aux2=aux+h
   aux3=(aux+aux2)/2.0d0
   resul=f(aux3)
   
   do i=1,iteracoes-1,1
      aux=aux+h
      aux2=aux+h
      aux3=(aux+aux2)/2.0d0
      resul=resul+f(aux3)
   end do
   
   resul=resul*h
   
   print*,"Resultado metodo dos trapezios h*SUM((f(Xi)+f(Xi+1)/2)):",resul
   result_met3=resul    
end subroutine

real(8) function f(x)
   implicit none
   real(8)::x
   
   f=x**2
end function

Tranposta da matriz em Haskell

Zfehwallpaper - wallpaper no Openbox

Programação para sistemas embarcados em Assembly

Adicionar proxy no Internet Explorer na inicialização

Perguntas e respostas com Assembly e NASM