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