subroutine Gau_Sei(nx, a, b, eps, x)
! ガウスザイデル法による連立 1 次方程式ソルバ
implicit none
integer, intent(in) :: nx ! 第 1 成分の要素数
real, intent(in) :: a(nx,nx) ! 係数行列
real, intent(in) :: b(nx) ! ax=b のベクトル
real, intent(in) :: eps ! 収束条件
real, intent(inout) :: x(nx) ! 解く解
integer :: i, j, k, l, m, n ! イテレーション用添字
real :: xn ! 更新した x(i) のテンプ領域
real :: err, err_max ! 誤差
!-- 初期値は 0,0 からスタートする ---
x=0.0
!-- 以下, 実際のソルバ(while を使用するため, 1 回目のイテレートは単独で行う) ---
err_max=0.0
do i=1,nx
xn=0.0
if(i==1)then
do j=i+1,nx
xn=xn+a(i,j)*x(j)
end do
else
if(i/=1.and.i/=nx)then
do j=1,i-1
xn=xn+a(i,j)*x(j)
end do
do j=i+1,nx
xn=xn+a(i,j)*x(j)
end do
else
do j=1,i-1
xn=xn+a(i,j)*x(j)
end do
end if
end if
xn=(b(i)-xn)/a(i,i)
err=errata(x(i),xn,1)
write(*,*) "err_max", x(i), nx, err_max,err
if(err_max<=err)then
err_max=err
end if
x(i)=xn
end do
if(err_max<=eps)then
stop
end if
!-- 以下より, 収束条件を満たすまでループする ---
do while(err_max>=eps)
err_max=0.0
do i=1,nx
xn=0.0
if(i==1)then
do j=i+1,nx
xn=xn+a(i,j)*x(j)
end do
else
if(i/=1.and.i/=nx)then
do j=1,i-1
xn=xn+a(i,j)*x(j)
end do
do j=i+1,nx
xn=xn+a(i,j)*x(j)
end do
else
do j=1,i-1
xn=xn+a(i,j)*x(j)
end do
end if
end if
xn=(b(i)-xn)/a(i,i)
err=errata(x(i),xn,1)
if(err_max<=err)then
err_max=err
end if
x(i)=xn
end do
end do
contains
real function errata(x1, x2, n)
implicit none
real, intent(in) :: x1 ! 誤差比較
real, intent(in) :: x2 ! 誤差比較
integer, intent(in) :: n ! 誤差の種類 (n=1 : 相対誤差, n=2 : 絶対誤差)
if(n==1)then
if(abs(x1)==0.0)then
errata=(abs(x1-x2))/(abs(x2))
else
errata=(abs(x1-x2))/(abs(x1))
end if
else
errata=abs(x1-x2)
end if
end function errata
end subroutine Gau_Sei