Fortran - Integrais
Publicado por Rastaplaca (última atualização em 25/09/2015)
[ Hits: 5.108 ]
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.
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
Verifica se o link caiu e manda aviso por email - MIkrotik v5.*
SearchSploit-GTK: Interface gráfica simples para o searchsploit (Kali Linux)
Fazendo um ajuste não linear em dados experimentais - FORTRAN 90
Perguntas e respostas com Assembly e NASM
Compartilhando a tela do Computador no Celular via Deskreen
Como Configurar um Túnel SSH Reverso para Acessar Sua Máquina Local a Partir de uma Máquina Remota
Configuração para desligamento automatizado de Computadores em um Ambiente Comercial
Como renomear arquivos de letras maiúsculas para minúsculas
Imprimindo no formato livreto no Linux
Vim - incrementando números em substituição
Efeito "livro" em arquivos PDF
Como resolver o erro no CUPS: Unable to get list of printer drivers
Preciso resolver um erro de DPKG (1)
Melhores Práticas de Nomenclatura: Pastas, Arquivos e Código (2)
Não to conseguindo resolver este problemas ao instalar o playonelinux (1)
[Python] Automação de scan de vulnerabilidades
[Python] Script para analise de superficie de ataque
[Shell Script] Novo script para redimensionar, rotacionar, converter e espelhar arquivos de imagem
[Shell Script] Iniciador de DOOM (DSDA-DOOM, Doom Retro ou Woof!)
[Shell Script] Script para adicionar bordas às imagens de uma pasta