Class Alge_Solv
In: alge_solv.f90

代数演算を用いて偏微分方程式を解くモジュール

Methods

Public Instance methods

Subroutine :
nx :integer, intent(in)
: x 方向の配列要素
ny :integer, intent(in)
: y 方向の配列要素
dx :real, intent(in)
: x 方向の格子間隔
dy :real, intent(in)
: y 方向の格子間隔
rho(nx,ny) :real, intent(in)
: ポアソン方程式の強制項 rho =0 でラプラス方程式も求積可能
eps :real, intent(in)
: 収束条件
boundary :integer, intent(in)
: 境界条件 boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
psi(nx,ny) :real, intent(inout)
: ポアソン方程式の解
bound_opt(nx,ny) :real, intent(in), optional
: 固定端境界の場合 : 境界値 ノイマン境界の場合 : フラックス値

ガウス=ザイデル法によるポアソン方程式の求積

[Source]

subroutine Poisson_GauSei(nx, ny, dx, dy, rho, eps, boundary, psi, bound_opt)
! ガウス=ザイデル法によるポアソン方程式の求積
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
                   ! rho =0 でラプラス方程式も求積可能
  real, intent(in) :: eps  ! 収束条件
  integer, intent(in) :: boundary  ! 境界条件
                   ! boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
  real, intent(in), optional :: bound_opt(nx,ny)  ! 固定端境界の場合 : 境界値
                                        ! ノイマン境界の場合 : フラックス値
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  integer :: i, j, k, l, m, n
  real :: tmp, err, err_max

  psi = 0.0

  select case (boundary)

  case(1)
     if(present(bound_opt))then
        call fix(nx,ny,dx,dy,eps,rho,psi,bound_opt)
     else
        call fix(nx,ny,dx,dy,eps,rho,psi)
     end if

  case(2)
     if(present(bound_opt))then
        call free(nx,ny,dx,dy,eps,rho,psi,bound_opt)
     else
        call free(nx,ny,dx,dy,eps,rho,psi)
     end if

  case(3)
     call period(nx,ny,dx,dy,eps,rho,psi)

  end select

contains

subroutine fix(nx,ny,dx,dy,eps,rho,psi,bound_opt)
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
  real, intent(in) :: eps  ! 収束条件
  real, intent(in), optional :: bound_opt(nx,ny)  ! 固定端境界の場合の境界値, デフォルトはゼロ
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  integer :: i, j, k, l, m, n
  real :: delta, err_max, err
  real :: bnd(nx,ny)

  if(present(bound_opt))then
     do j=1,ny
        do i=1,nx
           bnd(i,j)=bound_opt(i,j)
        end do
     end do
  else
     do j=1,ny
        do i=1,nx
           bnd(i,j)=0.0
        end do
     end do
  end if

  delta=dx/dy
!-- 固定端の設定 ---
  psi(1,:)=bnd(1,:)
  psi(nx,:)=bnd(nx,:)
  psi(:,1)=bnd(:,1)
  psi(:,nx)=bnd(:,nx)

  err_max=eps  ! while に入るための便宜的措置

!-- 実際のソルバ ---
  do while(err_max>=eps)
     err_max=0.0
  do j=2,ny-1
     do i=2,nx-1
        tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))

!-- 誤差の計算 ---
        if(psi(i,j)==0.0)then
           err=abs(tmp-psi(i,j))/abs(tmp)
        else
           err=abs(tmp-psi(i,j))/abs(psi(i,j))
        end if

!-- 最大誤差の更新
        if(err_max<=err)then
           err_max=err
        end if

        psi(i,j)=tmp

     end do
  end do
  end do
  

end subroutine fix

subroutine free(nx,ny,dx,dy,eps,rho,psi,bound_flx)
  ! ノイマン型境界条件なので, du/dx=f の境界では, 境界の1つ内側について
  ! if 文で別の処理をする. 具体的には,
  ! u(i,j)=u(i-1,j)+f*dx という関係式があるので,
  ! u(i-1,j) には, u(i,j)-f*dx を代入する.
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
  real, intent(in) :: eps  ! 収束条件
  real, intent(in), optional :: bound_flx(nx,ny)  ! 境界におけるノイマン勾配の値
        ! デフォルトでは, 0 で計算
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  integer :: i, j, k, l, m, n
  real :: delta, err_max, err
  real :: flx(nx,ny)

  if(present(bound_opt))then
     do j=1,ny
        do i=1,nx
           flx(i,j)=bound_opt(i,j)
        end do
     end do
  else
     do j=1,ny
        do i=1,nx
           flx(i,j)=0.0
        end do
     end do
  end if

  delta=dx/dy

  err_max=eps  ! while に入るための便宜的措置

!-- 実際のソルバ ---
  do while(err_max>=eps)
     err_max=0.0

  do j=2,ny-1
     do i=2,nx-1
        if(i/=2.and.i/=nx-1.and.j/=2.and.j/=nx-1)then
           ! 境界の 1 つ内側以外
           tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
        else
!-- ここから下は if 文のインデントを調節しない.
           if(i==2)then  ! 左境界での扱い
              if(j==2)then  ! 左下境界での扱い.
                 tmp=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)-flx(i,j)*dx+delta**2*(psi(i,j+1)-flx(i,j)*dy)))
              else
                 if(j==ny-1)then  ! 左上境界での扱い.
                    tmp=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)-flx(i,j)*dx+delta**2*(psi(i,j+1)+flx(i,j)*dy)))
                 else
                    tmp=(1.0/(1.0+2.0*delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)-flx(i,j)*dx+delta**2*(psi(i,j+1)+psi(i,j-1))))
                 end if
              end if
           else
              if(i==nx-1)then  ! 右境界での扱い.
                 if(j==2)then  ! 右下境界での扱い.
                    tmp=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+flx(i,j)*dx+delta**2*(psi(i,j+1)-flx(i,j)*dy)))
                 else
                    if(j==ny-1)then  ! 右上境界での扱い.
                       tmp=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+flx(i,j)*dx+delta**2*(psi(i,j+1)+flx(i,j)*dy)))
                    else
                       tmp=(1.0/(1.0+2.0*delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+flx(i,j)*dx+delta**2*(psi(i,j+1)+psi(i,j-1))))
                    end if
                 end if
              else
                 if(j==2)then  ! 下側境界での扱い.
                    tmp=(1.0/(2.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)-flx(i,j)*dy)))
                 else  ! 上側境界での扱い.
                    tmp=(1.0/(2.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+flx(i,j)*dy)))
                 end if
              end if
           end if
!-- ここまでは if 文のインデントを調節しない.
        end if

!-- 誤差の計算 ---
        if(psi(i,j)==0.0)then
           err=abs(tmp-psi(i,j))/abs(tmp)
        else
           err=abs(tmp-psi(i,j))/abs(psi(i,j))
        end if

!-- 最大誤差の更新
        if(err_max<=err)then
           err_max=err
        end if

        psi(i,j)=tmp

     end do
  end do

!-- 境界条件の設定
     psi(2:nx-1,1)=psi(2:nx-1,2)-flx(2:nx-1,1)*dy
     psi(1,2:ny-1)=psi(2,2:ny-1)-flx(1,2:ny-1)*dx
     psi(2:nx-1,ny)=psi(2:nx-1,ny-1)+flx(2:nx-1,ny)*dy
     psi(nx,2:ny-1)=psi(nx-1,2:ny-1)+flx(1,2:ny-1)*dx
!-- 4 隅の条件の設定
     psi(1,1)=0.5*(psi(1,2)+psi(2,1)-flx(1,1)*(dx+dy))
     psi(1,ny)=0.5*(psi(1,ny-1)+psi(2,ny)-flx(1,ny)*(dx-dy))
     psi(nx,1)=0.5*(psi(nx,2)+psi(nx-1,1)-flx(nx,1)*(dy-dx))
     psi(nx,ny)=0.5*(psi(nx,ny-1)+psi(nx-1,ny)+flx(nx,ny)*(dx+dy))

  end do
 

end subroutine free

subroutine period(nx,ny,dx,dy,eps,rho,psi)
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
  real, intent(in) :: eps  ! 収束条件
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  integer :: i, j, k, l, m, n
  real :: delta, err_max, err

  delta=dx/dy

  err_max=eps  ! while に入るための便宜的措置

!-- 実際のソルバ ---
  do while(err_max>=eps)
     err_max=0.0

  do j=2,ny-1
     do i=2,nx-1
        if(i/=2.and.i/=nx-1.and.j/=2.and.j/=nx-1)then
           ! 境界の 1 つ内側以外
           tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
        else
!-- ここから下は if 文のインデントを調節しない.
           if(i==2)then  ! 左境界での扱い
              if(j==2)then  ! 左下境界での扱い.
                 tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(nx-1,j)+delta**2*(psi(i,j+1)+psi(i,ny-1))))
              else
                 if(j==ny-1)then  ! 左上境界での扱い.
                    tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(nx-1,j)+delta**2*(psi(i,2)+psi(i,j-1))))
                 else
                    tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(nx-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
                 end if
              end if
           else
              if(i==nx-1)then  ! 右境界での扱い.
                 if(j==2)then  ! 右下境界での扱い.
                    tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(2,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,ny-1))))
                 else
                    if(j==ny-1)then  ! 右上境界での扱い.
                       tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(2,j)+psi(i-1,j)+delta**2*(psi(i,2)+psi(i,j-1))))
                    else
                       tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(2,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
                    end if
                 end if
              else
                 if(j==2)then  ! 下側境界での扱い.
                    tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,ny-1))))
                 else  ! 上側境界での扱い.
                    tmp=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,2)+psi(i,j-1))))
                 end if
              end if
           end if
!-- ここまでは if 文のインデントを調節しない.
        end if

!-- 誤差の計算 ---
        if(psi(i,j)==0.0)then
           err=abs(tmp-psi(i,j))/abs(tmp)
        else
           err=abs(tmp-psi(i,j))/abs(psi(i,j))
        end if

!-- 最大誤差の更新
        if(err_max<=err)then
           err_max=err
        end if

        psi(i,j)=tmp

     end do
  end do

!-- 境界条件の設定
     psi(2:nx-1,1)=psi(2:nx-1,ny-1)
     psi(1,2:ny-1)=psi(nx-1,2:ny-1)
     psi(2:nx-1,ny)=psi(2:nx-1,2)
     psi(nx,2:ny-1)=psi(2,2:ny-1)
!-- 4 隅の条件の設定
     psi(1,1)=0.5*(psi(1,ny-1)+psi(nx-1,1))
     psi(1,ny)=0.5*(psi(1,2)+psi(nx-1,ny))
     psi(nx,1)=0.5*(psi(nx,ny-1)+psi(2,1))
     psi(nx,ny)=0.5*(psi(nx,2)+psi(2,ny))
write(*,*) "###########", psi(nx/2,ny/2)
  end do

  

end subroutine period

end subroutine Poisson_GauSei
Subroutine :
nx :integer, intent(in)
: x 方向の配列要素
ny :integer, intent(in)
: y 方向の配列要素
dx :real, intent(in)
: x 方向の格子間隔
dy :real, intent(in)
: y 方向の格子間隔
rho(nx,ny) :real, intent(in)
: ポアソン方程式の強制項 rho =0 でラプラス方程式も求積可能.
eps :real, intent(in)
: 収束条件
boundary :integer, intent(in)
: 境界条件 ノイマン境界の場合 : フラックス値 boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
psi(nx,ny) :real, intent(inout)
: ポアソン方程式の解
bound_opt(nx,ny) :real, intent(in), optional
: 固定端境界の場合 : 境界値

ヤコビ法によるポアソン方程式の求積(開発中openmp) openmp によるスレッド並列が可能. ガウス・ザイデル法ではアルゴリズムの点から並列化が困難と思われたので, 並列計算によるポアソン方程式の求積が必要となるなら, ヤコビ法のものを使用されたい.

[Source]

subroutine Poisson_Jacobi(nx, ny, dx, dy, rho, eps, boundary, psi, bound_opt)
  ! ヤコビ法によるポアソン方程式の求積(開発中openmp)
  ! openmp によるスレッド並列が可能.
  ! ガウス・ザイデル法ではアルゴリズムの点から並列化が困難と思われたので,
  ! 並列計算によるポアソン方程式の求積が必要となるなら,
  ! ヤコビ法のものを使用されたい.
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
                    ! rho =0 でラプラス方程式も求積可能.
  real, intent(in) :: eps  ! 収束条件
  integer, intent(in) :: boundary  ! 境界条件
                    ! ノイマン境界の場合 : フラックス値
                    ! boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
  real, intent(in), optional :: bound_opt(nx,ny)  ! 固定端境界の場合 : 境界値
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  integer :: i, j, k, l, m, n
  real :: tmp, err, err_max

  psi = 0.0

  select case (boundary)

  case(1)
     if(present(bound_opt))then
        call fix(nx,ny,dx,dy,eps,rho,psi,bound_opt)
     else
        call fix(nx,ny,dx,dy,eps,rho,psi)
     end if

  case(2)
     if(present(bound_opt))then
        call free(nx,ny,dx,dy,eps,rho,psi,bound_opt)
     else
        call free(nx,ny,dx,dy,eps,rho,psi)
     end if

  case(3)
     call period(nx,ny,dx,dy,eps,rho,psi)

  end select

contains

subroutine fix(nx,ny,dx,dy,eps,rho,psi,bound_opt)
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
  real, intent(in) :: eps  ! 収束条件
  real, intent(in), optional :: bound_opt(nx,ny)  ! 固定端境界の場合の境界値, デフォルトはゼロ.
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  real :: tmp(nx,ny)  ! ヤコビ法で解くために, イテレート後の値をプールする配列
  integer :: i, j, k, l, m, n
  real :: delta, err_max, err
  real :: bnd(nx,ny)

  if(present(bound_opt))then
     do j=1,ny
        do i=1,nx
           bnd(i,j)=bound_opt(i,j)
        end do
     end do
  else
     do j=1,ny
        do i=1,nx
           bnd(i,j)=0.0
        end do
     end do
  end if

  delta=dx/dy
!-- 固定端の設定 ---
  psi(1,:)=bnd(1,:)
  psi(nx,:)=bnd(nx,:)
  psi(:,1)=bnd(:,1)
  psi(:,nx)=bnd(:,nx)

  err_max=eps  ! while に入るための便宜的措置

!-- 実際のソルバ ---
  do while(err_max>=eps)
     err_max=0.0
!$omp parallel do shared(tmp,psi,rho,delta,dx) private(i,j)
  do j=2,ny-1
     do i=2,nx-1
        tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
     end do
  end do
!$omp end parallel do

!-- 誤差の計算 ---
  do j=2,ny-1
     do i=2,nx-1
        if(psi(i,j)==0.0)then
           err=abs(tmp(i,j)-psi(i,j))/abs(tmp(i,j))
        else
           err=abs(tmp(i,j)-psi(i,j))/abs(psi(i,j))
        end if

!-- 最大誤差の更新
        if(err_max<=err)then
           err_max=err
        end if

     end do
  end do

!$omp parallel do shared(tmp,psi) private(i,j)
  do j=2,ny-1
     do i=2,nx-1
        psi(i,j)=tmp(i,j)
     end do
  end do
!$omp end parallel do

  end do

  

end subroutine fix

subroutine free(nx,ny,dx,dy,eps,rho,psi,bound_flx)
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
  real, intent(in) :: eps  ! 収束条件
  real, intent(in), optional :: bound_flx(nx,ny)  ! 境界におけるフラックスの値
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  real :: tmp(nx,ny)  ! ヤコビ法で解くために, イテレート後の値をプールする配列
  integer :: i, j, k, l, m, n
  real :: delta
  real :: flx(nx,ny)

  if(present(bound_opt))then
     do j=1,ny
        do i=1,nx
           flx(i,j)=bound_opt(i,j)
        end do
     end do
  else
     do j=1,ny
        do i=1,nx
           flx(i,j)=0.0
        end do
     end do
  end if

  delta=dx/dy

  err_max=eps  ! while に入るための便宜的措置

!-- 実際のソルバ ---
  do while(err_max>=eps)
     err_max=0.0
!$omp parallel do shared(tmp,psi,rho,delta,dx) private(i,j)
  do j=ny-1,2,-1
     do i=nx-1,2,-1
        if(i/=2.and.i/=nx-1.and.j/=2.and.j/=nx-1)then
           ! 境界の 1 つ内側以外
           tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
        else
!-- ここから下は if 文のインデントを調節しない.
           if(i==2)then  ! 左境界での扱い
              if(j==2)then  ! 左下境界での扱い.
                 tmp(i,j)=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)-flx(1,1)*dx+delta**2*(psi(i,j+1)-flx(1,1)*dy)))
              else
                 if(j==ny-1)then  ! 左上境界での扱い.
                    tmp(i,j)=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)-flx(1,ny)*dx+delta**2*(psi(i,j+1)+flx(1,ny)*dy)))
                 else
                    tmp(i,j)=(1.0/(1.0+2.0*delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)-flx(1,j)*dx+delta**2*(psi(i,j+1)+psi(i,j-1))))
                 end if
              end if
           else
              if(i==nx-1)then  ! 右境界での扱い.
                 if(j==2)then  ! 右下境界での扱い.
                    tmp(i,j)=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+flx(nx,1)*dx+delta**2*(psi(i,j+1)-flx(nx,1)*dy)))
                 else
                    if(j==ny-1)then  ! 右上境界での扱い.
                       tmp(i,j)=(1.0/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+flx(nx,ny)*dx+delta**2*(psi(i,j+1)+flx(nx,ny)*dy)))
                    else
                       tmp(i,j)=(1.0/(1.0+2.0*delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+flx(nx,j)*dx+delta**2*(psi(i,j+1)+psi(i,j-1))))
                    end if
                 end if
              else
                 if(j==2)then  ! 下側境界での扱い.
                    tmp(i,j)=(1.0/(2.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)-flx(i,1)*dy)))
                 else  ! 上側境界での扱い.
                    tmp(i,j)=(1.0/(2.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+flx(i,ny)*dy)))
                 end if
              end if
           end if
!-- ここまでは if 文のインデントを調節しない.
        end if
     end do
  end do
!$omp end parallel do

!-- 誤差の計算 ---
  do j=2,ny-1
     do i=2,nx-1
        if(psi(i,j)==0.0)then
           err=abs(tmp(i,j)-psi(i,j))/abs(tmp(i,j))
        else
           err=abs(tmp(i,j)-psi(i,j))/abs(psi(i,j))
        end if

!-- 最大誤差の更新
        if(err_max<=err)then
           err_max=err
        end if

     end do
  end do

!$omp parallel do shared(tmp,psi) private(i,j)
  do j=2,ny-1
     do i=2,nx-1
        psi(i,j)=tmp(i,j)
     end do
  end do
!$omp end parallel do

!-- 境界条件の設定
     psi(2:nx-1,1)=psi(2:nx-1,2)-flx(2:nx-1,1)*dy
     psi(1,2:ny-1)=psi(2,2:ny-1)-flx(1,2:ny-1)*dx
     psi(2:nx-1,ny)=psi(2:nx-1,ny-1)+flx(2:nx-1,ny)*dy
     psi(nx,2:ny-1)=psi(nx-1,2:ny-1)+flx(1,2:ny-1)*dx
!-- 4 隅の条件の設定
     psi(1,1)=0.5*(psi(1,2)+psi(2,1)-flx(1,1)*(dx+dy))
     psi(1,ny)=0.5*(psi(1,ny-1)+psi(2,ny)-flx(1,ny)*(dx-dy))
     psi(nx,1)=0.5*(psi(nx,2)+psi(nx-1,1)-flx(nx,1)*(dy-dx))
     psi(nx,ny)=0.5*(psi(nx,ny-1)+psi(nx-1,ny)+flx(nx,ny)*(dx+dy))

  end do

  

end subroutine free

subroutine period(nx,ny,dx,dy,eps,rho,psi)
  implicit none
  integer, intent(in) :: nx  ! x 方向の配列要素
  integer, intent(in) :: ny  ! y 方向の配列要素
  real, intent(in) :: dx  ! x 方向の格子間隔
  real, intent(in) :: dy  ! y 方向の格子間隔
  real, intent(in) :: rho(nx,ny)  ! ポアソン方程式の強制項
  real, intent(in) :: eps  ! 収束条件
  real, intent(inout) :: psi(nx,ny)  ! ポアソン方程式の解
  real :: tmp(nx,ny)  ! ヤコビ法で解くために, イテレート後の値をプールする配列
  integer :: i, j, k, l, m, n
  real :: delta

  delta=dx/dy

  err_max=eps  ! while に入るための便宜的措置

!-- 実際のソルバ ---
  do while(err_max>=eps)
     err_max=0.0
!$omp parallel do shared(tmp,psi,rho,delta,dx) private(i,j)
  do j=2,ny-1
     do i=2,nx-1
        if(i/=2.and.i/=nx-1.and.j/=2.and.j/=nx-1)then
           ! 境界の 1 つ内側以外
           tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
        else
!-- ここから下は if 文のインデントを調節しない.
           if(i==2)then  ! 左境界での扱い
              if(j==2)then  ! 左下境界での扱い.
                 tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(nx-1,j)+delta**2*(psi(i,j+1)+psi(i,ny-1))))
              else
                 if(j==ny-1)then  ! 左上境界での扱い.
                    tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(nx-1,j)+delta**2*(psi(i,2)+psi(i,j-1))))
                 else
                    tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(nx-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
                 end if
              end if
           else
              if(i==nx-1)then  ! 右境界での扱い.
                 if(j==2)then  ! 右下境界での扱い.
                    tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(2,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,ny-1))))
                 else
                    if(j==ny-1)then  ! 右上境界での扱い.
                       tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(2,j)+psi(i-1,j)+delta**2*(psi(i,2)+psi(i,j-1))))
                    else
                       tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(2,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,j-1))))
                    end if
                 end if
              else
                 if(j==2)then  ! 下側境界での扱い.
                    tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,j+1)+psi(i,ny-1))))
                 else  ! 上側境界での扱い.
                    tmp(i,j)=(0.5/(1.0+delta**2))*(-dx**2*rho(i,j) +(psi(i+1,j)+psi(i-1,j)+delta**2*(psi(i,2)+psi(i,j-1))))
                 end if
              end if
           end if
!-- ここまでは if 文のインデントを調節しない.
        end if
     end do
  end do
!$omp end parallel do

!-- 誤差の計算 ---
  do j=2,ny-1
     do i=2,nx-1
        if(psi(i,j)==0.0)then
           err=abs(tmp(i,j)-psi(i,j))/abs(tmp(i,j))
        else
           err=abs(tmp(i,j)-psi(i,j))/abs(psi(i,j))
        end if

!-- 最大誤差の更新
        if(err_max<=err)then
           err_max=err
        end if

     end do
  end do

!$omp parallel do shared(tmp,psi,rho,delta,dx) private(i,j)
  do j=2,ny-1
     do i=2,nx-1
        psi(i,j)=tmp(i,j)
     end do
  end do
!$omp end parallel do

!-- 境界条件の設定
     psi(2:nx-1,1)=psi(2:nx-1,ny-1)
     psi(1,2:ny-1)=psi(nx-1,2:ny-1)
     psi(2:nx-1,ny)=psi(2:nx-1,2)
     psi(nx,2:ny-1)=psi(2,2:ny-1)
!-- 4 隅の条件の設定
     psi(1,1)=0.5*(psi(1,ny-1)+psi(nx-1,1))
     psi(1,ny)=0.5*(psi(1,2)+psi(nx-1,ny))
     psi(nx,1)=0.5*(psi(nx,ny-1)+psi(2,1))
     psi(nx,ny)=0.5*(psi(nx,2)+psi(2,ny))
  end do

  

end subroutine period

end subroutine Poisson_Jacobi