POLINÔMIOS DE AJUSTES

Esta é uma pré-visualização de arquivo. Entre para ver o arquivo original

! Este programa calcula os valores das constantes alphas dos polinômios de ajuste de grau 1, 3 e 5 para a população de coelhos.
program poli_ajustes
implicit none
real,dimension(2)::a11,a21,b01,c_I1,saida1 !POLINÕMIO DE GRAU 1
real,dimension(2,2)::A1 !POLINÕMIO DE GRAU 1
real,dimension(2,1)::B1 !POLINÕMIO DE GRAU 1
real::o,p,m,z,l,u ! POLINÔMIO DE GRAU 1
real, dimension (:,:), allocatable :: A
 real, dimension (:,:), allocatable :: lambda
 real, dimension (:), allocatable :: x
 integer :: i,j,k,N
 real :: soma
c_I1(1)=0.0
c_I1(2)=0.0
!POLINÕMIO DE GRAU 1
open(unit=577,file='mq1.txt',status='old')
 
 do i=1,2
 read(577,*)a11(i),a21(i),b01(i)
end do
 
A1(1,1)=a11(1)
A1(1,2)=a21(1)
A1(2,1)=a11(2)
A1(2,2)=a21(2)
B1(1,1)=b01(1)
B1(2,1)=b01(2)
o=A1(1,2)
p=A1(2,1)
m=B1(1,1)
z=B1(2,1)
l=A1(1,1)
u=A1(2,2)
call jacobi1(c_I1,saida1,o,p,m,z,l,u)
open(unit=455, file='p_ajuste1.txt')
do i=1,2
 write(455,*)saida1(i)
end do
!POLINÕMIO DE GRAU 3
open(unit=1547,file='mq3.txt',status='old')
 
 
 N = 4
 allocate(A(N,N+1))
 allocate(lambda(N,N))
 allocate(x(N))
 A(1,1) = 14.0000000
 A(1,2) = 24.3500023
 A(1,3) = 61.5903015
 A(1,4) = 180.367767
 A(1,5) = 11.6300001
 A(2,1) = 24.3500023
 A(2,2) = 61.5903015
 A(2,3) = 180.367767
 A(2,4) = 575.972900
 A(2,5) = 15.3855009
 A(3,1) = 61.5903015
 A(3,2) = 180.367767
 A(3,3) = 575.972900
 A(3,4) = 1948.03052
 A(3,5) = 35.8318024
 A(4,1) = 180.367767
 A(4,2) = 575.972900
 A(4,3) = 1948.03052
 A(4,4) = 6859.08496
 A(4,5) = 99.7567215
!Escalonamento
 do j=1,N-1
 if(A(j,j).eq.0.0) then
 write(*,*) 'Deu pau! Zero na diagonal!'
 write(*,*) 'Você deve parar o programa!'
 read(*,*)
 else
 do i=j+1,N
 lambda(i,j)=A(i,j)/A(j,j)
 do k=1,N+1
 A(i,k)=A(i,k)-lambda(i,j)*A(j,k)
 end do
 end do
 end if
 end do
!Substituição reversa
 x(N)=A(N,N+1)/A(N,N)
 do i=N-1,1,-1
 soma = 0.0
 do k=N,i+1,-1
 soma=soma+A(i,k)*x(k)
 end do
 x(i)=(A(i,N+1)-soma)/A(i,i)
 end do
open(unit=333,file='p_ajuste3.txt')
 do i=1,N
 write(333,*) x(i)
 end do
close(333)
close(1547)
close(455)
close(577)
end program poli_ajustes
! SUBROTINA PRA CALCULAR O POLINÔMIO DE AJUSTE DE GRAU 1
subroutine jacobi1(s1,s2,k,j,n,z,l,u)
 implicit none
real,intent(in)::k,j,n,z,l,u
real, dimension(2),intent(in)::s1
real, dimension(2), intent(out)::s2
 integer :: i
 real, dimension(101) :: x,y
x(1) = s1(1)
y(1) = s1(2)
do i = 1, 100
 x(i+1) = (n-k*y(i))/l
 y(i+1) = (z-j*x(i))/u
 
end do
s2(1)=x(101)
s2(2)=y(101)
return
end subroutine jacobi1