module solver ! objetivo: resolver o sistema de equações algébricas com o método TDMA implicit none contains !------------------------------------------------------------------------------- subroutine TDMA ( N, aw, ap, ae, bp, T ) ! resolve a equação: ap(P)*T(P) = aw(P)*T(P-1) + ae(P)*T(P+1) + bp(P) implicit none integer :: P ! número do nó real*8 :: div ! variável auxiliar integer,intent(in) :: N ! número de elementos da malha real*8,intent(in), dimension(0:N) :: aw ! coeficiente oeste real*8,intent(in), dimension(0:N) :: ap ! coeficiente central real*8,intent(in), dimension(0:N) :: ae ! coeficiente leste real*8,intent(in), dimension(0:N) :: bp ! termo fonte real*8,intent(out),dimension(0:N) :: T ! incógnita real*8,dimension(:),allocatable :: ps ! coeficiente do tdma real*8,dimension(:),allocatable :: qs ! coeficiente do tdma allocate(ps(0:N),qs(0:N)) ps(0) = ae(0) / ap(0) qs(0) = bp(0) / ap(0) do P = 1, N div = ap(P) - aw(P)*ps(P-1) ps(P) = ae(P) / div qs(P) = (bp(P) + aw(P)*qs(P-1))/div end do T(N) = qs(N) do P = N-1, 0, -1 T(P) = ps(P)*T(P+1) + qs(P) end do deallocate(ps,qs) end subroutine tdma !------------------------------------------------------------------------------- end module solver