!//---------------原方程-------------
!// x + 2y - z = 3
!// 2x + y -2z = 3
!// -3x + y + z = -6
!//----------------------------------
!// 本代實現了LU分解，但是並不是所有的矩陣都能進行LU分解
!// 後面會介紹PA=LU，可以解決所有問題
!// 爲什麼要進行LU分解
!// 使用LU分解方法代替高斯消去法的主要原因是由於如下系統的存在
!// Ax=B1, Ax=B2, Ax=B3,...,Ax=Bk。一般稱A爲結構矩陣
!// 經典高斯消去法對每一個Ax=B都要分解，但是因爲系統有相同的A，LU分解將Bk獨立出來，只進行一次LU分解即可
Module mod
Implicit none
Integer, parameter :: m = 3 !// 方程的階數
Real(kind=8) :: a(m,m) = [ 1.d0, 2.d0, -3.d0, 2.d0, 1.d0, 1.d0, -1.d0, -2.d0, 1.d0 ]
Real(kind=8) :: origin_b(m) = [ 3.d0, 3.d0, -6.d0 ]
Real(kind=8) :: c(m) = 0.d0, x(m) = 0.d0
Real(kind=8) :: U(m,m) = 0.d0, L(m,m) = 0.d0
!// origin_b存放初始右端項，用來計算Lc = b,計算c
!// 然後利用Ux = c，求解x
Contains
Subroutine GetLU ( )
Implicit none
Integer :: i, j, k
Real(kind=8), parameter :: eps = 1.d-5 !// 當主元小於這個數時，程序退出
Real(kind=8) :: mult
Write ( *,'(1x,a)' ) '原係數矩陣a爲：'
Do i = 1, m
Write ( *,'(*(f12.5))' ) ( a(i,j), j = 1, m )
End do
!// 對下三角矩陣對角線賦值
forall ( i = 1:m, j = 1:m, i == j ) L(i,j) = 1.d0
!// 計算上三角矩陣和下三角矩陣
U = a
Do j = 1, m - 1
If ( abs(U(j,j)) < eps ) Then
Write ( *,'(1x,a)' ) ' The pivot is zero!'
stop
End if
Do i = j + 1, m
mult = U(i,j) / U(j,j)
L(i,j) = mult
Do k = j, m
U(i,k) = U(i,k) - mult * U(j,k)
End do
End do
End do
!// 得到上三角矩陣
Write ( *,'(1x,a)' ) '上三角矩陣爲：'
Do i = 1, m
Write ( *,'(*(f12.5))' ) ( U(i,j), j = 1, m )
End do
Write ( *,'(1x,a)' ) '下三角矩陣爲：'
Do i = 1, m
Write ( *,'(*(f12.5))' ) ( L(i,j), j = 1, m )
End do
End subroutine GetLU
Subroutine BackSubstitution ( )
Implicit none
Integer :: i, j
!// 求c: Lc = origin_b
Do i = 1, m
Do j = 1, i-1
origin_b(i) = origin_b(i) - L(i,j) * c(j)
End do
c(i) = origin_b(i) / L(i,i)
End do
!// 求x: Ux = c
Do i = m, 1, -1
Do j = i + 1, m
c(i) = c(i) - U(i,j) * x(j)
End do
x(i) = c(i) / U(i,i)
End do
Write ( *,'(1x,a)' ) '原方程解爲：'
Do i = 1, m
Write ( *,'(f12.5)' ) x(i)
End do
End subroutine BackSubstitution
End module mod
Program LU_Factorization
Use mod
Implicit none
call GetLU ( )
call BackSubstitution ( )
End program LU_Factorization
!// 對另一方程組進行驗證。x=[1,2,3,4]
!//---------------原方程-------------
!// x + y + z + w = 10
!// 2x + 3y + z + w = 15
!// 3x - y + 2z - w = 3
!// 4x + y -3z + 2w = 5
!//----------------------------------
!Module mod
! Implicit none
! Integer, parameter :: m = 4 !// 方程的階數
! Real(kind=8) :: a(m,m) = [ 1.d0, 2.d0, 3.d0, 4.d0, 1.d0, 3.d0, -1.d0, 1.d0, 1.d0, 1.d0, 2.d0, -3.d0, 1.d0, 1.d0, -1.d0, 2.d0 ]
! Real(kind=8) :: origin_b(m) = [ 10.d0, 15.d0, 3.d0, 5.d0 ]
! Real(kind=8) :: c(m) = 0.d0, x(m) = 0.d0
! Real(kind=8) :: U(m,m) = 0.d0, L(m,m) = 0.d0
! !// origin_b存放初始右端項，用來計算Lc = b,計算c
! !// 然後利用Ux = c，求解x
!Contains
!Subroutine GetLU ( )
! Implicit none
! Integer :: i, j, k
! Real(kind=8), parameter :: eps = 1.d-5 !// 當主元小於這個數時，程序退出
! Real(kind=8) :: mult
!
! Write ( *,'(1x,a)' ) '原係數矩陣a爲：'
! Do i = 1, m
! Write ( *,'(*(f12.5))' ) ( a(i,j), j = 1, m )
! End do
!
! !// 對下三角矩陣對角線賦值
! forall ( i = 1:m, j = 1:m, i == j ) L(i,j) = 1.d0
!
! !// 計算上三角矩陣和下三角矩陣
! U = a
! Do j = 1, m - 1
! If ( abs(U(j,j)) < eps ) Then
! Write ( *,'(1x,a)' ) ' The pivot is zero!'
! stop
! End if
! Do i = j + 1, m
! mult = U(i,j) / U(j,j)
! L(i,j) = mult
! Do k = j, m
! U(i,k) = U(i,k) - mult * U(j,k)
! End do
! End do
! End do
!
! !// 得到上三角矩陣
! Write ( *,'(1x,a)' ) '上三角矩陣爲：'
! Do i = 1, m
! Write ( *,'(*(f12.5))' ) ( U(i,j), j = 1, m )
! End do
!
! Write ( *,'(1x,a)' ) '下三角矩陣爲：'
! Do i = 1, m
! Write ( *,'(*(f12.5))' ) ( L(i,j), j = 1, m )
! End do
!
!End subroutine GetLU
!
!Subroutine BackSubstitution ( )
! Implicit none
! Integer :: i, j
!
! !// 求c: Lc = origin_b
! Do i = 1, m
! Do j = 1, i-1
! origin_b(i) = origin_b(i) - L(i,j) * c(j)
! End do
! c(i) = origin_b(i) / L(i,i)
! End do
!
! !// 求x: Ux = c
! Do i = m, 1, -1
! Do j = i + 1, m
! c(i) = c(i) - U(i,j) * x(j)
! End do
! x(i) = c(i) / U(i,i)
! End do
!
! Write ( *,'(1x,a)' ) '原方程解爲：'
! Do i = 1, m
! Write ( *,'(f12.5)' ) x(i)
! End do
!
!End subroutine BackSubstitution
!
!End module mod
!
!
!Program LU_Factorization
! Use mod
! Implicit none
! call GetLU ( )
! call BackSubstitution ( )
!End program LU_Factorization
!
