Class Algebra
In: algebra.f90

代数演算を主に行うモジュール

Methods

Public Instance methods

Subroutine :
nx :integer, intent(in)
: 第 1 成分の要素数
a(nx,nx) :real, intent(in)
: 係数行列
b(nx) :real, intent(in)
: ax=b のベクトル
eps :real, intent(in)
: 収束条件
x(nx) :real, intent(inout)
: 解く解

ガウスザイデル法による連立 1 次方程式ソルバ

[Source]

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
Subroutine :
x(:) :real, intent(in)
: 積分変数
y(size(x)) :real, intent(in)
: 非積分関数
bot :real, intent(in)
: 積分区間左端
top :real, intent(in)
: 積分区間右端
res :real, intent(inout)
: 台形積分の積分値

1 次元台形積分 不等間隔でも計算可能であるが, 精度は保証しない.

[Source]

subroutine rectangle_int( x, y, bot, top, res )  ! 1 次元台形積分
  ! 不等間隔でも計算可能であるが, 精度は保証しない.
  implicit none
  real, intent(in) :: bot  ! 積分区間左端
  real, intent(in) :: top  ! 積分区間右端
  real, intent(in) :: x(:)  ! 積分変数
  real, intent(in) :: y(size(x))  ! 非積分関数
  real, intent(inout) :: res  ! 台形積分の積分値
  integer :: i, j, k, nx
  real :: dx

  nx=size(x)

  res=0.0
  do i=1,nx-1
     if(x(i)>=bot.and.x(i)<=top)then  ! 積分開始位置を決定
        res=res+0.5*(x(i+1)-x(i))*(y(i+1)+y(i))
     end if
  end do

end subroutine rectangle_int